#!/usr/bin/perl ## usage: chkfork [ N [ L ] ] ## We check memory changes in /proc/meminfo. ## This start 2**N processes. N defaults to 0. ## We only show the first L lines. L defaults to all. use strict; BEGIN { die "This isn't linux." unless $^O =~ /linux/i; } use Fcntl qw(:flock); use vars qw($MEMINFO $Filter_Pid); $MEMINFO = "/proc/meminfo"; my $Count = shift || 0; my $Lines = shift || 0; filter(); @::GOBBLE = ("fred") x 100000; # gobble lotsa memory show_info(); while (--$Count > 0) { fork; show_info(); } unfilter(); exit; ################################################ sub show_info { open(MEMINFO) || die "can't open $MEMINFO: $!"; # flock(MEMINFO, LOCK_EX); while () { next if /^(Mem|Swap):/; s{(\d+) kB}{sprintf("%*dM", (length($1)-1), $1/1024)}ge; s/^/$$:/; print unless /total:/; } close MEMINFO; } sub filter { flush(); unless ($Filter_Pid = open(STDOUT, "|-")) { die "cannot fork: $!" unless defined $Filter_Pid; head($Lines) if $Lines; my %mem; while () { my ($pid, $field, $size) = split /[:\s]+/; next unless $size; push @{ $mem{$pid}{$field} }, $size; } foreach my $pid ( sort { $a <=> $b } keys %mem ) { foreach my $field ( keys %{ $mem{$pid} } ) { my @vals = @{ $mem{$pid}{$field} }; printf "%-5d %12s " . "%6s " x @vals . "\n", $pid, $field, @vals; } } exit; } flush(); } sub unfilter { close(STDOUT); # waitpid($Filter_Pid,0); } sub head { return if my $pid = open(STDOUT, "|-"); die "cannot fork: $!" unless defined $pid; my $count = shift; while () { if ($count-- > 0) { print; } else { exit; } } exit; } sub flush { $| = 1; } # or duplicate output buffers!! __END__ total: used: free: shared: buffers: cached: Mem: 130650112 80674816 49975296 49299456 25858048 22708224 Swap: 263192576 0 263192576 MemTotal: 127588 kB MemFree: 48804 kB MemShared: 48144 kB Buffers: 25252 kB Cached: 22176 kB SwapTotal: 257024 kB SwapFree: 257024 kB