#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

# $Id: RealMem.pm,v 1.5 2004/03/11 10:12:41 rmd Exp $

package RealMem;

use strict;
use Exporter ();

@RealMem::ISA = qw(Exporter);
@RealMem::EXPORT = qw(RealMem PercentRealMem);

my $realMem;
my $realMemCalculated;

sub calcRealMem {
    $realMemCalculated = 1;
    my $uname = `uname -msr`;
    my ($sys, $vers, $machine) = split(/\s+/, $uname);
    
    if ($sys eq "Linux") {
	my $free = `free -k`;
	($realMem) = $free =~ /Mem\:\s+(\d+)/;
    } elsif ($sys eq "OSF1") {

	my $vmstat_out = `/bin/vmstat -P`;
	if ($vmstat_out =~ /Total\s+Physical\s+Memory\s+=\s+(\d+\.\d+)\s+M/) {
	    $realMem = $1 * 1024;
	}

	unless (defined($realMem)) {
	    my $topOut = `top-$machine-$vers -b -u -d 1`;
	    unless ($topOut) { $topOut = `top 2> /dev/null`; }
	    unless ($topOut) { $topOut = `/usr/local/bin/top 2> /dev/null`; }
	    $topOut =~ /Memory\:\s+Real\:\s+\d+[KMG]\/(\d+)([KMG])/;
	    if ($2 eq 'M') {
		$realMem = $1 * 1024;
	    } elsif ($2 eq 'G') {
		$realMem = $1 * 1024 * 1024;
	    } else {
		$realMem = $1;
	    }
	}
    } elsif ($sys eq "SunOS") {
	my $topOut = `top-$machine-$vers -b -u -d 1`;
	unless ($topOut) { $topOut = `top`; }
	$topOut =~ /Memory\:\s+(\d+)([KM])\s+real/;
	if ($2 eq 'M') {
	    $realMem = $1 * 1024;
	} else {
	    $realMem = $1;
	}
    }
    my $ulimit = ($sys eq "OSF1") ?
	`sh -c 'ulimit -h -d'` : `sh -c 'ulimit -Hd'`;
    chomp($ulimit);
    my ($hardLimit) = $ulimit =~ /^(\d+)/;

    if ($hardLimit && $realMem > $hardLimit) { $realMem = $hardLimit; }
}

sub RealMem {
    unless ($realMemCalculated) { calcRealMem(); }
    return $realMem;
}

sub PercentRealMem {
    unless ($realMemCalculated) { calcRealMem(); }
    my ($scaleFactor) = @_;
    unless (defined($realMem)) { return undef; }
    if ($scaleFactor < 0) { $scaleFactor = 0; }
    if ($scaleFactor > 100) { $scaleFactor = 100; }
    return int($realMem * $scaleFactor / 100);
}

1;

__END__

=head1 NAME

RealMem.pm - Return the physical memory size of the machine running perl.

=head1 SYNOPSIS

use RealMem;

RealMem();

PercentRealMem($scaleFactor);

=head1 PARAMETERS

I<$scaleFactor>  Percentage (between 0 and 100) of real memory to return

=head1 DESCRIPTION

C<RealMem> attempts to find the amount of physical memory available on the
machine running perl.  This information can be used to set process limits,
in order to ensure programs fail rather than leave the machine thrashing.

Use C<RealMem()> for the full amount of physical memory, and
C<PercentRealMem()> to calculate a percentage of the total, if it isn't all
needed.

=head1 RETURN VALUES

On successful completion, C<RealMem()> returns the size of the physical memory
in kilobytes.  If it can't work out how big the memory is, it returns undef.

C<PercentRealMem($scalefactor)> returns a value equal to 
C<RealMem() * $scalefactor / 100> or undef if the memory size is unknown.

=head1 BUGS

C<RealMem()> only returns a value if it is run on Linux, OSF1 or SunOS
machines.  It also relies on C<top> (for SunOS, OSF1), C<free> (for linux),
C<uname> and C<sh> being installed.

=head1 SEE ALSO

Commands: The B<top(1), free(1), uname(1)> and B<sh(1)> manpages.

=head1 AUTHOR

Rob Davies

=head1 HISTORY
S<
# $Log: RealMem.pm,v $
# Revision 1.5  2004/03/11  10:12:41  rmd
# Use vmstat for OSF1 as it is much quicker at coming up with a result.
#
# Revision 1.4  2001/08/22  13:34:36  rmd
# Fixed problem where systems keep on installing /bin/top with the wrong
# permissions.
#
# Revision 1.3  2000/08/08  08:35:36  rmd
# Altered to cater for machines with Gb of memory.
#
# Revision 1.2  1998/04/03  13:45:45  rmd
# Delay looking up memory size until RealMem() is first called, as
# this makes applications start faster.
# Made history log in documentation look nicer.
#
# Revision 1.1  1998/03/31  16:41:45  rmd
# Initial revision
#
>
