Annotation of loncom/debugging_tools/getties.pl, revision 1.2

1.2     ! foxr        1: #
        !             2: # as this is a standalong file..that may ot be able to access the LONCAPA
        !             3: # module, I'm leaving the temp directory knoweldge uncentralized
        !             4: #    - R. Fox 7/1/2011
        !             5: #
        !             6: 
1.1       albertel    7: use strict;
1.2     ! foxr        8: 
        !             9: my $loncapa_tempdir = '/home/httpd/perl/tmp'; # configure the temp dir here.
        !            10: 
        !            11: my $result=`ls -l /proc/*/fd/* | grep $loncapa_tempdir`;
1.1       albertel   12: my @result=split("\n",$result);
                     13: my (@pids,@files);
                     14: foreach my $line (@result) {
                     15: 	if ($line=~m-/proc/(\d+)/fd-) {
                     16: 		push(@pids,$1);
                     17: 		$line=~m-(/home/httpd/perl/tmp/.*)-;
                     18: 		push(@files,$1);
                     19: 	}
                     20: }
                     21: 
                     22: $result=`wget --http-user=lonadm -q --http-passwd=litelite --output-document=- http://localhost/server-status`;
                     23: 
                     24: @result=split('<tr>',$result);
                     25: 
                     26: foreach my $line (@result) {
                     27: 	if ($line =~ m -</b><td>(\d+)<td>-) {
                     28: 		my $curpid=$1;
                     29: 		print ("curpid is $1\n");
                     30: 		for (my $i=0;$i<=$#pids;$i++) {
                     31: 			my $pid=@pids[$i];
                     32: 			my $file=@files[$i];
                     33: 			if ($curpid == $pid) {
                     34: 				$line=~m-<td nowrap>([^<]*)</tr>-;
                     35: 				print("$pid has a tmp file $file, last known request is $1\n");
                     36: 			}
                     37: 		}
                     38: 	}
                     39: }
                     40: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>