From codesite-noreply at google.com Tue Sep 1 21:07:16 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 01 Sep 2009 20:07:16 +0000 Subject: [padb-devel] [padb] r165 committed - Re-instate RMS support, it's un-tested by me but is tested by... Message-ID: <001636c5c05767ed86047289b2e0@google.com> Revision: 165 Author: apittman Date: Tue Sep 1 13:06:21 2009 Log: Re-instate RMS support, it's un-tested by me but is tested by somebody with access to a RMS machine. http://code.google.com/p/padb/source/detail?r=165 Modified: /trunk/src/padb ======================================= --- /trunk/src/padb Wed Aug 26 05:04:08 2009 +++ /trunk/src/padb Tue Sep 1 13:06:21 2009 @@ -2124,6 +2124,8 @@ my $ncpus = rms_job_to_ncpus($job); + my $nhosts = rms_job_to_nhosts($job); + if ( $res eq "" ) { printf("Job '$job' doesn't have a associated resource\n"); return undef; @@ -2153,7 +2155,7 @@ my $cmd = "prun -i /dev/null -T $res"; - return ( $cmd, $ncpus ); + return ( $cmd, $ncpus, $nhosts ); } # Not exported... @@ -2186,6 +2188,55 @@ return $ncpus; } + +sub rms_job_to_nhosts { + my $job = shift; + my $nodeSpec = `rmsquery "select hostnames from jobs where name=\'$job\'"`; + + chomp $nodeSpec; + my $i; + my @nodeList; + my $prefix; + my $suffix; + + # deal with multiple entries + foreach ( split( " ", $nodeSpec ) ) { + if (m/([^\[]+)\[([0-9-,]+)\]([^\[]*)/) { + $prefix = $1; + $suffix = $3; + + foreach ( split( ",", $2 ) ) { + if ( !m/([0-9]+)-?([0-9]+)?/ ) { + print "malformed nodespec '$_'\n"; + exit(1); + } + + if ( defined($2) ) { + + # square braces with range, eg 'machine[0-3]' + for ( $i = $1 ; $i <= $2 ; $i++ ) { + push( @nodeList, $prefix . $i . $suffix ); + } + } else { + + # no range, just suffix + push( @nodeList, $prefix . $1 . $suffix ); + } + } + } else { + + # no square braces, just node name, eg 'machine0' + if ( !m/([^\[]+)([0-9]+)([^\[]*)/ ) { + print "malformed nodespec '$_'\n"; + exit(1); + } + + push( @nodeList, $1 . $2 . $3 ); + } + } + + return $#nodeList + 1; +} sub rms_res_to_partition { my $res = shift; From codesite-noreply at google.com Tue Sep 1 21:11:20 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 01 Sep 2009 20:11:20 +0000 Subject: [padb-devel] [padb] r166 committed - Bump version number to 3.0-rc1 Message-ID: <00504502f5caffe89e047289c051@google.com> Revision: 166 Author: apittman Date: Tue Sep 1 13:07:04 2009 Log: Bump version number to 3.0-rc1 http://code.google.com/p/padb/source/detail?r=166 Modified: /trunk/src/padb ======================================= --- /trunk/src/padb Tue Sep 1 13:06:21 2009 +++ /trunk/src/padb Tue Sep 1 13:07:04 2009 @@ -250,7 +250,7 @@ # Main. my $prog = basename $0; -my $version = "3.0-beta"; +my $version = "3.0-rc1"; my %conf; From codesite-noreply at google.com Tue Sep 1 21:15:26 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 01 Sep 2009 20:15:26 +0000 Subject: [padb-devel] [padb] r167 committed - Bump version number to 3.0-rc1 Message-ID: <001636ed78419de948047289cfd6@google.com> Revision: 167 Author: apittman Date: Tue Sep 1 13:09:16 2009 Log: Bump version number to 3.0-rc1 http://code.google.com/p/padb/source/detail?r=167 Modified: /trunk/src/Makefile ======================================= --- /trunk/src/Makefile Sun Jun 14 12:03:53 2009 +++ /trunk/src/Makefile Tue Sep 1 13:09:16 2009 @@ -1,6 +1,7 @@ INSTALL_DIR=/usr/local/ CONFIG_DIR=/etc +VERSION=3.0-rc1 FILES = Makefile minfo.c mpi_interface.h padb @@ -20,10 +21,9 @@ /bin/rm -f minfo.x tarfile: - /bin/rm -f padb-2.5.tgz - /bin/rm -rf padb-2.5 - mkdir padb-2.5 - /bin/cp ${FILES} padb-2.5 - svnversion > padb-2.5/svnversion - tar -czf padb-2.5.tgz padb-2.5 - + /bin/rm -f padb-${VERSION}.tgz + /bin/rm -rf padb-${VERSION} + mkdir padb-${VERSION} + /bin/cp ${FILES} padb-${VERSION} + svnversion > padb-${VERSION}/svnversion + tar -czf padb-${VERSION}.tgz padb-${VERSION} From codesite-noreply at google.com Wed Sep 2 21:25:59 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Wed, 02 Sep 2009 20:25:59 +0000 Subject: [padb-devel] [padb] r168 committed - Create a 3.0 release branch Message-ID: <001636284afc30f49304729e13b0@google.com> Revision: 168 Author: apittman Date: Wed Sep 2 13:24:17 2009 Log: Create a 3.0 release branch http://code.google.com/p/padb/source/detail?r=168 Added: /branches/3.0 From codesite-noreply at google.com Wed Sep 2 21:34:51 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Wed, 02 Sep 2009 20:34:51 +0000 Subject: [padb-devel] [padb] r169 committed - Create a branch for trying out some code cleanups Message-ID: <0016368e1d7ef00d9004729e3216@google.com> Revision: 169 Author: apittman Date: Wed Sep 2 13:34:05 2009 Log: Create a branch for trying out some code cleanups http://code.google.com/p/padb/source/detail?r=169 Added: /branches/cleanup From codesite-noreply at google.com Thu Sep 3 20:35:53 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Thu, 03 Sep 2009 19:35:53 +0000 Subject: [padb-devel] [padb] r170 committed - Start the process of cleaning up the code to modern guidelines, ... Message-ID: <00163623aa37db2ae10472b17dbf@google.com> Revision: 170 Author: apittman Date: Thu Sep 3 12:34:57 2009 Log: Start the process of cleaning up the code to modern guidelines, use return at the end of every function to ensure we don't accidently return anything we don't want to, replace instances of "return undef" with a simple return and finally make all file descriptors locals. http://code.google.com/p/padb/source/detail?r=170 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 1 13:07:04 2009 +++ /branches/cleanup/src/padb Thu Sep 3 12:34:57 2009 @@ -605,7 +605,8 @@ printf( "DEBUG ($type): %3d: $str\n", $time, @params ); return if $debugModes{$type} eq "basic"; return unless defined $handle; - print Dumper $handle; + print Dumper($handle); + return; } # Valid debug modes, a full list is maintained here so using unexpected @@ -957,7 +958,7 @@ my @header; if ( $a[0] ne "ELAN STATS" or $a[1] ne "falcon" ) { - return undef; + return; } my $index; @@ -1068,7 +1069,7 @@ my @raw_data; - return undef if ( $#a < 5 ); + return if ( $#a < 5 ); for ( $index = 0 ; $index < 4 ; $index++ ) { $raw_data[$index] = _hex( $a[$index] ); @@ -1113,7 +1114,7 @@ my $typename = $stat_types[$type]; my $count = get_sub_stat_count( $inst{sysId}, $type, $header ); - next if $count eq 0; + next if $count == 0; my %type; for ( my $idx = 0 ; $idx < $count ; $idx++ ) { my %data; @@ -1172,8 +1173,6 @@ sub total { my ($data_structures_aref) = @_; - my %total; #holds data structures keyed by name and id - my @keys_order; #keep the order new names and ids were encountered # Make an initial total by just copying the first set of stats # carte blance. @@ -1353,6 +1352,7 @@ $~ = "WITHOUT_VP"; } write STDOUT; + return; } sub display_hashes { @@ -1471,7 +1471,7 @@ my $header = parse_header( shift @data ); - return undef unless $header; + return unless $header; my @out; foreach my $vp (@data) { @@ -1544,6 +1544,7 @@ if ($group) { print group_status($d); } + return; } ############################################################################### @@ -1672,7 +1673,7 @@ { my @invalid; foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { - if ( $ad{$gid}{'idents'}{$ident}{'valid'} eq 0 ) { + if ( $ad{$gid}{'idents'}{$ident}{'valid'} == 0 ) { push @invalid, $ident; } } @@ -1807,19 +1808,21 @@ } my @data; - open( PCMD, "edb -k $key --stats-raw 2>/dev/null|" ) + open( my $PCMD, "edb -k $key --stats-raw 2>/dev/null|" ) or confess "$prog: cant open file: $!\n"; local $/ = "\n\n"; - while () { + while (<$PCMD>) { s/\n//g; push @data, $_; } + close $PCMD; my $s = read_stats(@data); # $stats_total = 1; show_stats($s); + return; } # Show stats for all jobs on this node. @@ -1835,6 +1838,7 @@ local_stats_from_job($job); } + return; } ############################################################################### @@ -2128,7 +2132,7 @@ if ( $res eq "" ) { printf("Job '$job' doesn't have a associated resource\n"); - return undef; + return; } # Try to prevent zombie jobs, fairly rare but I have seen @@ -2268,7 +2272,7 @@ my $job = shift; my $s = "$job." . $conf{slurm_job_step}; my @steps = `squeue -s $s -o "%i %A" 2>/dev/null`; - return undef if ( $? != 0 ); + return if ( $? != 0 ); # The %A option is new so ensure we have the TASKS output # before we believe what we see here... @@ -2282,20 +2286,20 @@ $have_tasks = 1 if ( $cpus eq "TASKS" ); } return $tasks if $have_tasks; - return undef; + return; } # Query the nodecount for the "job" as that is what we shall be running on. sub slurm_job_to_nodecount { my $job = shift; my @jobs = `squeue -o "%i %D" 2>/dev/null`; - return undef if ( $? != 0 ); + return if ( $? != 0 ); foreach my $step (@jobs) { my ( $left, $right ) = split( " ", $step ); return $right if ( $left eq $job ); } - return undef; + return; } # Query the node list for the "step" which isn't the same as the node list @@ -2306,14 +2310,14 @@ my $job = shift; my $s = "$job." . $conf{slurm_job_step}; my @steps = `squeue -s $s -o "%i %N" 2>/dev/null`; - return undef if ( $? != 0 ); + return if ( $? != 0 ); foreach my $step (@steps) { my ( $left, $right ) = split( " ", $step ); return $right if ( $left eq $s ); } - return undef; + return; } sub slurm_job_is_running { @@ -2431,9 +2435,9 @@ } sub mpd_get_data { - open( MPD, "mpdlistjobs|" ) or return; - my @out = ; - close MPD; + open( my $MPD, "mpdlistjobs|" ) or return; + my @out = <$MPD>; + close $MPD; my %jobs; my $job; my $host; @@ -2507,6 +2511,7 @@ sub mpd_cleanup_pcmd { unlink($mpd_dfile) if ( defined($mpd_dfile) ); + return; } ############################################################################### @@ -2543,9 +2548,9 @@ my $job; - open( OPEN, "ompi-ps|" ) or return; - my @out = ; - close OPEN; + open( my $open, "ompi-ps|" ) or return; + my @out = <$open>; + close $open; # Handle being called multiple times, zero the hash every # time we are called. Of course we could just return the @@ -2586,6 +2591,7 @@ } } + return; } sub open_get_jobs { @@ -2623,6 +2629,7 @@ sub open_cleanup_pcmd { unlink($open_dfile) if ( defined($open_dfile) ); + return; } ############################################################################### @@ -2643,9 +2650,9 @@ my @jobs; - open( LSF, "bjobs -r -u $user 2>/dev/null|" ) or return; - my @out = ; - close LSF; + open( my $LSF, "bjobs -r -u $user 2>/dev/null|" ) or return; + my @out = <$LSF>; + close $LSF; foreach my $l (@out) { my ( $job, $user, $stat, $queue, $from, $exec, $name, $time ) = split( " ", $l ); @@ -2673,11 +2680,12 @@ my ( $res, $ncpus ) = split( " ", $result ); - open( QUERY, + open( + my $QUERY, "rmsquery \"select name from jobs where jobs.resource=\'$res\' and status = \'running\' order by name\"|" ); - my @out = ; - close QUERY; + my @out = <$QUERY>; + close $QUERY; my $rjob; @@ -2707,6 +2715,7 @@ } else { $cinner{rmgr} = $conf{rmgr}; } + return; } sub find_rmgr { @@ -2749,6 +2758,7 @@ } setup_rmgr( $ok[0] ); + return; } # Find any active resource manager, that is --any or --all @@ -2855,7 +2865,7 @@ return $rmgr{ $conf{rmgr} }{job_to_key}($job); } - return undef; + return; } sub setup_pcmd { @@ -2868,6 +2878,7 @@ if ( defined( $rmgr{ $conf{rmgr} }{cleanup_pcmd} ) ) { $rmgr{ $conf{rmgr} }{cleanup_pcmd}(); } + return; } ############################################################################### @@ -2926,6 +2937,7 @@ $lines->{$tag} = \@new; } } + return; } sub sort_proc_hashes { @@ -2961,6 +2973,7 @@ } } printf("$l\n"); + return; } # Convert back from a set of values (with ranges) in a namespace to a array of @@ -3006,6 +3019,7 @@ $o .= $v; } print("$o\n"); + return; } # Nicely format process information. @@ -3102,6 +3116,7 @@ return; } } + return; } # XXX: Now only called when loading things from file. @@ -3152,6 +3167,7 @@ } } } + return; } ############################################################################### @@ -3178,6 +3194,7 @@ } else { printf("malformed line: $line"); } + return; } sub post_process_lines { @@ -3187,6 +3204,7 @@ $lines->{raw}{$tag} = thaw( decode_base64( join( "\n", @{ $lines->{base64}{$tag} } ) ) ); } + return; } sub default_output_handler { @@ -3253,6 +3271,7 @@ } } } + return; } sub go_file { @@ -3272,9 +3291,9 @@ # return; #} - open( PCMD, "$file" ) or die "$prog: cant open file $file: $!\n"; - my @data = ; - close(PCMD); + open( my $PCMD, "$file" ) or die "$prog: cant open file $file: $!\n"; + my @data = <$PCMD>; + close($PCMD); my %lines; # A hash of arrays. @@ -3283,6 +3302,7 @@ } post_process_lines( \%lines ); show_results( \%lines, $mode, undef ); + return; } sub rc_status { @@ -3302,6 +3322,7 @@ printf( "%s", " \033[1;1H" ); printf( "%s", "\033[2J" ); } + return; } sub connect_to_child { @@ -3442,6 +3463,7 @@ $comm_data->{sockets}{ $cdata->{socket} } = $cdata; $comm_data->{sel}->add( $cdata->{socket} ); + return; } sub issue_command_to_inner { @@ -3450,6 +3472,7 @@ debug_log( "full_duplex", $cmd, "Sending command to inner, %d bytes", length($str) ); $cdata->{socket}->print("$str\n"); + return; } sub first_command { @@ -3485,6 +3508,7 @@ $cmd{out_format} = $out_format if defined($out_format); $cmd{args} = $args if defined($args); push @commands, \%cmd; + return; } sub next_command { @@ -3554,6 +3578,7 @@ printf( "%$c{i}s : %s\n", $value, rng_convert_to_user( $data->{$value} ) ); } + return; } sub check_signon { @@ -3589,7 +3614,7 @@ printf("Warning, remote process state differs across ranks\n"); report_failed_signon( "state", \%{ $data->{target_data}{state} } ); } - + return; } my $header_shown = 0; @@ -3603,6 +3628,7 @@ $allfns{$mode}{pre_out_handler}( $comm_data->{nprocesses} ); } $header_shown = 1; + return; } sub format_target_data { @@ -3710,6 +3736,7 @@ if ( $comm_data->{signons} == $comm_data->{nhosts} ) { connect_to_children($comm_data); } + return; } sub hello_from_inner { @@ -3731,6 +3758,7 @@ $comm_data->{listen}->close(); } + return; } sub inner_stdout_cb { @@ -3746,11 +3774,13 @@ return; } print("inner: $line\n"); + return; } sub inner_stderr_cb { my ( $comm_data, $cdata, $line ) = @_; print("einner: $line\n"); + return; } sub eof_from_fd { @@ -3761,6 +3791,7 @@ } #printf("Expected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); + return; } sub handle_event_from_socket { @@ -3780,6 +3811,7 @@ $cdata->{str} .= $data; extract_line( $comm_data, $cdata ); } + return; } sub handle_event_from_port { @@ -3792,6 +3824,7 @@ $cdata{line_cb} = \&hello_from_inner; $cdata{event_cb} = \&handle_event_from_socket; $comm_data->{sockets}{$new} = \%cdata; + return; } ############################################################################### @@ -3843,9 +3876,9 @@ sub rng_convert_from_user { my ($range) = @_; - return undef unless defined $range; - return undef if $range eq ""; - return undef if $range eq "[]"; + return unless defined $range; + return if $range eq ""; + return if $range eq "[]"; my $newrange; @@ -3896,7 +3929,7 @@ my ($rg) = @_; # Return undef if this range is empty. - return undef if ( $#{$rg} == -1 ); + return if ( $#{$rg} == -1 ); my $value = $rg->[0]->{l}; if ( $rg->[0]->{l} == $rg->[0]->{u} ) { @@ -4157,9 +4190,9 @@ exit(1); } - open( SFD, $file ) or return; - my @l = ; - close(SFD); + open( my $SFD, $file ) or return; + my @l = <$SFD>; + close($SFD); if ( $#l != 0 ) { return; } @@ -4233,6 +4266,7 @@ sub config_init { map { $ic_names{$_}++ } @inner_conf; map { $ic_names_cmd{$_}++ } @inner_conf_cmd; + return; } sub config_set_internal { @@ -4253,6 +4287,7 @@ if ( defined $ic_names_cmd{$key} ) { $cinner_cmd{$key} = $value; } + return; } sub config_set { @@ -4265,15 +4300,16 @@ } config_set_internal( $key, $value ); + return; } sub config_from_file { my $file = shift; printf("Loading config from \"$file\"\n") if ( $conf{verbose} ); - open( CFILE, $file ) or return; - - while () { + open( my $CFILE, $file ) or return; + + while (<$CFILE>) { if (/^([\w-]+)\s*\=\s*(.*)/) { my $key = $1; my $value = $2; @@ -4281,7 +4317,7 @@ config_set( $key, $value ); } } - close(CFILE); + close($CFILE); return; } @@ -4303,6 +4339,7 @@ config_set( $key, $ENV{$name} ); } } + return; } sub config_help { @@ -4344,6 +4381,7 @@ } } } + return; } sub outer_main { @@ -4598,6 +4636,7 @@ push_command( $mode, $of, $conf{mode_options}{$mode} ); go_job($jobid); } + return; } ############################################################################### @@ -4618,7 +4657,7 @@ $confInner{verbose} or return; $vp = -1 unless defined $vp; print "$confInner{hostname}.$vp:$str\n"; - + return; } my %inner_output; @@ -4632,7 +4671,7 @@ } push( @{ $inner_output{$vp} }, $str ); - + return; } # Report a single string error for a given target rank. @@ -4643,7 +4682,7 @@ } # Report a single string error for a given target rank. -sub target_key_pair ($$$) { +sub target_key_pair { my ( $rank, $key, $value ) = @_; if ( defined $local_target_data{$key}{$value} ) { @@ -4651,6 +4690,7 @@ } else { $local_target_data{$key}{$value} = rng_convert_from_user($rank); } + return; } sub p_die { @@ -4739,6 +4779,7 @@ $gdb->{attached} = 0; send_cont_signal( $gdb->{tracepid} ); + return; } sub gdb_wait_for_prompt { @@ -4829,6 +4870,7 @@ # printf("$2 $indent\nleft '$left'\nright '$right'\n\n\n\n"); } printf("ident $indent\n"); + return; } sub extract_value_soft { @@ -4855,6 +4897,7 @@ # printf("$2 $indent\nleft '$left'\nright '$right'\n\n\n\n"); } printf("ident $indent\n"); + return; } sub new_parse { @@ -4945,7 +4988,6 @@ } return ( $key, \%res, $leftover ); - } sub gdb_parse_reason { @@ -5025,7 +5067,7 @@ sub gdb_type_size { my ( $gdb, $type ) = @_; my %p = gdb_n_send( $gdb, "-data-evaluate-expression sizeof($type)" ); - return undef unless ( $p{status} eq "done" ); + return unless ( $p{status} eq "done" ); return gdb_strip_value( $p{reason} ); } @@ -5033,14 +5075,14 @@ my ( $gdb, $type, $field ) = @_; my %p = gdb_n_send( $gdb, "-data-evaluate-expression \"&(($type *)0)->$field\"" ); - return undef unless ( $p{status} eq "done" ); + return unless ( $p{status} eq "done" ); return hex( gdb_strip_value( $p{reason} ) ); } sub gdb_func_addr { my ( $gdb, $func ) = @_; my %p = gdb_n_send( $gdb, "-data-evaluate-expression $func" ); - return undef unless ( $p{status} eq "done" ); + return unless ( $p{status} eq "done" ); my $value = gdb_strip_value( $p{reason} ); my @a = split( " ", $value ); my $hex = $a[-2]; @@ -5050,7 +5092,7 @@ sub gdb_var_addr { my ( $gdb, $var ) = @_; my %p = gdb_n_send( $gdb, "-data-evaluate-expression &$var" ); - return undef unless ( $p{status} eq "done" ); + return unless ( $p{status} eq "done" ); $p{reason} =~ /value=\"(.+)\"$/; #" return $1; } @@ -5067,7 +5109,7 @@ gdb_n_send( $gdb, "-data-read-memory -o $offset $ptr x 1 1 $count" ); $offset += $count; - return undef unless ( $p{status} eq "done" ); + return unless ( $p{status} eq "done" ); my $val = gdb_parse_reason( $p{reason}, "thread-ids" ); push( @d, @{ $val->{memory}[0]{data} } ); @@ -5080,7 +5122,7 @@ my $offset = 0; my $str = ""; my @s = gdb_read_raw( $gdb, $strp, 128 ); - return undef if ( not defined( $s[0] ) ); + return if ( not defined( $s[0] ) ); foreach my $d (@s) { my $v = hex($d); return $str if ( $v == 0 ); @@ -5194,10 +5236,10 @@ # No interaction was had with minfo, abort with nothing. target_error( $vp, "Error running $confInner{minfo}: No contact" ); - return undef; + return; } - if ( $? ne 0 ) { + if ( $? != 0 ) { # Bad exit code but we did talk to it so run with what we have. target_error( $vp, @@ -5215,6 +5257,7 @@ sub send_cont_signal { my $pid = shift; kill( "CONT", $pid ); + return; } sub fetch_mpi_queue { @@ -5284,6 +5327,7 @@ foreach my $o (@mq) { output( $vp, $o ); } + return; } sub show_mpi_queue_all { @@ -5556,6 +5600,7 @@ my $r = go_deadlock_detect( $carg, \%coll_data ); print $r; + return; } sub gdb_read_value { @@ -5598,6 +5643,7 @@ $arg->{value} = $value; } } + return; } sub gdb_dump_frames { @@ -5782,6 +5828,7 @@ } gdb_quit($gdb); + return; } sub run_ptrack_cmd { @@ -5791,28 +5838,29 @@ my $lines = 0; send_cont_signal($pid); - open( CMD, "$cmd 2>/dev/null|" ) + open( my $CMD, "$cmd 2>/dev/null|" ) || p_die( $vp, "cant start command $cmd" ); - while () { + while (<$CMD>) { chomp $_; output $vp, $_; $lines++; } send_cont_signal($pid); - close CMD; + close $CMD; return $lines; } sub run_command { my ( $vp, $cmd ) = @_; debug $vp, "running $cmd"; - open( CMDS, "$cmd|" ) || p_die $vp, "cant fork subcommand"; - while () { + open( my $CMDS, "$cmd|" ) || p_die $vp, "cant fork subcommand"; + while (<$CMDS>) { chomp $_; output $vp, $_; } - close CMDS; + close $CMDS; debug $vp, "Finished $cmd"; + return; } sub get_remote_env { @@ -5821,15 +5869,15 @@ my %env; local $/ = "\0"; - open( FD, "/proc/$pid/environ" ) or return undef; - while () { + open( my $FD, "/proc/$pid/environ" ) or return; + while (<$FD>) { chomp; my @f = split "="; my $key = $f[0]; shift @f; $env{$key} = join( "=", @f ); } - close FD; + close $FD; return %env; } @@ -5838,22 +5886,18 @@ sub load_rms_procs { my $jobId = shift; - if ( not open PIDFILE, "/proc/rms/programs/$jobId/pids" ) { - - # This is actually perfectly legitimate, it's because you - # can do for example allocate -N4 prun -N2 . Because - # of the way prun -T works (across a resource) not having - # a pids file isn't always a bad thing. - # - # Of course it could mean that whatever jobs were supposed - # to be running on this node aren't. - debug undef, "Cannot open /proc/rms/programs/$jobId/pids"; - return; - } + # This is actually perfectly legitimate, it's because you + # can do for example allocate -N4 prun -N2 . Because + # of the way prun -T works (across a resource) not having + # a pids file isn't always a bad thing. + # + # Of course it could mean that whatever jobs were supposed + # to be running on this node aren't. + open( my $PIDFILE, "/proc/rms/programs/$jobId/pids" ) or return; my @procs; - while () { + while (<$PIDFILE>) { my ( $pid, $vp ) = split(' '); my %process; $process{pid} = $pid; @@ -5867,16 +5911,16 @@ } push @procs, \%process; } - close(PIDFILE); + close($PIDFILE); return @procs; } sub show_task_file { my ( $vp, $file, $prefix ) = @_; return unless ( -f $file ); - open( FD, "$file" ) or return; - my @all = ; - close FD; + open( my $FD, "$file" ) or return; + my @all = <$FD>; + close $FD; foreach my $l (@all) { chomp $l; if ( defined $prefix ) { @@ -5887,6 +5931,7 @@ proc_output( $vp, $key, $value ); } } + return; } sub show_task_stat_file { @@ -5899,9 +5944,9 @@ nswap cnswap exit_signal processor rt_ptiority policy delayacct_blkio_ticks guest_time cguest_time); return unless ( -f $file ); - open( FD, "$file" ) or return; - my @all = ; - close FD; + open( my $FD, "$file" ) or return; + my @all = <$FD>; + close $FD; foreach my $l (@all) { chomp $l; @@ -5911,6 +5956,7 @@ } } + return; } sub show_task_dir { @@ -5930,9 +5976,9 @@ } if ( -f "$dir/maps" ) { - open( MAP, "$dir/maps" ); - my @map = (); - close(MAP); + open( my $MAP, "$dir/maps" ); + my @map = (<$MAP>); + close($MAP); my %totals; foreach my $rgn (@map) { my ( $area, $perm, $offset, $time, $inode, $file ) = @@ -5958,9 +6004,9 @@ } if ( $carg->{proc_shows_fds} ) { - opendir( FDS, "$dir/fd" ); - my @fds = readdir(FDS); - closedir(FDS); + opendir( my $FDS, "$dir/fd" ); + my @fds = readdir($FDS); + closedir($FDS); my @all_fddata; foreach my $fd (@fds) { next if ( $fd eq "." ); @@ -5975,9 +6021,9 @@ # if requested by -O proc-shows-fds=full if ( $carg->{proc_shows_fds} eq "full" ) { if ( -f "$dir/fdinfo/$fd" ) { - open( FDI, "$dir/fdinfo/$fd" ); - my @fdi = (); - close FDI; + open( my $FDI, "$dir/fdinfo/$fd" ); + my @fdi = (<$FDI>); + close $FDI; foreach my $fdi (@fdi) { chomp($fdi); my ( $key, $value ) = split( ":", $fdi ); @@ -6000,6 +6046,7 @@ if ( $carg->{proc_shows_maps} ) { show_task_file( $vp, "$dir/maps", "maps" ); } + return; } # Convert the first line of /proc/stat to elapsed jiffies. @@ -6066,6 +6113,7 @@ } else { output( $vp, "$key: $value" ); } + return; } sub show_proc_all { @@ -6085,16 +6133,17 @@ my $jiffies_start; my $load_avg; + my $SFD; if ( $carg->{proc_shows_proc} ) { foreach my $proc ( @{$list} ) { my $pid = $proc->{pid}; open( $proc->{handle}, "/proc/$pid/stat" ); } - open( SFD, "/proc/stat\n" ); + open( $SFD, "/proc/stat\n" ); # Begin critical path. - my $stat = ; + my $stat = <$SFD>; foreach my $proc ( @{$list} ) { my $pid = $proc->{pid}; @@ -6103,15 +6152,15 @@ seek( $proc->{handle}, 0, 0 ); } - seek( SFD, 0, 0 ); - my $stat2 = ; + seek( $SFD, 0, 0 ); + my $stat2 = <$SFD>; # End critical path. $jiffies_start = add_and_divide_jiffies( $stat, $stat2 ); - open( LFD, "/proc/loadavg" ); - $load_avg = ; - close LFD; + open( my $LFD, "/proc/loadavg" ); + $load_avg = <$LFD>; + close $LFD; } foreach my $proc ( @{$list} ) { @@ -6123,10 +6172,10 @@ if ( $carg->{proc_shows_proc} ) { sleep(1); - seek( SFD, 0, 0 ); + seek( $SFD, 0, 0 ); # Begin critical path. - my $stat = ; + my $stat = <$SFD>; ***The diff for this file has been truncated for email.*** From codesite-noreply at google.com Thu Sep 3 21:57:12 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Thu, 03 Sep 2009 20:57:12 +0000 Subject: [padb-devel] [padb] r171 committed - Use single rather than double quotes where possible. Message-ID: <0016367b65c6b683590472b2a0e9@google.com> Revision: 171 Author: apittman Date: Thu Sep 3 13:56:37 2009 Log: Use single rather than double quotes where possible. http://code.google.com/p/padb/source/detail?r=171 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Thu Sep 3 12:34:57 2009 +++ /branches/cleanup/src/padb Thu Sep 3 13:56:37 2009 @@ -250,7 +250,7 @@ # Main. my $prog = basename $0; -my $version = "3.0-rc1"; +my $version = '3.0-rc1'; my %conf; @@ -313,11 +313,11 @@ 'find_pids' => \&open_find_pids, }; -$rmgr{"lsf-rms"} = { +$rmgr{'lsf-rms'} = { 'is_installed' => \&lsf_is_installed, 'get_active_jobs' => \&lsf_get_jobs, 'setup_pcmd' => \&lsf_setup_pcmd, - 'inner_rmgr' => "rms", + 'inner_rmgr' => 'rms', }; $rmgr{slurm} = { @@ -337,20 +337,20 @@ 'require_inner_callback' => 1, }; -$rmgr{"local-qsnet"} = { +$rmgr{'local-qsnet'} = { 'is_installed' => \&local_q_is_installed, 'get_active_jobs' => \&local_q_get_jobs, 'job_is_running' => \&local_job_is_running, 'setup_pcmd' => \&local_setup_pcmd, - 'inner_rmgr' => "local", + 'inner_rmgr' => 'local', 'require_inner_callback' => 1, }; -$rmgr{"local-fd"} = { +$rmgr{'local-fd'} = { 'get_active_jobs' => \&local_fd_get_jobs, 'job_is_running' => \&local_job_is_running, 'setup_pcmd' => \&local_setup_pcmd, - 'inner_rmgr' => "local", + 'inner_rmgr' => 'local', 'require_inner_callback' => 1, }; @@ -378,14 +378,14 @@ # Valid values are "none" "missing" or "all". Anything not recognised # is treated as "all". -$conf{check_signon} = "all"; +$conf{check_signon} = 'all'; # Output options. $conf{interval} = 10; $conf{watch_clears_screen} = 1; -$conf{scripts} = "bash,sh,dash,ash,perl,xterm"; +$conf{scripts} = 'bash,sh,dash,ash,perl,xterm'; $conf{lsf_job_offset} = 1; -$conf{local_fd_name} = "/dev/null"; +$conf{local_fd_name} = '/dev/null'; $conf{inner_callback} = 0; # These two are used by deadlock and QsNet group @@ -413,15 +413,15 @@ $conf{tree_width} = 4; my $norc = 0; -my $configfile = "/etc/padb.conf"; +my $configfile = '/etc/padb.conf'; # Look for edb in the default install location only. sub find_edb { - return "/usr/lib/qsnet/elan4/bin/" - if ( -d "/usr/lib/qsnet/elan4/bin/" ); - return "/usr/lib64/qsnet/elan4/bin/" - if ( -d "/usr/lib64/qsnet/elan4/bin/" ); - return "edb"; + return '/usr/lib/qsnet/elan4/bin/' + if ( -d '/usr/lib/qsnet/elan4/bin/' ); + return '/usr/lib64/qsnet/elan4/bin/' + if ( -d '/usr/lib64/qsnet/elan4/bin/' ); + return 'edb'; } # Look for minfo.x in the same directory as padb. @@ -603,7 +603,7 @@ return unless $debugModes{$type}; my $time = time() - $start_time; printf( "DEBUG ($type): %3d: $str\n", $time, @params ); - return if $debugModes{$type} eq "basic"; + return if $debugModes{$type} eq 'basic'; return unless defined $handle; print Dumper($handle); return; @@ -623,36 +623,36 @@ sub parse_args_outer { - Getopt::Long::Configure("bundling"); + Getopt::Long::Configure('bundling'); my $debugflag; my @ranks; my %optionhash = ( - "verbose|v+" => \$conf{verbose}, - "user|u=s" => \$user, - "rank|r=s" => \@ranks, - "group-id=s" => \@target_groups, - "help|h" => \&usage, - "all|a" => \$all, - "any|A" => \$any, - "version|V" => \&show_version, - "compress|c" => \$compress, - "compress-long|C" => \$compress_C, - "tree|t" => \$tree, - "input-file|file|i=s" => \$input_file, - "config-option|O=s" => \@config_options, - "full-report=s" => \$full_report, - "core-stack" => \$core_stack, - "core=s" => \$core_name, - "exe=s" => \$exe_name, - "list-rmgrs" => \$list_rmgrs, - "watch" => \$watch, - "local-stats" => \$local_stats, - "show-jobs" => \$show_jobs, - "norc" => \$norc, - "config-file=s" => \$configfile, - "debug=s" => \$debugflag, + 'verbose|v+' => \$conf{verbose}, + 'user|u=s' => \$user, + 'rank|r=s' => \@ranks, + 'group-id=s' => \@target_groups, + 'help|h' => \&usage, + 'all|a' => \$all, + 'any|A' => \$any, + 'version|V' => \&show_version, + 'compress|c' => \$compress, + 'compress-long|C' => \$compress_C, + 'tree|t' => \$tree, + 'input-file|file|i=s' => \$input_file, + 'config-option|O=s' => \@config_options, + 'full-report=s' => \$full_report, + 'core-stack' => \$core_stack, + 'core=s' => \$core_name, + 'exe=s' => \$exe_name, + 'list-rmgrs' => \$list_rmgrs, + 'watch' => \$watch, + 'local-stats' => \$local_stats, + 'show-jobs' => \$show_jobs, + 'norc' => \$norc, + 'config-file=s' => \$configfile, + 'debug=s' => \$debugflag, ); my %config_hash; @@ -678,7 +678,7 @@ foreach my $f ( split( ",", $debugflag ) ) { my ( $name, $v ) = split( "=", $f ); if ( exists $debugModes{$name} ) { - $debugModes{$name} = defined($v) ? $v : "basic"; + $debugModes{$name} = defined($v) ? $v : 'basic'; } else { printf("Attempt to set unknown debug flag \"$name\".\n"); } @@ -733,7 +733,7 @@ my $str = shift; if ( not defined $str ) { return 0; - } elsif ( $str eq "0xffffffffffffffff" ) { + } elsif ( $str eq '0xffffffffffffffff' ) { return -1; } else { @@ -810,19 +810,19 @@ } my @scales = ( - "Bytes", "Kilobytes", "Megabytes", "Gigabytes", - "Terabytes", "Petabytes", "Exabytes" + 'Bytes', 'Kilobytes', 'Megabytes', 'Gigabytes', + 'Terabytes', 'Petabytes', 'Exabytes' ); my @bin_names = ( - "0 bytes", "1 byte", "2 bytes", "4 bytes", - "8 bytes", "16 bytes", "32 bytes", "64 bytes", - "128 bytes", "256 bytes", "512 bytes", "1kb", - "2kb", "4kb", "8kb", "16kb", - "32kb", "64kb", "128kb", "256kb", - "512kb", "1mb", "2mb", "4mb", - "8mb", "16mb", "32mb", "64mb", - "128mb", "256mb", "512mb", "overflow" + '0 bytes', '1 byte', '2 bytes', '4 bytes', + '8 bytes', '16 bytes', '32 bytes', '64 bytes', + '128 bytes', '256 bytes', '512 bytes', '1kb', + '2kb', '4kb', '8kb', '16kb', + '32kb', '64kb', '128kb', '256kb', + '512kb', '1mb', '2mb', '4mb', + '8mb', '16mb', '32mb', '64mb', + '128mb', '256mb', '512mb', 'overflow' ); sub show_counter { @@ -918,7 +918,7 @@ if ( $d->{$bin}{raw}[$j] or $conf{show_all_stats} > 1 ) { push( @vals, - sprintf( "%9s: %10d", + sprintf( '%9s: %10d', $bin_names[$j], $d->{$bin}{raw}[$j] ) ); @@ -939,16 +939,16 @@ # These must stay in the correct order, that is the order # they appear in shared memory. -my @stat_types = ( "Counter", "Tally", "Bin", "Attribute" ); +my @stat_types = qw(Counter Tally Bin Attribute); my @display_order = qw(Attribute Counter Tally Bin); my %stat_types2 = ( Counter => - { size => "1", displayfn => \&show_counter, sumfn => \&sum_counter }, - Tally => { size => "3", displayfn => \&show_tally, sumfn => \&sum_tally }, - Bin => { size => "35", displayfn => \&show_bin, sumfn => \&sum_bin }, - Attribute => { size => "1", displayfn => \&show_attr, sumfn => \&sum_attr }, + { size => '1', displayfn => \&show_counter, sumfn => \&sum_counter }, + Tally => { size => '3', displayfn => \&show_tally, sumfn => \&sum_tally }, + Bin => { size => '35', displayfn => \&show_bin, sumfn => \&sum_bin }, + Attribute => { size => '1', displayfn => \&show_attr, sumfn => \&sum_attr }, ); sub parse_header { @@ -957,7 +957,7 @@ my @header; - if ( $a[0] ne "ELAN STATS" or $a[1] ne "falcon" ) { + if ( $a[0] ne 'ELAN STATS' or $a[1] ne 'falcon' ) { return; } @@ -1056,7 +1056,7 @@ my $rail = _hex $r; if ( $rail == -1 ) { - return "ELAN_RAIL_ALL"; + return 'ELAN_RAIL_ALL'; } else { return $rail; } @@ -1347,9 +1347,9 @@ . local $~; if ( defined $hash->{vp} ) { - $~ = "WITH_VP"; + $~ = 'WITH_VP'; } else { - $~ = "WITHOUT_VP"; + $~ = 'WITHOUT_VP'; } write STDOUT; return; @@ -1361,7 +1361,7 @@ my $rev = $reverse; - $rev = not $rev if ( $sort eq "vp" ); + $rev = not $rev if ( $sort eq 'vp' ); if ($rev) { foreach my $e ( sort { $a->{$sort} <=> $b->{$sort} } ( @{$hashes} ) ) { @@ -1561,14 +1561,14 @@ my $ret; my $sstr = defined $size ? " (size $size)" : ""; - my $members = "members"; - my $are = "are"; - my $have = "have"; + my $members = 'members'; + my $are = 'are'; + my $have = 'have'; if ( $#identical == 0 ) { - $members = "member"; - $are = "is"; - $have = "has"; + $members = 'member'; + $are = 'is'; + $have = 'has'; } if ($possessive) { @@ -1680,7 +1680,7 @@ if ( $#invalid != -1 ) { if ( $conf{show_all_groups} ) { $ret .= $gstr - . group_status_helper( "showing the group as removed", + . group_status_helper( 'showing the group as removed', 0, $ad{$gid}{size}, @invalid ); $gstr = ""; } @@ -1704,12 +1704,12 @@ if ( $conf{show_all_groups} ) { $ret .= $gstr . group_status_helper( - "no statistics for this group *(1)", + 'no statistics for this group *(1)', 1, $ad{$gid}{size}, @identical ); $gstr = ""; } else { $gstr .= - group_status_helper( "no statistics for this group *(1)", + group_status_helper( 'no statistics for this group *(1)', 1, $ad{$gid}{size}, @identical ); } } @@ -1762,7 +1762,7 @@ } if ( $#inactive != -1 ) { $ret .= $gstr - . group_status_helper( "not in a call to the collectives", + . group_status_helper( 'not in a call to the collectives', 0, $ad{$gid}{size}, @inactive ); $gstr = ""; } @@ -1772,11 +1772,11 @@ my $count = keys(%ad); if ( $count == 1 ) { - my $use_str = ( $i_count == 1 ) ? "" : " not"; + my $use_str = ( $i_count == 1 ) ? "" : ' not'; $ret .= "Total: $count group which is$use_str in use.\n"; } else { - my $d_str = ( $d_count == 1 ) ? "is" : "are"; - my $i_str = ( $i_count == 1 ) ? "is" : "are"; + my $d_str = ( $d_count == 1 ) ? 'is' : 'are'; + my $i_str = ( $i_count == 1 ) ? 'is' : 'are'; $ret .= "Total: $count groups of which $d_count $d_str destroyed and $i_count $i_str in use.\n"; } @@ -1827,13 +1827,13 @@ # Show stats for all jobs on this node. sub local_stats { - opendir( DH, "/proc/rms/programs" ); + opendir( DH, '/proc/rms/programs' ); my @files = readdir(DH); closedir(DH); foreach my $job (@files) { - next if ( $job eq ".." ); - next if ( $job eq "." ); + next if ( $job eq '..' ); + next if ( $job eq '.' ); local_stats_from_job($job); @@ -1879,7 +1879,7 @@ my $prev; my $tag = $tags[0]; - debug_log( "tree", \@tags, "called tag:%s, level:%d", $tag, $level ); + debug_log( 'tree', \@tags, 'called tag:%s, level:%d', $tag, $level ); return if ( !defined($tag) ); return if ( !defined( $lines->{$tag} ) ); @@ -1939,7 +1939,7 @@ } debug_log( - "tree", undef, + 'tree', undef, "level $level, endlevel $endlevel, identical:@identical different:@different" ); @@ -1971,7 +1971,7 @@ } debug_log( - "tree", undef, + 'tree', undef, "returning level:$level endlevel:$endlevel identical:@identical different:@different" ); @@ -2016,7 +2016,7 @@ sub show_tree { my $ref = shift; - debug_log( "tree", $ref, "Complete tree" ); + debug_log( 'tree', $ref, 'Complete tree' ); return _show_tree( $ref, undef, "" ); } @@ -2098,7 +2098,7 @@ } sub rms_is_installed { - return ( find_exe("prun") and find_exe("rmsquery") ); + return ( find_exe('prun') and find_exe('rmsquery') ); } sub rms_get_jobs { @@ -2113,7 +2113,7 @@ my $job = shift; my $status = `rmsquery "select status from jobs where name=\'$job\'"`; chomp $status; - return ( $status eq "running" ); + return ( $status eq 'running' ); } sub rms_job_to_key { @@ -2256,7 +2256,7 @@ ############################################################################### sub slurm_is_installed { - return ( find_exe("srun") and find_exe("squeue") and find_exe("scontrol") ); + return ( find_exe('srun') and find_exe('squeue') and find_exe('scontrol') ); } sub slurm_get_jobs { @@ -2283,7 +2283,7 @@ foreach my $step (@steps) { my ( $step, $cpus ) = split( " ", $step ); $tasks = $cpus if ( $step eq $s ); - $have_tasks = 1 if ( $cpus eq "TASKS" ); + $have_tasks = 1 if ( $cpus eq 'TASKS' ); } return $tasks if $have_tasks; return; @@ -2324,7 +2324,7 @@ my $job = shift; my $status = lc `squeue -h -j $job -o "%T"`; chomp $status; - return ( $status eq "running" ); + return ( $status eq 'running' ); } sub slurm_setup_pcmd { @@ -2342,7 +2342,7 @@ sub local_get_jobs { my $user = shift; - opendir( DIR, "/proc/" ); + opendir( DIR, '/proc/' ); my @pids = readdir(DIR); closedir(DIR); my @jobs; @@ -2368,7 +2368,7 @@ sub local_fd_get_jobs_real { my $user = shift; my $file = shift; - opendir( DIR, "/proc/" ); + opendir( DIR, '/proc/' ); my @pids = readdir(DIR); closedir(DIR); my @jobs; @@ -2407,12 +2407,12 @@ } sub local_q_is_installed { - return ( -d "/proc/qsnet" ); + return ( -d '/proc/qsnet' ); } sub local_q_get_jobs { my $user = shift; - return local_fd_get_jobs_real( $user, "/proc/qsnet/elan/user" ); + return local_fd_get_jobs_real( $user, '/proc/qsnet/elan/user' ); } sub local_job_is_running { @@ -2431,7 +2431,7 @@ ############################################################################### sub mpd_is_installed { - return ( find_exe("mpdlistjobs") and find_exe("mpdrun") ); + return ( find_exe('mpdlistjobs') and find_exe('mpdrun') ); } sub mpd_get_data { @@ -2447,22 +2447,22 @@ next unless $value; $key =~ s/ //g; chomp $value; - if ( $key eq "jobid" ) { + if ( $key eq 'jobid' ) { my ( $j, $host ) = split( "@", $value ); $job = $j; } - if ( $key eq "username" ) { + if ( $key eq 'username' ) { $jobs{$job}{user} = $value; } - if ( $key eq "host" ) { + if ( $key eq 'host' ) { $host = $value; $jobs{$job}{host}{$value}++; } - if ( $key eq "pid" ) { + if ( $key eq 'pid' ) { $pid = $value; $jobs{$job}{pids}{$host}{$value}++; } - if ( $key eq "rank" ) { + if ( $key eq 'rank' ) { $jobs{$job}{pids}{$host}{$pid} = $value; if ( ( not defined $jobs{$job}{lastproc} ) or ( $value > $jobs{$job}{lastproc} ) ) @@ -2494,7 +2494,7 @@ my @hosts = keys %{ $d->{$job}{host} }; my $i = @hosts; - my ( $fh, $fn ) = tempfile("/tmp/padb.XXXXXXXX"); + my ( $fh, $fn ) = tempfile('/tmp/padb.XXXXXXXX'); foreach my $host (@hosts) { print $fh "$host:1\n"; } @@ -2533,7 +2533,7 @@ } sub open_is_installed { - return ( find_exe("ompi-ps") and find_exe("orterun") ); + return ( find_exe('ompi-ps') and find_exe('orterun') ); } my %open_jobs; @@ -2576,7 +2576,7 @@ my $host = $elems[4]; $host =~ s/ //g; $host =~ s/\t//g; - next if $host eq "Node"; + next if $host eq 'Node'; $open_jobs{$job}{hosts}{$host}++; my $name = $elems[1]; @@ -2611,7 +2611,7 @@ my @hosts = keys %{ $open_jobs{$job}{hosts} }; my $i = @hosts; - my ( $fh, $fn ) = tempfile("/tmp/padb.XXXXXXXX"); + my ( $fh, $fn ) = tempfile('/tmp/padb.XXXXXXXX'); foreach my $host (@hosts) { print $fh "$host\n"; @@ -2642,7 +2642,7 @@ # Check for both LSF and RMS, I know LSF works in other ways but I don't # know how to launch jobs then... - return ( find_exe("bjobs") and rms_is_installed() ); + return ( find_exe('bjobs') and rms_is_installed() ); } sub lsf_get_jobs { @@ -2656,7 +2656,7 @@ foreach my $l (@out) { my ( $job, $user, $stat, $queue, $from, $exec, $name, $time ) = split( " ", $l ); - next if ( $job eq "JOBID" ); + next if ( $job eq 'JOBID' ); next unless ( defined $time ); push @jobs, $job; } @@ -2751,8 +2751,8 @@ printf( "Error, multiple resource managers detected, use -Ormgr=\n" ); - push @ok, "local-fd"; - push @ok, "local"; + push @ok, 'local-fd'; + push @ok, 'local'; printf("@ok\n"); exit(1); } @@ -2808,8 +2808,8 @@ printf( "Error, multiple resource managers detected, use -Ormgr=\n" ); - push @installed, "local-fd"; - push @installed, "local"; + push @installed, 'local-fd'; + push @installed, 'local'; printf("@installed\n"); exit(1); } @@ -2833,15 +2833,15 @@ printf( "Error, multiple active resource managers detected, use -Ormgr=\n" ); - push @installed, "local-fd"; - push @installed, "local"; + push @installed, 'local-fd'; + push @installed, 'local'; printf("@installed\n"); exit(1); } sub get_all_jobids { my $user = shift; - debug_log( "rmgr", undef, "Loading active jobs list" ); + debug_log( 'rmgr', undef, 'Loading active jobs list' ); return $rmgr{ $conf{rmgr} }{get_active_jobs}($user); } @@ -2927,7 +2927,7 @@ my $start = ( $cargs->{strip_below_main} and $main_idx ) ? $main_idx : 0; - printf( "Stripping 0.." + printf( 'Stripping 0..' . $#{ $lines->{$tag} } . " to $start..$end for $tag\n" ) if $conf{verbose} > 1; @@ -2962,14 +2962,14 @@ .: consuming CPU cycles ,: using CPU but no queue data -: sleeping *: error EOF print($header); - my $l = "0"; + my $l = '0'; for ( my $i = 1 ; $i < $nprocs ; $i++ ) { if ( $i % 10 == 0 ) { $l .= substr( $i, 0, 1 ); } elsif ( $i % 5 == 0 ) { - $l .= "5"; + $l .= '5'; } else { - $l .= "."; + $l .= '.'; } } printf("$l\n"); @@ -3042,7 +3042,7 @@ my @columns = split( ",", $carg->{proc_format} ); foreach my $column (@columns) { - $show_fields = 1 if ( $column eq "fields" ); + $show_fields = 1 if ( $column eq 'fields' ); my ( $name, $desc ) = split( "=", $column ); if ( defined $desc ) { @@ -3217,21 +3217,21 @@ my $lines = $d->{target_output}; my $mode = $req->{mode}; - my $output = "raw"; + my $output = 'raw'; $output = $req->{out_format} if defined $req->{out_format}; - if ( $mode eq "stack" or $input_file ) { + if ( $mode eq 'stack' or $input_file ) { if ( $cargs->{strip_below_main} or $cargs->{strip_above_wait} ) { strip_stack_traces( $cargs, $lines ); } } - if ( $output eq "tree" ) { + if ( $output eq 'tree' ) { print show_tree go_p( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ); - } elsif ( $output eq "compress" ) { + } elsif ( $output eq 'compress' ) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); @@ -3250,7 +3250,7 @@ print("$data\n"); } } - } elsif ( $output eq "compress_c" ) { + } elsif ( $output eq 'compress_c' ) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { print("----------------\n"); print("$tag\n"); @@ -3379,7 +3379,7 @@ sub generate_comm_tree_ladder { my ($a) = @_; my @b = @{$a}; - my $last = "root"; + my $last = 'root'; my %comm_tree; foreach my $c (@b) { $comm_tree{$c}{parent} = $last; @@ -3397,7 +3397,7 @@ sub generate_binary_tree { my ( $a, $width ) = @_; my @b = @{$a}; - my $last = "root"; + my $last = 'root'; my %comm_tree; my @leaves; @@ -3438,7 +3438,7 @@ sub connect_to_children { my $comm_data = shift; - debug_log( "signon", undef, "Received last signon, connecting to inner" ); + debug_log( 'signon', undef, 'Received last signon, connecting to inner' ); @{ $comm_data->{host_ids} } = sortn( keys( %{ $comm_data->{remote} } ) ); $comm_data->{connection_tree} = @@ -3446,7 +3446,7 @@ my $td = $comm_data->{connection_tree}->{root}{children}[0]; - debug_log( "ctree", $comm_data->{connection_tree}, "connection tree" ); + debug_log( 'ctree', $comm_data->{connection_tree}, 'connection tree' ); my $cdata; $cdata->{socket} = connect_to_child( @@ -3456,7 +3456,7 @@ ); $cdata->{active} = 1; $cdata->{str} = ""; - $cdata->{fd_desc} = "child socket"; + $cdata->{fd_desc} = 'child socket'; $cdata->{line_cb} = \&command_from_inner; $cdata->{eof_cb} = \&eof_from_fd; $cdata->{event_cb} = \&handle_event_from_socket; @@ -3469,7 +3469,7 @@ sub issue_command_to_inner { my ( $cdata, $cmd ) = @_; my $str = my_encode($cmd); - debug_log( "full_duplex", $cmd, "Sending command to inner, %d bytes", + debug_log( 'full_duplex', $cmd, 'Sending command to inner, %d bytes', length($str) ); $cdata->{socket}->print("$str\n"); return; @@ -3479,7 +3479,7 @@ my $comm_data = shift; my $req; - $req->{mode} = "signon"; + $req->{mode} = 'signon'; $req->{connection_tree} = $comm_data->{connection_tree}; $req->{remote} = $comm_data->{remote}; @@ -3487,7 +3487,7 @@ # configuration options. # XXX: Need to send over scripts and other stuff here as well. - if ( $conf{rmgr} eq "orte" ) { + if ( $conf{rmgr} eq 'orte' ) { $req->{orte_data} = $open_jobs{ $comm_data->{jobid} }{ranks}; } @@ -3516,7 +3516,7 @@ if ( $#commands == -1 ) { my $req; - $req->{mode} = "exit"; + $req->{mode} = 'exit'; return $req; } @@ -3583,7 +3583,7 @@ sub check_signon { my ( $comm_data, $data ) = @_; - return if ( $conf{check_signon} eq "none" ); + return if ( $conf{check_signon} eq 'none' ); my %here; while ( defined( my $proc = rng_shift( $data->{target_data}{found}{yes} ) ) ) @@ -3603,16 +3603,16 @@ rng_convert_to_user($rng) ); } - return if ( $conf{check_signon} eq "missing" ); + return if ( $conf{check_signon} eq 'missing' ); if ( keys( %{ $data->{target_data}{name} } ) != 1 ) { printf("Warning, remote process name differs across ranks\n"); - report_failed_signon( "name", \%{ $data->{target_data}{name} } ); + report_failed_signon( 'name', \%{ $data->{target_data}{name} } ); } if ( keys( %{ $data->{target_data}{state} } ) != 1 ) { printf("Warning, remote process state differs across ranks\n"); - report_failed_signon( "state", \%{ $data->{target_data}{state} } ); + report_failed_signon( 'state', \%{ $data->{target_data}{state} } ); } return; } @@ -3649,7 +3649,7 @@ my ( $comm_data, $cdata, $line ) = @_; # Initial signon from child. - if ( $line eq "Welcome" ) { + if ( $line eq 'Welcome' ) { my $req = first_command($comm_data); $comm_data->{current_req} = $req; issue_command_to_inner( $cdata, $req ); @@ -3659,20 +3659,20 @@ # A reply from inner. my $d = my_decode($line); - debug_log( "full_duplex", $d, "Reply from inner, %d bytes", length($line) ); + debug_log( 'full_duplex', $d, 'Reply from inner, %d bytes', length($line) ); # The inner process has signed on. - if ( $comm_data->{current_req}->{mode} eq "signon" ) { + if ( $comm_data->{current_req}->{mode} eq 'signon' ) { $comm_data->{current_req} = next_command($comm_data); issue_command_to_inner( $cdata, $comm_data->{current_req} ); - $comm_data->{state} = "live"; + $comm_data->{state} = 'live'; check_signon( $comm_data, $d ); return; } # The inner process is about to exit. - if ( $comm_data->{current_req}->{mode} eq "exit" ) { - $comm_data->{state} = "shutdown"; + if ( $comm_data->{current_req}->{mode} eq 'exit' ) { + $comm_data->{state} = 'shutdown'; return; } @@ -3687,8 +3687,8 @@ if ( defined $d->{target_data} ) { debug_log( - "tdata", $d->{target_data}, - "Target data %s", + 'tdata', $d->{target_data}, + 'Target data %s', format_target_data( $d->{target_data} ) ); } @@ -3744,7 +3744,7 @@ # Children connect back with "Hello $outerkey $hostname $port $innernkey"; my @words = split( " ", $line ); - if ( $#words != 4 or $words[0] ne "Hello" or $words[1] ne $secret ) { + if ( $#words != 4 or $words[0] ne 'Hello' or $words[1] ne $secret ) { printf("Bad signon $line\n"); return 0; } @@ -3764,11 +3764,11 @@ sub inner_stdout_cb { my ( $comm_data, $cdata, $line ) = @_; my @words = split( " ", $line ); - if ( $#words == 3 and $words[0] eq "connect" ) { + if ( $#words == 3 and $words[0] eq 'connect' ) { handle_signon( $comm_data, $words[1], $words[2], $words[3] ); return; - } elsif ( $words[0] eq "debug" ) { + } elsif ( $words[0] eq 'debug' ) { my $count = $comm_data->{sel}->count(); print("There are $count sockets\n"); return; @@ -3786,7 +3786,7 @@ sub eof_from_fd { my ( $comm_data, $cdata ) = @_; - if ( $comm_data->{state} ne "shutdown" ) { + if ( $comm_data->{state} ne 'shutdown' ) { printf("Unexpected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); } @@ -3981,12 +3981,12 @@ } return; } elsif ( $value >= $part->{l} and $value <= $part->{u} ) { - carp("Failed to add value to range (Value already in range)"); + carp('Failed to add value to range (Value already in range)'); return; } $idx++; } - confess("Failed to add value to range"); + confess('Failed to add value to range'); } sub rng_merge { @@ -4067,7 +4067,7 @@ $comm_data->{listen} = $sl; my $port = $sl->sockport(); my $hostname = hostname(); - config_set_internal( "outer", "$hostname:$port" ); + config_set_internal( 'outer', "$hostname:$port" ); $sel->add($sl); my %cdata; @@ -4077,7 +4077,7 @@ map { $cmd .= " --$_=\"$cinner_cmd{$_}\"" } keys(%cinner_cmd); - debug_log( "show_cmd", undef, $cmd ); + debug_log( 'show_cmd', undef, $cmd ); my $pcmd = { pid => -1, @@ -4098,7 +4098,7 @@ $comm_data->{signons} = 0; # State, one of "connecting" "live" and "shutdown"; - $comm_data->{state} = "connecting"; + $comm_data->{state} = 'connecting'; $sel->add( $pcmd->{out} ); $sel->add( $pcmd->{err} ); @@ -4110,7 +4110,7 @@ $op{str} = ""; $op{line_cb} = \&inner_stdout_cb; $op{eof_cb} = \&eof_from_fd; - $op{fd_desc} = "Inner stdout"; + $op{fd_desc} = 'Inner stdout'; $op{event_cb} = \&handle_event_from_socket; $comm_data->{sockets}{ $pcmd->{out} } = \%op; @@ -4118,7 +4118,7 @@ $ep{str} = ""; $ep{line_cb} = \&inner_stderr_cb; $ep{eof_cb} = \&eof_from_fd; - $ep{fd_desc} = "Inner stderr"; + $ep{fd_desc} = 'Inner stderr'; $ep{event_cb} = \&handle_event_from_socket; $comm_data->{sockets}{ $pcmd->{err} } = \%ep; @@ -4149,7 +4149,7 @@ waitpid( $pcmd->{pid}, 0 ); my $res = $?; - if ( $comm_data->{state} ne "shutdown" ) { + if ( $comm_data->{state} ne 'shutdown' ) { printf( "Unexpected exit from parallel command (state=$comm_data->{state})\n" ); @@ -4233,7 +4233,7 @@ $conf{verbose} && defined $ncpus && print "Job has $ncpus process(es)\n"; $conf{verbose} && defined $hosts && print "Job spans $hosts host(s)\n"; - debug_log( "verbose", undef, "There are %d processes over %d hosts", + debug_log( 'verbose', undef, 'There are %d processes over %d hosts', $ncpus, $hosts ); $cmd .= " $0 --inner"; @@ -4245,7 +4245,7 @@ } my $errors = go_parallel( $jobid, $cmd, $ncpus, $hosts ); - debug_log( "verbose", undef, "Completed command" ); + debug_log( 'verbose', undef, 'Completed command' ); cleanup_pcmd(); return $errors; @@ -4326,7 +4326,7 @@ foreach my $key ( keys(%conf) ) { $key =~ s/\-/\_/g; - my $name = "PADB_" . uc($key); + my $name = 'PADB_' . uc($key); if ( defined $ENV{$name} ) { config_set( $key, $ENV{$name} ); } @@ -4334,7 +4334,7 @@ foreach my $key ( keys( %{ $conf{mode_options_reverse} } ) ) { $key =~ s/\-/\_/g; - my $name = "PADB_" . uc($key); + my $name = 'PADB_' . uc($key); if ( defined $ENV{$name} ) { config_set( $key, $ENV{$name} ); } @@ -4348,14 +4348,14 @@ my $max_len = 0; foreach my $key ( keys(%conf) ) { - next if ( ref( $conf{$key} ) eq "HASH" ); + next if ( ref( $conf{$key} ) eq 'HASH' ); if ( length $key > $max_len ) { $max_len = length $key; } } foreach my $key ( sort( keys(%conf) ) ) { - next if ( ref( $conf{$key} ) eq "HASH" ); + next if ( ref( $conf{$key} ) eq 'HASH' ); my $name = $key; $name =~ s/\_/\-/g; if ( defined $conf{$key} ) { @@ -4420,7 +4420,7 @@ $key =~ s/\-/\_/g; - if ( $key eq "scriptDir" ) { + if ( $key eq 'scriptDir' ) { printf( "$prog: -OscriptDir deprecated, use -Oedb=/path/to/edb instead\n" ); ***The diff for this file has been truncated for email.*** From codesite-noreply at google.com Thu Sep 3 22:07:21 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Thu, 03 Sep 2009 21:07:21 +0000 Subject: [padb-devel] [padb] r172 committed - Use explicit -1 as array indexes rather than calculating... Message-ID: <00163623ac5d02c8fa0472b2c571@google.com> Revision: 172 Author: apittman Date: Thu Sep 3 14:06:55 2009 Log: Use explicit -1 as array indexes rather than calculating the length of the array and subtracting one. http://code.google.com/p/padb/source/detail?r=172 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Thu Sep 3 13:56:37 2009 +++ /branches/cleanup/src/padb Thu Sep 3 14:06:55 2009 @@ -6362,8 +6362,8 @@ $ok = 1; $ok = 0 - unless ( defined $frames[$#frames]{func} - and $frames[$#frames]{func} eq 'main' ); + unless ( defined $frames[-1]{func} + and $frames[-1]{func} eq 'main' ); } else { $ok = 0; } From codesite-noreply at google.com Fri Sep 4 20:55:36 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 19:55:36 +0000 Subject: [padb-devel] [padb] r173 committed - Quote integer values when using them to set default values in $conf Message-ID: <0016364c6f453c590e0472c5e273@google.com> Revision: 173 Author: apittman Date: Fri Sep 4 12:55:00 2009 Log: Quote integer values when using them to set default values in $conf http://code.google.com/p/padb/source/detail?r=173 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Thu Sep 3 14:06:55 2009 +++ /branches/cleanup/src/padb Fri Sep 4 12:55:00 2009 @@ -381,7 +381,7 @@ $conf{check_signon} = 'all'; # Output options. -$conf{interval} = 10; +$conf{interval} = '10'; $conf{watch_clears_screen} = 1; $conf{scripts} = 'bash,sh,dash,ash,perl,xterm'; $conf{lsf_job_offset} = 1; @@ -395,8 +395,8 @@ #$conf{"show-all-groups"} = 0; # Tuning options. -$conf{prun_timeout} = 120; -$conf{prun_exittimeout} = 120; +$conf{prun_timeout} = '120'; +$conf{prun_exittimeout} = '120'; $conf{rmgr} = undef; $conf{slurm_job_step} = 0; @@ -410,7 +410,7 @@ # Option to define a list of ports used by padb. $conf{port_range} = undef; -$conf{tree_width} = 4; +$conf{tree_width} = '4'; my $norc = 0; my $configfile = '/etc/padb.conf'; From codesite-noreply at google.com Fri Sep 4 21:15:54 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 20:15:54 +0000 Subject: [padb-devel] [padb] r174 committed - Don't brace paramaters to builtin function printf. Message-ID: <0016364c6f45d962a20472c62a24@google.com> Revision: 174 Author: apittman Date: Fri Sep 4 13:15:24 2009 Log: Don't brace paramaters to builtin function printf. http://code.google.com/p/padb/source/detail?r=174 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 12:55:00 2009 +++ /branches/cleanup/src/padb Fri Sep 4 13:15:24 2009 @@ -437,9 +437,9 @@ ############################################################################### sub show_version { - printf("$prog version $version\n\n"); - printf("Written by Ashley Pittman\n"); - printf("http://padb.pittman.org.uk\n"); + printf "$prog version $version\n\n"; + printf "Written by Ashley Pittman\n"; + printf "http://padb.pittman.org.uk\n"; exit 0; } @@ -597,12 +597,12 @@ sub debug_log { my ( $type, $handle, $str, @params ) = @_; if ( not exists $debugModes{$type} ) { - printf("Unknown debug mode: $type\n"); + printf "Unknown debug mode: $type\n"; exit(1); } return unless $debugModes{$type}; my $time = time() - $start_time; - printf( "DEBUG ($type): %3d: $str\n", $time, @params ); + printf "DEBUG ($type): %3d: $str\n", $time, @params; return if $debugModes{$type} eq 'basic'; return unless defined $handle; print Dumper($handle); @@ -680,7 +680,7 @@ if ( exists $debugModes{$name} ) { $debugModes{$name} = defined($v) ? $v : 'basic'; } else { - printf("Attempt to set unknown debug flag \"$name\".\n"); + printf "Attempt to set unknown debug flag \"$name\".\n"; } } if ( $debugModes{all} ) { @@ -1798,12 +1798,12 @@ sub local_stats_from_job { my $job = shift; - printf("Showing local job $job\n"); + printf "Showing local job $job\n"; my $key = rms_job_to_key($job); if ( not defined $key ) { - printf("Cannot find key for local job $job\n"); + printf "Cannot find key for local job $job\n"; return; } @@ -2131,7 +2131,7 @@ my $nhosts = rms_job_to_nhosts($job); if ( $res eq "" ) { - printf("Job '$job' doesn't have a associated resource\n"); + printf "Job '$job' doesn't have a associated resource\n"; return; } @@ -2188,7 +2188,7 @@ $ncpus += $n[$idx] * $c[$idx]; } - printf("extracted $ncpus from $cpus and $nodes\n") if $conf{verbose} > 1; + printf "extracted $ncpus from $cpus and $nodes\n" if $conf{verbose} > 1; return $ncpus; } @@ -2725,16 +2725,15 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { - printf("Error, resource manager \"$conf{rmgr}\" not supported\n"); + printf "Error, resource manager \"$conf{rmgr}\" not supported\n"; exit(1); } if ( defined $rmgr{ $conf{rmgr} }{is_installed} and not $rmgr{ $conf{rmgr} }{is_installed}() ) { - printf( -"Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n" - ); + printf +"Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n"; } setup_rmgr( $conf{rmgr} ); return; @@ -2748,12 +2747,11 @@ } } if ( $#ok != 0 ) { - printf( -"Error, multiple resource managers detected, use -Ormgr=\n" - ); + printf +"Error, multiple resource managers detected, use -Ormgr=\n"; push @ok, 'local-fd'; push @ok, 'local'; - printf("@ok\n"); + print "@ok\n"; exit(1); } @@ -2773,16 +2771,15 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { - printf("Error, resource manager \"$conf{rmgr}\" not supported\n"); + printf "Error, resource manager \"$conf{rmgr}\" not supported\n"; exit(1); } if ( defined $rmgr{ $conf{rmgr} }{is_installed} and not $rmgr{ $conf{rmgr} }{is_installed}() ) { - printf( -"Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n" - ); + printf +"Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n"; } setup_rmgr( $conf{rmgr} ); return; @@ -2805,12 +2802,11 @@ # No resource managers are installed, bad. if ( $#installed == -1 ) { - printf( -"Error, multiple resource managers detected, use -Ormgr=\n" - ); + printf +"Error, multiple resource managers detected, use -Ormgr=\n"; push @installed, 'local-fd'; push @installed, 'local'; - printf("@installed\n"); + printf "@installed\n"; exit(1); } @@ -2830,12 +2826,11 @@ # Multiple resource managers are installed and have jobs, # bouce back to the user to specify which one they want. - printf( -"Error, multiple active resource managers detected, use -Ormgr=\n" - ); + printf +"Error, multiple active resource managers detected, use -Ormgr=\n"; push @installed, 'local-fd'; push @installed, 'local'; - printf("@installed\n"); + printf "@installed\n"; exit(1); } @@ -2927,9 +2922,9 @@ my $start = ( $cargs->{strip_below_main} and $main_idx ) ? $main_idx : 0; - printf( 'Stripping 0..' - . $#{ $lines->{$tag} } - . " to $start..$end for $tag\n" ) + printf 'Stripping 0..' + . $#{ $lines->{$tag} } + . " to $start..$end for $tag\n" if $conf{verbose} > 1; my @new = @{ $lines->{$tag} }; @@ -2972,7 +2967,7 @@ $l .= '.'; } } - printf("$l\n"); + printf "$l\n"; return; } @@ -3151,7 +3146,7 @@ } } print("----------------\n"); - printf( "%s\n", join( ",", compress( @identical, $tag ) ) ); + printf "%s\n", join( ",", compress( @identical, $tag ) ); print("----------------\n"); foreach my $data ( @{ $lines->{$tag} } ) { print("$data\n"); @@ -3189,10 +3184,10 @@ push( @{ $lines->{lines}{$key} }, $value ); } } else { - printf("debug $1.$2: $3\n"); + printf "debug $1.$2: $3\n"; } } else { - printf("malformed line: $line"); + printf "malformed line: $line"; } return; } @@ -3244,7 +3239,7 @@ } } print("----------------\n"); - printf( "%s\n", join( ",", compress( @identical, $tag ) ) ); + printf "%s\n", join( ",", compress( @identical, $tag ) ); print("----------------\n"); foreach my $data ( @{ $lines->{$tag} } ) { print("$data\n"); @@ -3319,8 +3314,8 @@ sub maybe_clear_screen { return unless $watch; if ( $conf{watch_clears_screen} ) { - printf( "%s", " \033[1;1H" ); - printf( "%s", "\033[2J" ); + printf "%s", " \033[1;1H"; + printf "%s", "\033[2J"; } return; } @@ -3556,12 +3551,12 @@ } if ( $conf{verbose} and defined $req->{cargs} ) { - printf("Mode '$req->{mode}' mode specific flags:\n"); + printf "Mode '$req->{mode}' mode specific flags:\n"; foreach my $arg ( sort( keys( %{ $req->{cargs} } ) ) ) { if ( defined $req->{cargs}{$arg} ) { - printf( "%20s : '%s'\n", $arg, $req->{cargs}{$arg} ); + printf "%20s : '%s'\n", $arg, $req->{cargs}{$arg}; } else { - printf( "%20s : undef\n", $arg ); + printf "%20s : undef\n", $arg; } } } @@ -3573,10 +3568,9 @@ my ( $key, $data ) = @_; my %c; $c{i} = length($key); - printf("$key : ranks\n"); + printf "$key : ranks\n"; foreach my $value ( sort( keys( %{$data} ) ) ) { - printf( "%$c{i}s : %s\n", - $value, rng_convert_to_user( $data->{$value} ) ); + printf "%$c{i}s : %s\n", $value, rng_convert_to_user( $data->{$value} ); } return; } @@ -3599,19 +3593,19 @@ } if ( not rng_empty($rng) ) { - printf( "Warning, failed to locate ranks %s\n", - rng_convert_to_user($rng) ); + printf "Warning, failed to locate ranks %s\n", + rng_convert_to_user($rng); } return if ( $conf{check_signon} eq 'missing' ); if ( keys( %{ $data->{target_data}{name} } ) != 1 ) { - printf("Warning, remote process name differs across ranks\n"); + printf "Warning, remote process name differs across ranks\n"; report_failed_signon( 'name', \%{ $data->{target_data}{name} } ); } if ( keys( %{ $data->{target_data}{state} } ) != 1 ) { - printf("Warning, remote process state differs across ranks\n"); + printf "Warning, remote process state differs across ranks\n"; report_failed_signon( 'state', \%{ $data->{target_data}{state} } ); } return; @@ -3702,12 +3696,12 @@ my $mode = $comm_data->{current_req}->{mode}; if ( defined $d->{target_data}{error} ) { - printf("Warning: errors reported by some ranks\n========\n"); + printf "Warning: errors reported by some ranks\n========\n"; foreach my $error ( sort( keys( %{ $d->{target_data}{error} } ) ) ) { - printf( "%s: $error\n", - rng_convert_to_user( $d->{target_data}{error}{$error} ) ); - } - printf("========\n"); + printf "%s: $error\n", + rng_convert_to_user( $d->{target_data}{error}{$error} ); + } + printf "========\n"; } if ( defined( $allfns{$mode}{out_handler} ) ) { @@ -3745,7 +3739,7 @@ # Children connect back with "Hello $outerkey $hostname $port $innernkey"; my @words = split( " ", $line ); if ( $#words != 4 or $words[0] ne 'Hello' or $words[1] ne $secret ) { - printf("Bad signon $line\n"); + printf "Bad signon $line\n"; return 0; } @@ -3787,7 +3781,7 @@ my ( $comm_data, $cdata ) = @_; if ( $comm_data->{state} ne 'shutdown' ) { - printf("Unexpected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); + printf "Unexpected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"; } #printf("Expected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); @@ -4129,7 +4123,7 @@ my $cdata = $comm_data->{sockets}{$h}; $cdata->{event_cb}( $comm_data, $h ); } else { - printf("Responce from unknown fd $h\n"); + printf "Responce from unknown fd $h\n"; exit(1); } } @@ -4138,7 +4132,6 @@ my $count = $sel->count(); if ( $count > 0 ) { - #printf("Still here, time:$t2 comm_count:$count\n"); if ( $comm_data->{signons} != $comm_data->{nhosts} ) { my $missing = $comm_data->{nhosts} - $comm_data->{signons}; print("Waiting for signon from $missing hosts.\n"); @@ -4150,21 +4143,19 @@ my $res = $?; if ( $comm_data->{state} ne 'shutdown' ) { - printf( -"Unexpected exit from parallel command (state=$comm_data->{state})\n" - ); - } - printf("result from parallel command is $res (state=$comm_data->{state})\n") + printf + "Unexpected exit from parallel command (state=$comm_data->{state})\n"; + } + printf "result from parallel command is $res (state=$comm_data->{state})\n" if ( $conf{verbose} ); if ( $res != 0 ) { my %status = rc_status($res); if ( job_is_running($jobid) ) { - printf( - "Bad exit code from parallel command (exit_code=$status{rc})\n" - ); + printf + "Bad exit code from parallel command (exit_code=$status{rc})\n"; } else { - printf("Job $jobid is no longer active\n"); + printf "Job $jobid is no longer active\n"; return 1; } } @@ -4176,7 +4167,7 @@ my $file = "$ENV{HOME}/.padb-secret"; if ( !-f $file ) { - printf("No secret file ($file)\n"); + printf "No secret file ($file)\n"; return; } my ( @@ -4186,7 +4177,7 @@ # Check that the file is mode 100600 (Octal) if ( $mode != 33152 ) { - printf("Wrong permissions on secret file, should be 0600 ($file)\n"); + printf "Wrong permissions on secret file, should be 0600 ($file)\n"; exit(1); } @@ -4214,7 +4205,7 @@ $secret = find_padb_secret(); if ( not defined $secret ) { - printf("Error: Could not load secret file on this node\n"); + printf "Error: Could not load secret file on this node\n"; exit(1); } @@ -4239,8 +4230,8 @@ $cmd .= " $0 --inner"; if ( not defined $hosts ) { - printf("Full duplex mode needs to know the host count\n"); - printf("Which is doesn't for this resource manager: $conf{rmgr}\n"); + printf "Full duplex mode needs to know the host count\n"; + printf "Which is doesn't for this resource manager: $conf{rmgr}\n"; return 1; } my $errors = go_parallel( $jobid, $cmd, $ncpus, $hosts ); @@ -4292,11 +4283,10 @@ sub config_set { my ( $key, $value ) = @_; - printf("Setting '$key' to '$value'\n") if ( $conf{verbose} ); + printf "Setting '$key' to '$value'\n" if ( $conf{verbose} ); if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { - printf( STDERR - "Warning, unknown config option '$key' value '$value'.\n" ); + printf STDERR "Warning, unknown config option '$key' value '$value'.\n"; } config_set_internal( $key, $value ); @@ -4306,7 +4296,7 @@ sub config_from_file { my $file = shift; - printf("Loading config from \"$file\"\n") if ( $conf{verbose} ); + printf "Loading config from \"$file\"\n" if ( $conf{verbose} ); open( my $CFILE, $file ) or return; while (<$CFILE>) { @@ -4322,7 +4312,7 @@ } sub config_from_env { - printf("Loading config from environment\n") if ( $conf{verbose} ); + printf "Loading config from environment\n" if ( $conf{verbose} ); foreach my $key ( keys(%conf) ) { $key =~ s/\-/\_/g; @@ -4343,7 +4333,7 @@ } sub config_help { - printf("Current options are:\n"); + printf "Current options are:\n"; my $max_len = 0; @@ -4359,25 +4349,23 @@ my $name = $key; $name =~ s/\_/\-/g; if ( defined $conf{$key} ) { - printf( " %$max_len" . "s = '$conf{$key}'\n", $name ); + printf " %$max_len" . "s = '$conf{$key}'\n", $name; } else { - printf( " %$max_len" . "s = unset\n", $name ); + printf " %$max_len" . "s = unset\n", $name; } } foreach my $mode ( sort( keys( %{ $conf{mode_options} } ) ) ) { - printf("\nOptions for mode '$allfns{$mode}{arg_long}'\n"); + printf "\nOptions for mode '$allfns{$mode}{arg_long}'\n"; foreach my $key ( sort( keys( %{ $conf{mode_options}{$mode} } ) ) ) { my $name = $key; $name =~ s/\_/\-/g; if ( defined $conf{mode_options}{$mode}{$key} ) { - printf( - " %$max_len" . "s = '$conf{mode_options}{$mode}{$key}'\n", - $name - ); + printf + " %$max_len" . "s = '$conf{mode_options}{$mode}{$key}'\n", + $name; } else { - printf( " %$max_len" . "s = undef\n", $name ); - + printf " %$max_len" . "s = undef\n", $name; } } } @@ -4403,7 +4391,7 @@ config_from_env(); - printf("Loading config from command line\n") if ( $conf{verbose} ); + printf "Loading config from command line\n" if ( $conf{verbose} ); # # Once again there is a 'bugette' here, you cant pass the @@ -4430,12 +4418,12 @@ if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { - printf("Error, unknown config option '$name'\n"); + printf "Error, unknown config option '$name'\n"; config_help(); exit(1); } if ( !defined $val ) { - printf("Error, config option '$name' requires value\n"); + printf "Error, config option '$name' requires value\n"; config_help(); exit(1); } @@ -4454,16 +4442,16 @@ my $r = $res; if ( $working eq 'yes' ) { - printf("$r: "); + printf "$r: "; my @jobs = $rmgr{$res}{get_active_jobs}($user); if ( $#jobs > -1 ) { my $j = join( " ", sortn(@jobs) ); - printf("jobs($j)\n"); + printf "jobs($j)\n"; } else { - printf("No active jobs\n"); + printf "No active jobs\n"; } } else { - printf("$r: not active\n"); + printf "$r: not active\n"; } } exit(0); @@ -4471,16 +4459,16 @@ if ($core_stack) { if ( not defined $core_name or not defined $exe_name ) { - printf( - "Usage $0 --core-stack --core= --exe=\n"); + printf + "Usage $0 --core-stack --core= --exe=\n"; exit(1); } if ( not -f $exe_name ) { - printf("Error: executable file '$exe_name' does not exist!\n"); + printf "Error: executable file '$exe_name' does not exist!\n"; exit(1); } if ( not -f $core_name ) { - printf("Error: core file '$core_name' does not exist!\n"); + printf "Error: core file '$core_name' does not exist!\n"; exit(1); } stack_from_core( $exe_name, $core_name ); @@ -4492,14 +4480,13 @@ find_rmgr(); if ( not job_is_running($full_report) ) { - printf( STDERR -"Job $full_report is not active, use --show-jobs to see active jobs\n" - ); + printf STDERR +"Job $full_report is not active, use --show-jobs to see active jobs\n"; exit(1); } - printf("padb version $version\n"); - printf("full job report for job $full_report\n\n"); + printf "padb version $version\n"; + printf "full job report for job $full_report\n\n"; push_command( 'mqueue', 'compress' ); @@ -4597,14 +4584,14 @@ find_any_rmgr(); @jobids = get_all_jobids($user); - printf( "Active jobs (%d) are @jobids\n", $#jobids + 1 ) + printf "Active jobs (%d) are @jobids\n", $#jobids + 1 if $conf{verbose}; if ( $#jobids == -1 ) { - printf("No active jobs could be found for user '$user'\n"); + printf "No active jobs could be found for user '$user'\n"; exit 1; } if ( $any && $#jobids != 0 ) { - printf("More than 1 active job (@jobids) for user '$user'\n"); + printf "More than 1 active job (@jobids) for user '$user'\n"; exit 1; } } else { @@ -4614,13 +4601,13 @@ if ( job_is_running($jobid) ) { push @jobids, $jobid; } else { - printf( STDERR "Job $jobid is not active\n" ); + printf STDERR "Job $jobid is not active\n"; } } } if ( $#jobids > 0 and $watch ) { - printf("Cannot use --watch with more than one job\n"); + printf "Cannot use --watch with more than one job\n"; exit(1); } @@ -4867,9 +4854,8 @@ } } - # printf("$2 $indent\nleft '$left'\nright '$right'\n\n\n\n"); - } - printf("ident $indent\n"); + } + printf "ident $indent\n"; return; } @@ -4894,9 +4880,8 @@ } } - # printf("$2 $indent\nleft '$left'\nright '$right'\n\n\n\n"); - } - printf("ident $indent\n"); + } + printf "ident $indent\n"; return; } @@ -4904,8 +4889,6 @@ my $str = shift; my $collapse = shift; - # printf("Parsing\t\t\t\t\t\t$str\n"); - my %res; my $key; my $value; @@ -4919,7 +4902,6 @@ } my $leftover; - # printf("Got key/value pair! $key\n"); my $type = substr( $value, 0, 1 ); if ( $type eq "[" ) { if ( $value eq "[]" ) { @@ -4929,8 +4911,6 @@ my ( $l, $r ) = extract_value_square($value); $leftover = $r; - # printf("Got value\n$l\n$r\n"); - my @b; while ( $l ne "" ) { my ( $kk, $vv, $c ) = new_parse( $l, $collapse ); @@ -4956,8 +4936,6 @@ my ( $l, $r ) = extract_value_soft($value); $leftover = $r; - # printf("Got value\n$l\n$r\n"); - my @all; while ( $l ne "" ) { my ( $kk, $vv, $c ) = new_parse( $l, $collapse ); @@ -5173,7 +5151,7 @@ $res = $image; } } else { - printf("Unhandled query $query\n"); + printf "Unhandled query $query\n"; } if ( defined $res ) { return "ok $res"; @@ -5783,12 +5761,12 @@ foreach my $thread ( sort { $a->{id} <=> $b->{id} } @threads ) { my @frames = @{ $thread->{frames} }; - printf("ThreadId: $thread->{id}\n") if ( $#threads != 0 ); + printf "ThreadId: $thread->{id}\n" if ( $#threads != 0 ); for ( my $i = $#frames ; $i >= 0 ; $i-- ) { my $frame = $frames[$i]; - printf("ERROR: $$frame{error}\n") + printf "ERROR: $$frame{error}\n" if exists $$frame{error}; next unless exists $$frame{level}; @@ -5806,7 +5784,7 @@ my $a = join( ", ", @a ); my $file = $frame->{file} || "?"; my $line = $frame->{line} || "?"; - printf("$frame->{func}($a) at $file:$line\n"); + printf "$frame->{func}($a) at $file:$line\n"; if ( $conf{stack_shows_locals} ) { foreach my $arg ( @{ $frame->{locals} } ) { @@ -7264,7 +7242,7 @@ $cdata->{dead} = 1; print("debug\n"); } else { - printf("Closing connection from $cdata->{desc} (Bad signon)\n"); + printf "Closing connection from $cdata->{desc} (Bad signon)\n"; $netdata->{sel}->remove($s); $s->close(); $cdata->{dead} = 1; @@ -7371,7 +7349,6 @@ # Dead connection. if ( not defined $d or $count == 0 ) { - # printf("null read from $sinfo->{desc}\n"); if ( eof($s) ) { $sel->remove($s); $s->close(); @@ -7396,7 +7373,7 @@ } } my $count = $sel->count(); - printf("Thats not supposed to happen count=($count)\n"); + printf "Thats not supposed to happen count=($count)\n"; return; } From codesite-noreply at google.com Fri Sep 4 21:27:20 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 20:27:20 +0000 Subject: [padb-devel] [padb] r175 committed - Replace printf with a simple print where possible. Message-ID: <001636ed688fb3d67f0472c653c5@google.com> Revision: 175 Author: apittman Date: Fri Sep 4 13:26:58 2009 Log: Replace printf with a simple print where possible. http://code.google.com/p/padb/source/detail?r=175 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 13:15:24 2009 +++ /branches/cleanup/src/padb Fri Sep 4 13:26:58 2009 @@ -437,9 +437,9 @@ ############################################################################### sub show_version { - printf "$prog version $version\n\n"; - printf "Written by Ashley Pittman\n"; - printf "http://padb.pittman.org.uk\n"; + print "$prog version $version\n\n"; + print "Written by Ashley Pittman\n"; + print "http://padb.pittman.org.uk\n"; exit 0; } @@ -597,7 +597,7 @@ sub debug_log { my ( $type, $handle, $str, @params ) = @_; if ( not exists $debugModes{$type} ) { - printf "Unknown debug mode: $type\n"; + print "Unknown debug mode: $type\n"; exit(1); } return unless $debugModes{$type}; @@ -680,7 +680,7 @@ if ( exists $debugModes{$name} ) { $debugModes{$name} = defined($v) ? $v : 'basic'; } else { - printf "Attempt to set unknown debug flag \"$name\".\n"; + print "Attempt to set unknown debug flag \"$name\".\n"; } } if ( $debugModes{all} ) { @@ -1798,12 +1798,12 @@ sub local_stats_from_job { my $job = shift; - printf "Showing local job $job\n"; + print "Showing local job $job\n"; my $key = rms_job_to_key($job); if ( not defined $key ) { - printf "Cannot find key for local job $job\n"; + print "Cannot find key for local job $job\n"; return; } @@ -2131,7 +2131,7 @@ my $nhosts = rms_job_to_nhosts($job); if ( $res eq "" ) { - printf "Job '$job' doesn't have a associated resource\n"; + print "Job '$job' doesn't have a associated resource\n"; return; } @@ -2188,7 +2188,7 @@ $ncpus += $n[$idx] * $c[$idx]; } - printf "extracted $ncpus from $cpus and $nodes\n" if $conf{verbose} > 1; + print "extracted $ncpus from $cpus and $nodes\n" if $conf{verbose} > 1; return $ncpus; } @@ -2725,14 +2725,14 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { - printf "Error, resource manager \"$conf{rmgr}\" not supported\n"; + print "Error, resource manager \"$conf{rmgr}\" not supported\n"; exit(1); } if ( defined $rmgr{ $conf{rmgr} }{is_installed} and not $rmgr{ $conf{rmgr} }{is_installed}() ) { - printf + print "Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n"; } setup_rmgr( $conf{rmgr} ); @@ -2747,7 +2747,7 @@ } } if ( $#ok != 0 ) { - printf + print "Error, multiple resource managers detected, use -Ormgr=\n"; push @ok, 'local-fd'; push @ok, 'local'; @@ -2771,14 +2771,14 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { - printf "Error, resource manager \"$conf{rmgr}\" not supported\n"; + print "Error, resource manager \"$conf{rmgr}\" not supported\n"; exit(1); } if ( defined $rmgr{ $conf{rmgr} }{is_installed} and not $rmgr{ $conf{rmgr} }{is_installed}() ) { - printf + print "Warning: Selected resource manager $conf{rmgr} does not appear to be installed\n"; } setup_rmgr( $conf{rmgr} ); @@ -2802,11 +2802,11 @@ # No resource managers are installed, bad. if ( $#installed == -1 ) { - printf + print "Error, multiple resource managers detected, use -Ormgr=\n"; push @installed, 'local-fd'; push @installed, 'local'; - printf "@installed\n"; + print "@installed\n"; exit(1); } @@ -2826,11 +2826,11 @@ # Multiple resource managers are installed and have jobs, # bouce back to the user to specify which one they want. - printf + print "Error, multiple active resource managers detected, use -Ormgr=\n"; push @installed, 'local-fd'; push @installed, 'local'; - printf "@installed\n"; + print "@installed\n"; exit(1); } @@ -2967,7 +2967,7 @@ $l .= '.'; } } - printf "$l\n"; + print "$l\n"; return; } @@ -3184,10 +3184,10 @@ push( @{ $lines->{lines}{$key} }, $value ); } } else { - printf "debug $1.$2: $3\n"; + print "debug $1.$2: $3\n"; } } else { - printf "malformed line: $line"; + print "malformed line: $line"; } return; } @@ -3551,7 +3551,7 @@ } if ( $conf{verbose} and defined $req->{cargs} ) { - printf "Mode '$req->{mode}' mode specific flags:\n"; + print "Mode '$req->{mode}' mode specific flags:\n"; foreach my $arg ( sort( keys( %{ $req->{cargs} } ) ) ) { if ( defined $req->{cargs}{$arg} ) { printf "%20s : '%s'\n", $arg, $req->{cargs}{$arg}; @@ -3568,7 +3568,7 @@ my ( $key, $data ) = @_; my %c; $c{i} = length($key); - printf "$key : ranks\n"; + print "$key : ranks\n"; foreach my $value ( sort( keys( %{$data} ) ) ) { printf "%$c{i}s : %s\n", $value, rng_convert_to_user( $data->{$value} ); } @@ -3600,12 +3600,12 @@ return if ( $conf{check_signon} eq 'missing' ); if ( keys( %{ $data->{target_data}{name} } ) != 1 ) { - printf "Warning, remote process name differs across ranks\n"; + print "Warning, remote process name differs across ranks\n"; report_failed_signon( 'name', \%{ $data->{target_data}{name} } ); } if ( keys( %{ $data->{target_data}{state} } ) != 1 ) { - printf "Warning, remote process state differs across ranks\n"; + print "Warning, remote process state differs across ranks\n"; report_failed_signon( 'state', \%{ $data->{target_data}{state} } ); } return; @@ -3696,12 +3696,12 @@ my $mode = $comm_data->{current_req}->{mode}; if ( defined $d->{target_data}{error} ) { - printf "Warning: errors reported by some ranks\n========\n"; + print "Warning: errors reported by some ranks\n========\n"; foreach my $error ( sort( keys( %{ $d->{target_data}{error} } ) ) ) { printf "%s: $error\n", rng_convert_to_user( $d->{target_data}{error}{$error} ); } - printf "========\n"; + print "========\n"; } if ( defined( $allfns{$mode}{out_handler} ) ) { @@ -3739,7 +3739,7 @@ # Children connect back with "Hello $outerkey $hostname $port $innernkey"; my @words = split( " ", $line ); if ( $#words != 4 or $words[0] ne 'Hello' or $words[1] ne $secret ) { - printf "Bad signon $line\n"; + print "Bad signon $line\n"; return 0; } @@ -3781,10 +3781,10 @@ my ( $comm_data, $cdata ) = @_; if ( $comm_data->{state} ne 'shutdown' ) { - printf "Unexpected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"; + print "Unexpected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"; } - #printf("Expected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); + #print("Expected EOF from $cdata->{fd_desc} ($comm_data->{state})\n"); return; } @@ -4123,7 +4123,7 @@ my $cdata = $comm_data->{sockets}{$h}; $cdata->{event_cb}( $comm_data, $h ); } else { - printf "Responce from unknown fd $h\n"; + print "Responce from unknown fd $h\n"; exit(1); } } @@ -4143,19 +4143,19 @@ my $res = $?; if ( $comm_data->{state} ne 'shutdown' ) { - printf + print "Unexpected exit from parallel command (state=$comm_data->{state})\n"; } - printf "result from parallel command is $res (state=$comm_data->{state})\n" + print "result from parallel command is $res (state=$comm_data->{state})\n" if ( $conf{verbose} ); if ( $res != 0 ) { my %status = rc_status($res); if ( job_is_running($jobid) ) { - printf + print "Bad exit code from parallel command (exit_code=$status{rc})\n"; } else { - printf "Job $jobid is no longer active\n"; + print "Job $jobid is no longer active\n"; return 1; } } @@ -4167,7 +4167,7 @@ my $file = "$ENV{HOME}/.padb-secret"; if ( !-f $file ) { - printf "No secret file ($file)\n"; + print "No secret file ($file)\n"; return; } my ( @@ -4177,7 +4177,7 @@ # Check that the file is mode 100600 (Octal) if ( $mode != 33152 ) { - printf "Wrong permissions on secret file, should be 0600 ($file)\n"; + print "Wrong permissions on secret file, should be 0600 ($file)\n"; exit(1); } @@ -4205,7 +4205,7 @@ $secret = find_padb_secret(); if ( not defined $secret ) { - printf "Error: Could not load secret file on this node\n"; + print "Error: Could not load secret file on this node\n"; exit(1); } @@ -4230,8 +4230,8 @@ $cmd .= " $0 --inner"; if ( not defined $hosts ) { - printf "Full duplex mode needs to know the host count\n"; - printf "Which is doesn't for this resource manager: $conf{rmgr}\n"; + print "Full duplex mode needs to know the host count\n"; + print "Which is doesn't for this resource manager: $conf{rmgr}\n"; return 1; } my $errors = go_parallel( $jobid, $cmd, $ncpus, $hosts ); @@ -4283,10 +4283,10 @@ sub config_set { my ( $key, $value ) = @_; - printf "Setting '$key' to '$value'\n" if ( $conf{verbose} ); + print "Setting '$key' to '$value'\n" if ( $conf{verbose} ); if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { - printf STDERR "Warning, unknown config option '$key' value '$value'.\n"; + print STDERR "Warning, unknown config option '$key' value '$value'.\n"; } config_set_internal( $key, $value ); @@ -4296,7 +4296,7 @@ sub config_from_file { my $file = shift; - printf "Loading config from \"$file\"\n" if ( $conf{verbose} ); + print "Loading config from \"$file\"\n" if ( $conf{verbose} ); open( my $CFILE, $file ) or return; while (<$CFILE>) { @@ -4312,7 +4312,7 @@ } sub config_from_env { - printf "Loading config from environment\n" if ( $conf{verbose} ); + print "Loading config from environment\n" if ( $conf{verbose} ); foreach my $key ( keys(%conf) ) { $key =~ s/\-/\_/g; @@ -4333,7 +4333,7 @@ } sub config_help { - printf "Current options are:\n"; + print "Current options are:\n"; my $max_len = 0; @@ -4356,7 +4356,7 @@ } foreach my $mode ( sort( keys( %{ $conf{mode_options} } ) ) ) { - printf "\nOptions for mode '$allfns{$mode}{arg_long}'\n"; + print "\nOptions for mode '$allfns{$mode}{arg_long}'\n"; foreach my $key ( sort( keys( %{ $conf{mode_options}{$mode} } ) ) ) { my $name = $key; $name =~ s/\_/\-/g; @@ -4391,7 +4391,7 @@ config_from_env(); - printf "Loading config from command line\n" if ( $conf{verbose} ); + print "Loading config from command line\n" if ( $conf{verbose} ); # # Once again there is a 'bugette' here, you cant pass the @@ -4409,7 +4409,7 @@ $key =~ s/\-/\_/g; if ( $key eq 'scriptDir' ) { - printf( + print( "$prog: -OscriptDir deprecated, use -Oedb=/path/to/edb instead\n" ); exit(1); @@ -4418,12 +4418,12 @@ if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { - printf "Error, unknown config option '$name'\n"; + print "Error, unknown config option '$name'\n"; config_help(); exit(1); } if ( !defined $val ) { - printf "Error, config option '$name' requires value\n"; + print "Error, config option '$name' requires value\n"; config_help(); exit(1); } @@ -4442,16 +4442,16 @@ my $r = $res; if ( $working eq 'yes' ) { - printf "$r: "; + print "$r: "; my @jobs = $rmgr{$res}{get_active_jobs}($user); if ( $#jobs > -1 ) { my $j = join( " ", sortn(@jobs) ); - printf "jobs($j)\n"; + print "jobs($j)\n"; } else { - printf "No active jobs\n"; + print "No active jobs\n"; } } else { - printf "$r: not active\n"; + print "$r: not active\n"; } } exit(0); @@ -4459,16 +4459,16 @@ if ($core_stack) { if ( not defined $core_name or not defined $exe_name ) { - printf + print "Usage $0 --core-stack --core= --exe=\n"; exit(1); } if ( not -f $exe_name ) { - printf "Error: executable file '$exe_name' does not exist!\n"; + print "Error: executable file '$exe_name' does not exist!\n"; exit(1); } if ( not -f $core_name ) { - printf "Error: core file '$core_name' does not exist!\n"; + print "Error: core file '$core_name' does not exist!\n"; exit(1); } stack_from_core( $exe_name, $core_name ); @@ -4480,13 +4480,13 @@ find_rmgr(); if ( not job_is_running($full_report) ) { - printf STDERR + print STDERR "Job $full_report is not active, use --show-jobs to see active jobs\n"; exit(1); } - printf "padb version $version\n"; - printf "full job report for job $full_report\n\n"; + print "padb version $version\n"; + print "full job report for job $full_report\n\n"; push_command( 'mqueue', 'compress' ); @@ -4601,19 +4601,19 @@ if ( job_is_running($jobid) ) { push @jobids, $jobid; } else { - printf STDERR "Job $jobid is not active\n"; + print STDERR "Job $jobid is not active\n"; } } } if ( $#jobids > 0 and $watch ) { - printf "Cannot use --watch with more than one job\n"; + print "Cannot use --watch with more than one job\n"; exit(1); } foreach my $jobid (@jobids) { - printf "\nCollecting information for job '$jobid'\n\n" + print "\nCollecting information for job '$jobid'\n\n" if ( $conf{verbose} or ( $#jobids > 0 ) ); my $of; @@ -4855,7 +4855,7 @@ } } - printf "ident $indent\n"; + print "ident $indent\n"; return; } @@ -4881,7 +4881,7 @@ } } - printf "ident $indent\n"; + print "ident $indent\n"; return; } @@ -5151,7 +5151,7 @@ $res = $image; } } else { - printf "Unhandled query $query\n"; + print "Unhandled query $query\n"; } if ( defined $res ) { return "ok $res"; @@ -5761,12 +5761,12 @@ foreach my $thread ( sort { $a->{id} <=> $b->{id} } @threads ) { my @frames = @{ $thread->{frames} }; - printf "ThreadId: $thread->{id}\n" if ( $#threads != 0 ); + print "ThreadId: $thread->{id}\n" if ( $#threads != 0 ); for ( my $i = $#frames ; $i >= 0 ; $i-- ) { my $frame = $frames[$i]; - printf "ERROR: $$frame{error}\n" + print "ERROR: $$frame{error}\n" if exists $$frame{error}; next unless exists $$frame{level}; @@ -5784,14 +5784,14 @@ my $a = join( ", ", @a ); my $file = $frame->{file} || "?"; my $line = $frame->{line} || "?"; - printf "$frame->{func}($a) at $file:$line\n"; + print "$frame->{func}($a) at $file:$line\n"; if ( $conf{stack_shows_locals} ) { foreach my $arg ( @{ $frame->{locals} } ) { if ( defined $frame->{vals}{$arg} ) { - printf(" $arg = $frame->{vals}{$arg}\n"); + print(" $arg = $frame->{vals}{$arg}\n"); } else { - printf(" $arg = ??\n"); + print(" $arg = ??\n"); } } } @@ -7242,7 +7242,7 @@ $cdata->{dead} = 1; print("debug\n"); } else { - printf "Closing connection from $cdata->{desc} (Bad signon)\n"; + print "Closing connection from $cdata->{desc} (Bad signon)\n"; $netdata->{sel}->remove($s); $s->close(); $cdata->{dead} = 1; @@ -7373,7 +7373,7 @@ } } my $count = $sel->count(); - printf "Thats not supposed to happen count=($count)\n"; + print "Thats not supposed to happen count=($count)\n"; return; } From codesite-noreply at google.com Fri Sep 4 22:08:07 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 21:08:07 +0000 Subject: [padb-devel] [padb] r176 committed - Remove braces from calls to sort and exit. Message-ID: <001636ed69f99654f20472c6e588@google.com> Revision: 176 Author: apittman Date: Fri Sep 4 14:07:49 2009 Log: Remove braces from calls to sort and exit. http://code.google.com/p/padb/source/detail?r=176 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 13:26:58 2009 +++ /branches/cleanup/src/padb Fri Sep 4 14:07:49 2009 @@ -512,7 +512,7 @@ my $extra = ""; $extra .= "Modes of operation\n"; - foreach my $arg ( sort( keys %allfns ) ) { + foreach my $arg ( sort keys %allfns ) { next unless ( defined $allfns{$arg}{help} ); next if ( defined $allfns{$arg}{qsnet} ); if ( defined $allfns{$arg}{arg_short} ) { @@ -526,7 +526,7 @@ } $extra .= "\nQsNet specific modes\n"; - foreach my $arg ( sort( keys %allfns ) ) { + foreach my $arg ( sort keys %allfns ) { next unless ( defined $allfns{$arg}{help} ); next unless ( defined $allfns{$arg}{qsnet} ); if ( defined $allfns{$arg}{arg_short} ) { @@ -598,7 +598,7 @@ my ( $type, $handle, $str, @params ) = @_; if ( not exists $debugModes{$type} ) { print "Unknown debug mode: $type\n"; - exit(1); + exit 1; } return unless $debugModes{$type}; my $time = time() - $start_time; @@ -672,7 +672,7 @@ } } - GetOptions(%optionhash) or exit(1); + GetOptions(%optionhash) or exit 1; if ( defined $debugflag ) { foreach my $f ( split( ",", $debugflag ) ) { @@ -1735,14 +1735,14 @@ push( @{ $inactive{$number} }, $ident ); } } - foreach my $number ( sort ( keys %active ) ) { + foreach my $number ( sort keys %active ) { $ret .= $gstr . group_status_helper( "in call $number to $s", 0, $ad{$gid}{size}, @{ $active{$number} } ); $gstr = ""; } - foreach my $number ( sort ( keys %inactive ) ) { + foreach my $number ( sort keys %inactive ) { $ret .= group_status_helper( "completed call $number to $s", 1, $ad{$gid}{size}, @{ $inactive{$number} } ); } @@ -1992,7 +1992,7 @@ my ( $ref, $parent, $indent ) = @_; my $ret = ""; - my @peers = sort ( { $a->{vps}[0] <=> $b->{vps}[0] } ( @{$ref} ) ); + my @peers = sort { $a->{vps}[0] <=> $b->{vps}[0] } ( @{$ref} ); foreach my $peer (@peers) { @@ -2212,7 +2212,7 @@ foreach ( split( ",", $2 ) ) { if ( !m/([0-9]+)-?([0-9]+)?/ ) { print "malformed nodespec '$_'\n"; - exit(1); + exit 1; } if ( defined($2) ) { @@ -2232,7 +2232,7 @@ # no square braces, just node name, eg 'machine0' if ( !m/([^\[]+)([0-9]+)([^\[]*)/ ) { print "malformed nodespec '$_'\n"; - exit(1); + exit 1; } push( @nodeList, $1 . $2 . $3 ); @@ -2726,7 +2726,7 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { print "Error, resource manager \"$conf{rmgr}\" not supported\n"; - exit(1); + exit 1; } if ( defined $rmgr{ $conf{rmgr} }{is_installed} @@ -2740,7 +2740,7 @@ } my @ok; - foreach my $res ( sort( keys %rmgr ) ) { + foreach my $res ( sort keys %rmgr ) { next unless defined $rmgr{$res}{is_installed}; if ( $rmgr{$res}{is_installed}() ) { push @ok, $res; @@ -2752,7 +2752,7 @@ push @ok, 'local-fd'; push @ok, 'local'; print "@ok\n"; - exit(1); + exit 1; } setup_rmgr( $ok[0] ); @@ -2772,7 +2772,7 @@ if ( defined $conf{rmgr} ) { if ( not defined $rmgr{ $conf{rmgr} } ) { print "Error, resource manager \"$conf{rmgr}\" not supported\n"; - exit(1); + exit 1; } if ( defined $rmgr{ $conf{rmgr} }{is_installed} @@ -2786,7 +2786,7 @@ } my @installed; - foreach my $res ( sort( keys %rmgr ) ) { + foreach my $res ( sort keys %rmgr ) { next unless defined $rmgr{$res}{is_installed}; if ( $rmgr{$res}{is_installed}() ) { push @installed, $res; @@ -2807,7 +2807,7 @@ push @installed, 'local-fd'; push @installed, 'local'; print "@installed\n"; - exit(1); + exit 1; } my @active; @@ -2831,7 +2831,7 @@ push @installed, 'local-fd'; push @installed, 'local'; print "@installed\n"; - exit(1); + exit 1; } sub get_all_jobids { @@ -2978,7 +2978,7 @@ my ($r) = @_; my @all; - foreach my $value ( sort( keys( %{$r} ) ) ) { + foreach my $value ( sort keys( %{$r} ) ) { while ( defined( my $rank = rng_shift( $r->{$value} ) ) ) { $all[$rank] = $value; } @@ -3055,7 +3055,7 @@ my @all; my $lines = tree_from_namespace( $nlines->{target_data} ); - foreach my $tag ( sort ( keys %$lines ) ) { + foreach my $tag ( sort keys %$lines ) { my %hash; $hash{vp} = $tag; foreach my $key ( keys( %{ $lines->{$tag} } ) ) { @@ -3071,9 +3071,9 @@ } if ($show_fields) { - my @fields = sort ( keys(%hash) ); + my @fields = sort keys(%hash); print "@fields\n"; - exit(0); + exit 0; } push @all, \%hash; } @@ -3552,7 +3552,7 @@ if ( $conf{verbose} and defined $req->{cargs} ) { print "Mode '$req->{mode}' mode specific flags:\n"; - foreach my $arg ( sort( keys( %{ $req->{cargs} } ) ) ) { + foreach my $arg ( sort keys( %{ $req->{cargs} } ) ) { if ( defined $req->{cargs}{$arg} ) { printf "%20s : '%s'\n", $arg, $req->{cargs}{$arg}; } else { @@ -3569,7 +3569,7 @@ my %c; $c{i} = length($key); print "$key : ranks\n"; - foreach my $value ( sort( keys( %{$data} ) ) ) { + foreach my $value ( sort keys( %{$data} ) ) { printf "%$c{i}s : %s\n", $value, rng_convert_to_user( $data->{$value} ); } return; @@ -3629,7 +3629,7 @@ my ($td) = @_; my $ret = "\n"; - foreach my $name ( sort( keys( %{$td} ) ) ) { + foreach my $name ( sort keys( %{$td} ) ) { $ret .= "Namespace: \"$name\"\n"; foreach my $value ( sortn( keys( %{ $td->{$name} } ) ) ) { $ret .= " $value\t"; @@ -3697,7 +3697,7 @@ if ( defined $d->{target_data}{error} ) { print "Warning: errors reported by some ranks\n========\n"; - foreach my $error ( sort( keys( %{ $d->{target_data}{error} } ) ) ) { + foreach my $error ( sort keys( %{ $d->{target_data}{error} } ) ) { printf "%s: $error\n", rng_convert_to_user( $d->{target_data}{error}{$error} ); } @@ -4124,7 +4124,7 @@ $cdata->{event_cb}( $comm_data, $h ); } else { print "Responce from unknown fd $h\n"; - exit(1); + exit 1; } } } @@ -4178,7 +4178,7 @@ # Check that the file is mode 100600 (Octal) if ( $mode != 33152 ) { print "Wrong permissions on secret file, should be 0600 ($file)\n"; - exit(1); + exit 1; } open( my $SFD, $file ) or return; @@ -4206,7 +4206,7 @@ if ( not defined $secret ) { print "Error: Could not load secret file on this node\n"; - exit(1); + exit 1; } } @@ -4251,7 +4251,7 @@ sub cmdline_error { my $str = shift; print STDERR $str; - exit(1); + exit 1; } sub config_init { @@ -4344,7 +4344,7 @@ } } - foreach my $key ( sort( keys(%conf) ) ) { + foreach my $key ( sort keys(%conf) ) { next if ( ref( $conf{$key} ) eq 'HASH' ); my $name = $key; $name =~ s/\_/\-/g; @@ -4355,9 +4355,9 @@ } } - foreach my $mode ( sort( keys( %{ $conf{mode_options} } ) ) ) { + foreach my $mode ( sort keys( %{ $conf{mode_options} } ) ) { print "\nOptions for mode '$allfns{$mode}{arg_long}'\n"; - foreach my $key ( sort( keys( %{ $conf{mode_options}{$mode} } ) ) ) { + foreach my $key ( sort keys( %{ $conf{mode_options}{$mode} } ) ) { my $name = $key; $name =~ s/\_/\-/g; if ( defined $conf{mode_options}{$mode}{$key} ) { @@ -4412,7 +4412,7 @@ print( "$prog: -OscriptDir deprecated, use -Oedb=/path/to/edb instead\n" ); - exit(1); + exit 1; } if ( !exists $conf{$key} @@ -4420,18 +4420,18 @@ { print "Error, unknown config option '$name'\n"; config_help(); - exit(1); + exit 1; } if ( !defined $val ) { print "Error, config option '$name' requires value\n"; config_help(); - exit(1); + exit 1; } config_set( $key, $val ); } if ($list_rmgrs) { - foreach my $res ( sort( keys %rmgr ) ) { + foreach my $res ( sort keys %rmgr ) { my $working = 'yes'; if ( defined $rmgr{$res}{is_installed} @@ -4454,25 +4454,25 @@ print "$r: not active\n"; } } - exit(0); + exit 0; } if ($core_stack) { if ( not defined $core_name or not defined $exe_name ) { print "Usage $0 --core-stack --core= --exe=\n"; - exit(1); + exit 1; } if ( not -f $exe_name ) { print "Error: executable file '$exe_name' does not exist!\n"; - exit(1); + exit 1; } if ( not -f $core_name ) { print "Error: core file '$core_name' does not exist!\n"; - exit(1); + exit 1; } stack_from_core( $exe_name, $core_name ); - exit(0); + exit 0; } if ($full_report) { @@ -4482,7 +4482,7 @@ if ( not job_is_running($full_report) ) { print STDERR "Job $full_report is not active, use --show-jobs to see active jobs\n"; - exit(1); + exit 1; } print "padb version $version\n"; @@ -4496,14 +4496,14 @@ push_command( 'stack', 'tree', \%c ); go_job($full_report); - exit(0); + exit 0; } if ($show_jobs) { find_rmgr(); my @jobids = get_all_jobids($user); print("@jobids\n"); - exit(0); + exit 0; } if ($local_stats) { @@ -4517,7 +4517,7 @@ } else { local_stats(); } - exit(0); + exit 0; } if ( $all or $any ) { @@ -4574,7 +4574,7 @@ $m = $mode; } go_file( $input_file, $m ); - exit(0); + exit 0; } my @jobids; @@ -4608,7 +4608,7 @@ if ( $#jobids > 0 and $watch ) { print "Cannot use --watch with more than one job\n"; - exit(1); + exit 1; } foreach my $jobid (@jobids) { @@ -4684,7 +4684,7 @@ my ( $vp, $str ) = @_; $confInner{verbose}++; debug( $vp, "$str, '$@'" ); - exit(1); + exit 1; } sub is_parent_resmgr { @@ -5489,14 +5489,14 @@ push( @{ $inactive{$number} }, $ident ); } } - foreach my $number ( sort ( keys %active ) ) { + foreach my $number ( sort keys %active ) { $ret .= $gstr . group_status_helper( "in call $number to $s", 0, $ad{$gid}{size}, @{ $active{$number} } ); $gstr = ""; } - foreach my $number ( sort ( keys %inactive ) ) { + foreach my $number ( sort keys %inactive ) { $ret .= group_status_helper( "completed call $number to $s", 1, $ad{$gid}{size}, @{ $inactive{$number} } ); } @@ -7049,14 +7049,14 @@ my $newpid; if ( defined( $ip->{scripts} ) ) { - my @ppids = sort( @{ $ip->{scripts} } ); + my @ppids = sort @{ $ip->{scripts} }; $newpid = $ppids[0]; } # If there are any pids which aren't scripts then target the # first one. if ( defined( $ip->{notscripts} ) ) { - my @ppids = sort( @{ $ip->{notscripts} } ); + my @ppids = sort @{ $ip->{notscripts} }; $newpid = $ppids[0]; } my %pd; @@ -7204,7 +7204,7 @@ $h->flush(); $h->close(); } - exit(0); + exit 0; } # Send a reply to our parent, put a status of "ok" on for this @@ -7369,7 +7369,7 @@ # Should probably handle this better, if the outer or tree never signons # for whatever reason silently die as it's probably the best thing do to. if ( ( $sel->count() == 1 ) and ( ( $time - $stime ) > 30 ) ) { - exit(0); + exit 0; } } my $count = $sel->count(); @@ -7410,7 +7410,7 @@ $confInner{myld} = $ENV{LD_LIBRARY_PATH}; inner_loop_for_comms( $confInner{outer} ); - exit(0); + exit 0; } @@ -7679,4 +7679,4 @@ outer_main(); } -exit(0); +exit 0; From codesite-noreply at google.com Fri Sep 4 22:35:59 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 21:35:59 +0000 Subject: [padb-devel] [padb] r177 committed - Don't use braces for calls to push or keys either. Message-ID: <00163623aa373a30330472c7490e@google.com> Revision: 177 Author: apittman Date: Fri Sep 4 14:35:11 2009 Log: Don't use braces for calls to push or keys either. http://code.google.com/p/padb/source/detail?r=177 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 14:07:49 2009 +++ /branches/cleanup/src/padb Fri Sep 4 14:35:11 2009 @@ -553,7 +553,7 @@ # ############################################################################### -my $user = getpwuid($<); +my $user = getpwuid $<; my $rank_rng; my @target_groups; @@ -592,7 +592,7 @@ # the string or call dumper on the ref as well. # Enable with --debug=type1,type2=all my %debugModes; -my $start_time = time(); +my $start_time = time; sub debug_log { my ( $type, $handle, $str, @params ) = @_; @@ -665,7 +665,7 @@ } } if ( defined $allfns{$arg}{options_i} ) { - foreach my $o ( keys( %{ $allfns{$arg}{options_i} } ) ) { + foreach my $o ( keys %{ $allfns{$arg}{options_i} } ) { $conf{mode_options}{$arg}{$o} = $allfns{$arg}{options_i}{$o}; $conf{mode_options_reverse}{$o}{$arg} = 1; } @@ -684,7 +684,7 @@ } } if ( $debugModes{all} ) { - foreach my $mode ( keys(%debugModes) ) { + foreach my $mode ( keys %debugModes ) { if ( not defined $debugModes{$mode} ) { $debugModes{$mode} = $debugModes{all}; } @@ -916,11 +916,9 @@ my @vals; for ( my $j = 0 ; $j < 32 ; $j++ ) { if ( $d->{$bin}{raw}[$j] or $conf{show_all_stats} > 1 ) { - push( - @vals, - sprintf( '%9s: %10d', - $bin_names[$j], $d->{$bin}{raw}[$j] ) - ); + push @vals, + sprintf( '%9s: %10d', + $bin_names[$j], $d->{$bin}{raw}[$j] ); if ( $#vals == 2 ) { $ret .= sprintf( " %s\n", join( " ", @vals ) ); @@ -1315,7 +1313,7 @@ my $many = shift; my @ret; foreach my $single ( @{$many} ) { - push( @ret, summarise($single) ); + push @ret, summarise($single); } return \@ret; } @@ -1477,7 +1475,7 @@ foreach my $vp (@data) { my $parsed = parse_content( $vp, $header ); if ( defined $parsed ) { - push( @out, $parsed ); + push @out, $parsed; } } @@ -1511,7 +1509,7 @@ my $rng = rng_dup($rank_rng); while ( defined( my $rank = rng_shift($rng) ) ) { if ( defined $d->[$rank] ) { - push( @ret, summarise( $d->[$rank] ) ); + push @ret, summarise( $d->[$rank] ); } else { my $vps = $#{$d} + 1; print "Invalid rank $rank (0 to $vps)\n"; @@ -1530,14 +1528,14 @@ my $rng = rng_dup($rank_rng); while ( defined( my $rank = rng_shift($rng) ) ) { if ( defined $d->[$rank] ) { - print show_name $conf{stats_name}, $d->[$rank]; + print show_name( $conf{stats_name}, $d->[$rank] ); } else { my $vps = $#{$d} + 1; print "Invalid rank $rank (0 to $vps)\n"; } } } else { - print show_name $conf{stats_name}, total($d); + print show_name( $conf{stats_name}, total($d) ); } } @@ -1625,8 +1623,7 @@ $ad{$gid}{idents}{$ident}{'statistics'}++; - foreach - my $tally ( keys( %{ $this_group->{statistics}{Tally} } ) ) + foreach my $tally ( keys %{ $this_group->{statistics}{Tally} } ) { my $name = $this_group->{statistics}{Tally}{$tally}{'name'}; my $number = @@ -1696,7 +1693,7 @@ { my @identical; foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { - push( @identical, $ident ) + push @identical, $ident unless ( $ad{$gid}{'idents'}{$ident}{'statistics'} ); } if ( $#identical != -1 ) { @@ -1728,11 +1725,11 @@ and $ad{$gid}{'idents'}{$ident}{'active'}{$s} ) { my $number = $ad{$gid}{'idents'}{$ident}{'active'}{$s}; - push( @{ $active{$number} }, $ident ); + push @{ $active{$number} }, $ident; } elsif ( $ad{$gid}{'idents'}{$ident}{'inactive'}{$s} ) { my $number = $ad{$gid}{'idents'}{$ident}{'inactive'}{$s}; - push( @{ $inactive{$number} }, $ident ); + push @{ $inactive{$number} }, $ident; } } foreach my $number ( sort keys %active ) { @@ -1757,7 +1754,7 @@ if ( $ad{$gid}{'idents'}{$ident}{'statistics'} and not defined $ad{$gid}{'idents'}{$ident}{'active'} ) { - push( @inactive, $ident ); + push @inactive, $ident; } } if ( $#inactive != -1 ) { @@ -1769,7 +1766,7 @@ } } - my $count = keys(%ad); + my $count = keys %ad; if ( $count == 1 ) { my $use_str = ( $i_count == 1 ) ? "" : ' not'; @@ -1897,16 +1894,16 @@ if ( defined( $lines->{$tag2}[$level] ) and $line eq $lines->{$tag2}[$level] ) { - push( @identical, $tag2 ); + push @identical, $tag2; delete( $lines->{$tag2}[$level] ); } else { - push( @different, $tag2 ); + push @different, $tag2; } } } else { foreach my $dtag (@tags) { if ( $dtag != $tag ) { - push( @different, $dtag ); + push @different, $dtag; } } @@ -2219,12 +2216,12 @@ # square braces with range, eg 'machine[0-3]' for ( $i = $1 ; $i <= $2 ; $i++ ) { - push( @nodeList, $prefix . $i . $suffix ); + push @nodeList, $prefix . $i . $suffix; } } else { # no range, just suffix - push( @nodeList, $prefix . $1 . $suffix ); + push @nodeList, $prefix . $1 . $suffix; } } } else { @@ -2235,7 +2232,7 @@ exit 1; } - push( @nodeList, $1 . $2 . $3 ); + push @nodeList, $1 . $2 . $3; } } @@ -2541,7 +2538,7 @@ sub open_get_data { # Simply return if called more than once. - if ( keys(%open_jobs) != 0 ) { + if ( keys %open_jobs != 0 ) { return; } @@ -2978,7 +2975,7 @@ my ($r) = @_; my @all; - foreach my $value ( sort keys( %{$r} ) ) { + foreach my $value ( sort keys %{$r} ) { while ( defined( my $rank = rng_shift( $r->{$value} ) ) ) { $all[$rank] = $value; } @@ -2991,8 +2988,8 @@ my %res; - foreach my $namespace ( keys( %{$r} ) ) { - foreach my $value ( keys( %{ $r->{$namespace} } ) ) { + foreach my $namespace ( keys %{$r} ) { + foreach my $value ( keys %{ $r->{$namespace} } ) { while ( defined( my $rank = rng_shift( $r->{$namespace}{$value} ) ) ) { @@ -3058,7 +3055,7 @@ foreach my $tag ( sort keys %$lines ) { my %hash; $hash{vp} = $tag; - foreach my $key ( keys( %{ $lines->{$tag} } ) ) { + foreach my $key ( keys %{ $lines->{$tag} } ) { my $value = $lines->{$tag}{$key}; next unless defined $proc_format_lengths{$key} or $show_fields; @@ -3071,7 +3068,7 @@ } if ($show_fields) { - my @fields = sort keys(%hash); + my @fields = sort keys %hash; print "@fields\n"; exit 0; } @@ -3141,7 +3138,7 @@ foreach my $tag2 ( keys %$lines ) { next if ( $tag2 eq $tag ); if ( cmp_list( \@{ $lines->{$tag} }, \@{ $lines->{$tag2} } ) ) { - push( @identical, $tag2 ); + push @identical, $tag2; delete( $lines->{$tag2} ); } } @@ -3179,9 +3176,9 @@ my $key = $2; my $value = $3; if ( $value =~ /raw\:([A-Za-z0-9\+\/\=]*)/ ) { - push( @{ $lines->{base64}{$key} }, $1 ); + push @{ $lines->{base64}{$key} }, $1; } else { - push( @{ $lines->{lines}{$key} }, $value ); + push @{ $lines->{lines}{$key} }, $value; } } else { print "debug $1.$2: $3\n"; @@ -3234,7 +3231,7 @@ foreach my $tag2 ( keys %$lines ) { next if ( $tag2 eq $tag ); if ( cmp_list( \@{ $lines->{$tag} }, \@{ $lines->{$tag2} } ) ) { - push( @identical, $tag2 ); + push @identical, $tag2; delete( $lines->{$tag2} ); } } @@ -3255,8 +3252,8 @@ } } } else { - my $nprocesses = keys( %{ $d->{target_output} } ); - foreach my $process ( sortn( keys( %{ $d->{target_output} } ) ) ) { + my $nprocesses = keys %{ $d->{target_output} }; + foreach my $process ( sortn( keys %{ $d->{target_output} } ) ) { foreach my $line ( @{ $d->{target_output}{$process} } ) { if ( $nprocesses == 1 ) { print "$line\n"; @@ -3378,7 +3375,7 @@ my %comm_tree; foreach my $c (@b) { $comm_tree{$c}{parent} = $last; - push( @{ $comm_tree{$last}{children} }, $c ); + push @{ $comm_tree{$last}{children} }, $c; $last = $c; } @@ -3400,7 +3397,7 @@ my $root = shift( @{$a} ); my @joints; - push( @joints, $root ); + push @joints, $root; $comm_tree{root}{children}[0] = $root; @@ -3408,7 +3405,7 @@ foreach my $joint (@joints) { my @children = splice( @{$a}, 0, $width ); if ( $#children > -1 ) { - push( @leaves, @children ); + push @leaves, @children; @{ $comm_tree{$joint}{children} } = @children; } } @@ -3435,7 +3432,7 @@ debug_log( 'signon', undef, 'Received last signon, connecting to inner' ); - @{ $comm_data->{host_ids} } = sortn( keys( %{ $comm_data->{remote} } ) ); + @{ $comm_data->{host_ids} } = sortn( keys %{ $comm_data->{remote} } ); $comm_data->{connection_tree} = generate_comm_tree( $comm_data->{host_ids} ); @@ -3552,7 +3549,7 @@ if ( $conf{verbose} and defined $req->{cargs} ) { print "Mode '$req->{mode}' mode specific flags:\n"; - foreach my $arg ( sort keys( %{ $req->{cargs} } ) ) { + foreach my $arg ( sort keys %{ $req->{cargs} } ) { if ( defined $req->{cargs}{$arg} ) { printf "%20s : '%s'\n", $arg, $req->{cargs}{$arg}; } else { @@ -3569,7 +3566,7 @@ my %c; $c{i} = length($key); print "$key : ranks\n"; - foreach my $value ( sort keys( %{$data} ) ) { + foreach my $value ( sort keys %{$data} ) { printf "%$c{i}s : %s\n", $value, rng_convert_to_user( $data->{$value} ); } return; @@ -3599,12 +3596,12 @@ return if ( $conf{check_signon} eq 'missing' ); - if ( keys( %{ $data->{target_data}{name} } ) != 1 ) { + if ( keys %{ $data->{target_data}{name} } != 1 ) { print "Warning, remote process name differs across ranks\n"; report_failed_signon( 'name', \%{ $data->{target_data}{name} } ); } - if ( keys( %{ $data->{target_data}{state} } ) != 1 ) { + if ( keys %{ $data->{target_data}{state} } != 1 ) { print "Warning, remote process state differs across ranks\n"; report_failed_signon( 'state', \%{ $data->{target_data}{state} } ); } @@ -3629,9 +3626,9 @@ my ($td) = @_; my $ret = "\n"; - foreach my $name ( sort keys( %{$td} ) ) { + foreach my $name ( sort keys %{$td} ) { $ret .= "Namespace: \"$name\"\n"; - foreach my $value ( sortn( keys( %{ $td->{$name} } ) ) ) { + foreach my $value ( sortn( keys %{ $td->{$name} } ) ) { $ret .= " $value\t"; $ret .= rng_convert_to_user( $td->{$name}{$value} ) . "\n"; } @@ -3697,7 +3694,7 @@ if ( defined $d->{target_data}{error} ) { print "Warning: errors reported by some ranks\n========\n"; - foreach my $error ( sort keys( %{ $d->{target_data}{error} } ) ) { + foreach my $error ( sort keys %{ $d->{target_data}{error} } ) { printf "%s: $error\n", rng_convert_to_user( $d->{target_data}{error}{$error} ); } @@ -3899,7 +3896,7 @@ } else { confess("Failed to recognise $part as range\n"); } - push( @parts, \%part ); + push @parts, \%part; } return \@parts; } @@ -3910,9 +3907,9 @@ my @entries; foreach my $part ( @{$rg} ) { if ( $part->{l} == $part->{u} ) { - push( @entries, $part->{l} ); + push @entries, $part->{l}; } else { - push( @entries, "$part->{l}-$part->{u}" ); + push @entries, "$part->{l}-$part->{u}"; } } my $range = join( ",", @entries ); @@ -3938,13 +3935,13 @@ my ( $rg, $value ) = @_; if ( ref( $rg->[0] ) eq "" ) { - push( @{$rg}, { 'l' => $value, 'u' => $value } ); + push @{$rg}, { 'l' => $value, 'u' => $value }; return; } # If it's after the last value then just add it. if ( $value > $rg->[-1]->{u} + 1 ) { - push( @{$rg}, { 'l' => $value, 'u' => $value } ); + push @{$rg}, { 'l' => $value, 'u' => $value }; return; } @@ -4069,7 +4066,7 @@ $comm_data->{sockets}{$sl} = \%cdata; } - map { $cmd .= " --$_=\"$cinner_cmd{$_}\"" } keys(%cinner_cmd); + map { $cmd .= " --$_=\"$cinner_cmd{$_}\"" } keys %cinner_cmd; debug_log( 'show_cmd', undef, $cmd ); @@ -4265,7 +4262,7 @@ if ( exists $conf{$key} ) { $conf{$key} = $value; } else { - foreach my $mode ( keys( %{ $conf{mode_options_reverse}{$key} } ) ) { + foreach my $mode ( keys %{ $conf{mode_options_reverse}{$key} } ) { $conf{mode_options}{$mode}{$key} = $value; } } @@ -4314,7 +4311,7 @@ sub config_from_env { print "Loading config from environment\n" if ( $conf{verbose} ); - foreach my $key ( keys(%conf) ) { + foreach my $key ( keys %conf ) { $key =~ s/\-/\_/g; my $name = 'PADB_' . uc($key); if ( defined $ENV{$name} ) { @@ -4322,7 +4319,7 @@ } } - foreach my $key ( keys( %{ $conf{mode_options_reverse} } ) ) { + foreach my $key ( keys %{ $conf{mode_options_reverse} } ) { $key =~ s/\-/\_/g; my $name = 'PADB_' . uc($key); if ( defined $ENV{$name} ) { @@ -4337,14 +4334,14 @@ my $max_len = 0; - foreach my $key ( keys(%conf) ) { + foreach my $key ( keys %conf ) { next if ( ref( $conf{$key} ) eq 'HASH' ); if ( length $key > $max_len ) { $max_len = length $key; } } - foreach my $key ( sort keys(%conf) ) { + foreach my $key ( sort keys %conf ) { next if ( ref( $conf{$key} ) eq 'HASH' ); my $name = $key; $name =~ s/\_/\-/g; @@ -4355,9 +4352,9 @@ } } - foreach my $mode ( sort keys( %{ $conf{mode_options} } ) ) { + foreach my $mode ( sort keys %{ $conf{mode_options} } ) { print "\nOptions for mode '$allfns{$mode}{arg_long}'\n"; - foreach my $key ( sort keys( %{ $conf{mode_options}{$mode} } ) ) { + foreach my $key ( sort keys %{ $conf{mode_options}{$mode} } ) { my $name = $key; $name =~ s/\_/\-/g; if ( defined $conf{mode_options}{$mode}{$key} ) { @@ -4657,7 +4654,7 @@ carp('no output'); } - push( @{ $inner_output{$vp} }, $str ); + push @{ $inner_output{$vp} }, $str; return; } @@ -5089,7 +5086,7 @@ return unless ( $p{status} eq 'done' ); my $val = gdb_parse_reason( $p{reason}, 'thread-ids' ); - push( @d, @{ $val->{memory}[0]{data} } ); + push @d, @{ $val->{memory}[0]{data} }; } while ( $offset < $size ); return @d[ 0 .. $size - 1 ]; @@ -5199,11 +5196,11 @@ debug( $vp, "Failed dll request $r\n" ); } } else { - push( @mq, $r ); + push @mq, $r; } } - my $sc = keys(%stats); + my $sc = keys %stats; waitpid( $h->{hpid}, 0 ); close( $h->{rdr} ); @@ -5321,7 +5318,7 @@ my $gdb = gdb_start(); if ( gdb_attach( $gdb, $pid ) ) { $proc->{gdb} = $gdb; - push( @all, $proc ); + push @all, $proc; } else { if ( defined $gdb->{error} ) { target_error( $vp, $gdb->{error} ); @@ -5369,7 +5366,7 @@ my $gdb = gdb_start(); if ( gdb_attach( $gdb, $pid ) ) { $proc->{gdb} = $gdb; - push( @all, $proc ); + push @all, $proc; } else { output $vp, 'Failed to attach to to process'; } @@ -5410,9 +5407,9 @@ } } - foreach my $process ( keys( %{$cd} ) ) { + foreach my $process ( keys %{$cd} ) { my $rd = $cd->{$process}; - foreach my $g ( keys( %{$rd} ) ) { + foreach my $g ( keys %{$rd} ) { my $gd = $rd->{$g}; my $gid = $gd->{id}; @@ -5432,7 +5429,7 @@ } $ad{$gid}{size} = $gd->{size}; $ad{$gid}{name} = $gd->{name}; - foreach my $coll ( keys( %{ $gd->{coll} } ) ) { + foreach my $coll ( keys %{ $gd->{coll} } ) { my $count = $gd->{coll}{$coll}{count}; if ( defined $gd->{coll}{$coll}{active} ) { $ad{$gid}{active}{$coll}++; @@ -5482,11 +5479,11 @@ and $ad{$gid}{'idents'}{$ident}{'active'}{$s} ) { my $number = $ad{$gid}{'idents'}{$ident}{'active'}{$s}; - push( @{ $active{$number} }, $ident ); + push @{ $active{$number} }, $ident; } elsif ( $ad{$gid}{'idents'}{$ident}{'inactive'}{$s} ) { my $number = $ad{$gid}{'idents'}{$ident}{'inactive'}{$s}; - push( @{ $inactive{$number} }, $ident ); + push @{ $inactive{$number} }, $ident; } } foreach my $number ( sort keys %active ) { @@ -5511,7 +5508,7 @@ my @inactive; foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { if ( not defined $ad{$gid}{'idents'}{$ident}{'active'} ) { - push( @inactive, $ident ); + push @inactive, $ident; } } if ( $#inactive != -1 ) { @@ -5523,7 +5520,7 @@ } } - my $count = keys(%ad); + my $count = keys %ad; if ( $count == 1 ) { my $use_str = ( $i_count == 1 ) ? "" : ' not'; @@ -5551,7 +5548,7 @@ } my %coll_data; - foreach my $rank ( keys( %{$data} ) ) { + foreach my $rank ( keys %{$data} ) { my $r = $data->{$rank}; my %lid; foreach my $line ( @{$r} ) { @@ -5674,7 +5671,7 @@ my %t; $t{id} = 0; @{ $t{frames} } = gdb_dump_frames( $gdb, $detail ); - push( @th, \%t ); + push @th, \%t; return @th; } foreach my $thread ( @{ $data->{'thread-ids'} } ) { @@ -5683,7 +5680,7 @@ $t{id} = $id; gdb_send( $gdb, "-thread-select $id" ); @{ $t{frames} } = gdb_dump_frames( $gdb, $detail ); - push( @th, \%t ); + push @th, \%t; } return @th; } @@ -5776,9 +5773,9 @@ my @a; foreach my $arg ( @{ $frame->{params} } ) { if ( defined $frame->{vals}{$arg} ) { - push( @a, "$arg = $frame->{vals}{$arg}" ); + push @a, "$arg = $frame->{vals}{$arg}"; } else { - push( @a, "$arg = ??" ); + push @a, "$arg = ??"; } } my $a = join( ", ", @a ); @@ -6010,7 +6007,7 @@ } } } - push( @all_fddata, \%fdhash ); + push @all_fddata, \%fdhash; } foreach my $fd (@all_fddata) { if ( defined $fd->{pos} ) { @@ -6282,7 +6279,7 @@ my $gdb = gdb_start(); if ( gdb_attach( $gdb, $pid ) ) { $proc->{gdb} = $gdb; - push( @all, $proc ); + push @all, $proc; } else { if ( defined $gdb->{error} ) { target_error( $vp, $gdb->{error} ); @@ -6444,9 +6441,9 @@ my @a; foreach my $arg ( @{ $frame->{params} } ) { if ( defined $frame->{vals}{$arg} ) { - push( @a, "$arg = $frame->{vals}{$arg}" ); + push @a, "$arg = $frame->{vals}{$arg}"; } else { - push( @a, "$arg = ??" ); + push @a, "$arg = ??"; } } my $a = join( ", ", @a ); @@ -6764,7 +6761,7 @@ my $hostname = $confInner{hostname}; - foreach my $rank ( keys( %{ $confInner{orte_data}{$hostname} } ) ) { + foreach my $rank ( keys %{ $confInner{orte_data}{$hostname} } ) { maybe_show_pid( $rank, $confInner{orte_data}{$hostname}{$rank} ); } return; @@ -6820,7 +6817,7 @@ debug( $vp, "Found $found vp $vp, pid: $proc->{pid}" ); - push( @{ $vps{$vp}{$found} }, $proc->{pid} ); + push @{ $vps{$vp}{$found} }, $proc->{pid}; } foreach my $vp ( keys %vps ) { @@ -6878,8 +6875,8 @@ $handle->{child_replys}++; # Combine the host responces. - foreach my $status ( keys( %{ $r->{host_responce} } ) ) { - foreach my $host ( keys( %{ $r->{host_responce}{$status} } ) ) { + foreach my $status ( keys %{ $r->{host_responce} } ) { + foreach my $host ( keys %{ $r->{host_responce}{$status} } ) { $handle->{all_replys}->{host_responce}{$status}{$host} = $r->{host_responce}{$status}{$host}; } @@ -6887,7 +6884,7 @@ # Combine the target process responces. if ( exists $r->{target_responce} ) { - foreach my $tp ( keys( %{ $r->{target_responce} } ) ) { + foreach my $tp ( keys %{ $r->{target_responce} } ) { $handle->{all_replys}->{target_responce}{$tp} = $r->{target_responce}{$tp}; } @@ -6895,7 +6892,7 @@ # Combine the target process responces from child. if ( exists $r->{target_output} ) { - foreach my $tp ( keys( %{ $r->{target_output} } ) ) { + foreach my $tp ( keys %{ $r->{target_output} } ) { $handle->{all_replys}->{target_output}{$tp} = $r->{target_output}{$tp}; } @@ -6903,14 +6900,14 @@ # Copy the target local responces. if ( exists $handle->{target_responce} ) { - foreach my $tp ( keys( %{ $handle->{target_responce} } ) ) { + foreach my $tp ( keys %{ $handle->{target_responce} } ) { $handle->{all_replys}->{target_responce}{$tp} = $handle->{target_responce}{$tp}; } } # Save any output we've got from this node. - foreach my $key ( keys(%inner_output) ) { + foreach my $key ( keys %inner_output ) { $handle->{all_replys}->{target_output}{$key} = $inner_output{$key}; } @@ -6919,8 +6916,8 @@ # Copy the network target errors into responce. if ( exists $r->{target_data} ) { if ( exists $handle->{all_replys}->{target_data} ) { - foreach my $key ( keys( %{ $r->{target_data} } ) ) { - foreach my $value ( keys( %{ $r->{target_data}{$key} } ) ) { + foreach my $key ( keys %{ $r->{target_data} } ) { + foreach my $value ( keys %{ $r->{target_data}{$key} } ) { if ( defined $handle->{all_replys} ->{target_data}{$key}{$value} ) @@ -6941,8 +6938,8 @@ } # Merge in local target responces. - foreach my $key ( keys(%local_target_data) ) { - foreach my $value ( keys( %{ $local_target_data{$key} } ) ) { + foreach my $key ( keys %local_target_data ) { + foreach my $value ( keys %{ $local_target_data{$key} } ) { if ( defined $handle->{all_replys}->{target_data}{$key}{$value} ) { rng_merge( $handle->{all_replys}->{target_data}{$key}{$value}, $local_target_data{$key}{$value} ); @@ -7036,14 +7033,14 @@ next unless defined $rmpid; if ( defined( $scripts{ pid_to_name($pid) } ) ) { - push( @{ $ipids->{$rmpid}{scripts} }, $pid ); + push @{ $ipids->{$rmpid}{scripts} }, $pid; } else { - push( @{ $ipids->{$rmpid}{notscripts} }, $pid ); + push @{ $ipids->{$rmpid}{notscripts} }, $pid; } } # Now chose what pid to target. - foreach my $key ( keys( %{$ipids} ) ) { + foreach my $key ( keys %{$ipids} ) { my $ip = $ipids->{$key}; my $newpid; @@ -7062,7 +7059,7 @@ my %pd; $pd{pid} = $newpid; $pd{vp} = $ip->{rank}; - push( @{ $confInner{all_pids} }, \%pd ); + push @{ $confInner{all_pids} }, \%pd; } return; @@ -7108,7 +7105,7 @@ $netdata->{signon_cmd} = my_encode($cmd); # Setup the environment. - foreach my $key ( keys( %{ $cmd->{cinner} } ) ) { + foreach my $key ( keys %{ $cmd->{cinner} } ) { $confInner{$key} = $cmd->{cinner}{$key}; } @@ -7259,7 +7256,7 @@ } # Save any output we've got from this node. - foreach my $key ( keys(%inner_output) ) { + foreach my $key ( keys %inner_output ) { $res->{target_output}{$key} = $inner_output{$key}; } From codesite-noreply at google.com Fri Sep 4 22:44:47 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 21:44:47 +0000 Subject: [padb-devel] [padb] r178 committed - Remove unnecessary quotes from hash keys, mainly in the stats reportin... Message-ID: <0016e6470f36bb0f3f0472c76820@google.com> Revision: 178 Author: apittman Date: Fri Sep 4 14:43:54 2009 Log: Remove unnecessary quotes from hash keys, mainly in the stats reporting code. http://code.google.com/p/padb/source/detail?r=178 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 14:35:11 2009 +++ /branches/cleanup/src/padb Fri Sep 4 14:43:54 2009 @@ -755,10 +755,10 @@ sub sum_attr { my ( $current, $sum_so_far ) = @_; - if ( defined $sum_so_far->{'raw'}[0] - and $sum_so_far->{'raw'}[0] != $current->{'raw'}[0] ) - { - $sum_so_far->{'raw'}[0] = undef; + if ( defined $sum_so_far->{raw}[0] + and $sum_so_far->{raw}[0] != $current->{raw}[0] ) + { + $sum_so_far->{raw}[0] = undef; } return $sum_so_far; @@ -768,26 +768,26 @@ my ( $current, $sum_so_far ) = @_; for ( my $j = 0 ; $j < 32 ; $j++ ) { - $sum_so_far->{'raw'}[$j] += $current->{'raw'}[$j]; + $sum_so_far->{raw}[$j] += $current->{raw}[$j]; } #check min if ( - ( $sum_so_far->{'raw'}[32] == -1 ) - or ( ( $current->{'raw'}[32] != -1 ) - and ( $current->{'raw'}[32] < $sum_so_far->{'raw'}[32] ) ) + ( $sum_so_far->{raw}[32] == -1 ) + or ( ( $current->{raw}[32] != -1 ) + and ( $current->{raw}[32] < $sum_so_far->{raw}[32] ) ) ) { - $sum_so_far->{'raw'}[32] = $current->{'raw'}[32]; + $sum_so_far->{raw}[32] = $current->{raw}[32]; } #check max - if ( $current->{'raw'}[33] > $sum_so_far->{'raw'}[33] ) { - $sum_so_far->{'raw'}[33] = $current->{'raw'}[33]; + if ( $current->{raw}[33] > $sum_so_far->{raw}[33] ) { + $sum_so_far->{raw}[33] = $current->{raw}[33]; } #total - $sum_so_far->{'raw'}[34] += $current->{'raw'}[34]; + $sum_so_far->{raw}[34] += $current->{raw}[34]; return $sum_so_far; } @@ -795,7 +795,7 @@ sub sum_counter { my ( $current, $sum_so_far ) = @_; - $sum_so_far->{'raw'}[0] += $current->{'raw'}[0]; + $sum_so_far->{raw}[0] += $current->{raw}[0]; return $sum_so_far; } @@ -803,7 +803,7 @@ my ( $current, $sum_so_far ) = @_; for ( my $j = 0 ; $j < 3 ; $j++ ) { - $sum_so_far->{'raw'}[$j] += $current->{'raw'}[$j]; + $sum_so_far->{raw}[$j] += $current->{raw}[$j]; } return $sum_so_far; @@ -1197,38 +1197,38 @@ } #add to each set of stats if it exists, else clone the new set - foreach my $name ( keys %{ $current_structure->{'subsystems'} } ) { - if ( $summed_structure->{'subsystems'}{$name} ) { + foreach my $name ( keys %{ $current_structure->{subsystems} } ) { + if ( $summed_structure->{subsystems}{$name} ) { foreach - my $id ( keys %{ $current_structure->{'subsystems'}{$name} } ) - { - if ( $summed_structure->{'subsystems'}{$name}{$id} ) { + my $id ( keys %{ $current_structure->{subsystems}{$name} } ) + { + if ( $summed_structure->{subsystems}{$name}{$id} ) { next unless ( - defined $current_structure->{'subsystems'}{$name} - {$id}{'statistics'} ); + defined $current_structure->{subsystems}{$name}{$id} + {statistics} ); if ( - not( $summed_structure->{'subsystems'}{$name}{$id} - {'statistics'} ) + not( $summed_structure->{subsystems}{$name}{$id} + {statistics} ) ) { - $summed_structure->{'subsystems'}{$name}{$id} - {'statistics'} = dclone( - $current_structure->{'subsystems'}{$name}{$id} - {'statistics'} ); + $summed_structure->{subsystems}{$name}{$id} + {statistics} = dclone( + $current_structure->{subsystems}{$name}{$id} + {statistics} ); next; } my %current_stat = - %{ $current_structure->{'subsystems'}{$name}{$id} - {'statistics'} }; + %{ $current_structure->{subsystems}{$name}{$id} + {statistics} }; my %summed_stat = - %{ $summed_structure->{'subsystems'}{$name}{$id} - {'statistics'} }; + %{ $summed_structure->{subsystems}{$name}{$id} + {statistics} }; #add to each type of stats if it exists, else copy #the new set @@ -1262,8 +1262,8 @@ } } } else { - $summed_structure->{'subsystems'}{$name}{$id} = dclone( - $current_structure->{'subsystems'}{$name}{$id} ); + $summed_structure->{subsystems}{$name}{$id} = dclone( + $current_structure->{subsystems}{$name}{$id} ); } } } else { @@ -1285,24 +1285,23 @@ 'Counter' => 0, 'Tally' => 0 ); - if ( defined $datastructure->{'vp'} ) { - $ret{'vp'} = $datastructure->{'vp'}; - } - foreach my $subsystem ( keys %{ $datastructure->{'subsystems'} } ) { - foreach my $id ( keys %{ $datastructure->{'subsystems'}{$subsystem} } ) - { + if ( defined $datastructure->{vp} ) { + $ret{vp} = $datastructure->{vp}; + } + foreach my $subsystem ( keys %{ $datastructure->{subsystems} } ) { + foreach my $id ( keys %{ $datastructure->{subsystems}{$subsystem} } ) { my $statistics = - $datastructure->{'subsystems'}{$subsystem}{$id}{'statistics'}; - foreach my $bin ( keys %{ $statistics->{'Bin'} } ) { + $datastructure->{subsystems}{$subsystem}{$id}{statistics}; + foreach my $bin ( keys %{ $statistics->{Bin} } ) { #Bin has a total value so just add that - $ret{'Bin'} += $statistics->{'Bin'}{$bin}{'raw'}[34]; - } - foreach my $counter ( keys %{ $statistics->{'Counter'} } ) { - $ret{'Counter'} += $statistics->{'Counter'}{$counter}{'raw'}[0]; - } - foreach my $tally ( keys %{ $statistics->{'Tally'} } ) { - $ret{'Tally'} += $statistics->{'Tally'}{$tally}{'raw'}[0]; + $ret{Bin} += $statistics->{Bin}{$bin}{raw}[34]; + } + foreach my $counter ( keys %{ $statistics->{Counter} } ) { + $ret{Counter} += $statistics->{Counter}{$counter}{raw}[0]; + } + foreach my $tally ( keys %{ $statistics->{Tally} } ) { + $ret{Tally} += $statistics->{Tally}{$tally}{raw}[0]; } } } @@ -1596,7 +1595,7 @@ foreach my $dataset ( @{$data_structures_aref} ) { # Loop over each group within the process. - foreach my $gid ( keys %{ $dataset->{'subsystems'}{'Group'} } ) { + foreach my $gid ( keys %{ $dataset->{subsystems}{Group} } ) { if ( $#target_groups != -1 ) { next unless defined $tg{$gid}; @@ -1604,11 +1603,11 @@ my $str; - my $this_group = $dataset->{'subsystems'}{'Group'}{$gid}; + my $this_group = $dataset->{subsystems}{Group}{$gid}; my $ident = $dataset->{vp}; - if ( $this_group->{'statistics'} ) { + if ( $this_group->{statistics} ) { # XXX: Why is this first test here, if ( $this_group->{statistics}{Attribute} @@ -1621,24 +1620,24 @@ if ( $conf{show_group_members} ); } - $ad{$gid}{idents}{$ident}{'statistics'}++; + $ad{$gid}{idents}{$ident}{statistics}++; foreach my $tally ( keys %{ $this_group->{statistics}{Tally} } ) { - my $name = $this_group->{statistics}{Tally}{$tally}{'name'}; + my $name = $this_group->{statistics}{Tally}{$tally}{name}; my $number = - $this_group->{statistics}{Tally}{$tally}{'raw'}[0]; + $this_group->{statistics}{Tally}{$tally}{raw}[0]; my $active = - $this_group->{statistics}{Tally}{$tally}{'raw'}[1]; + $this_group->{statistics}{Tally}{$tally}{raw}[1]; if ( $active != 0 ) { - $ad{$gid}{'active'}{$name}++; - $ad{$gid}{idents}{$ident}{'active'}{$name} = $number; + $ad{$gid}{active}{$name}++; + $ad{$gid}{idents}{$ident}{active}{$name} = $number; } else { - $ad{$gid}{idents}{$ident}{'inactive'}{$name} = $number; + $ad{$gid}{idents}{$ident}{inactive}{$name} = $number; } } } - $ad{$gid}{idents}{$ident}{'valid'} = $this_group->{'valid'}; + $ad{$gid}{idents}{$ident}{valid} = $this_group->{valid}; } } @@ -1669,8 +1668,8 @@ my $gone; { my @invalid; - foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { - if ( $ad{$gid}{'idents'}{$ident}{'valid'} == 0 ) { + foreach my $ident ( sort keys %{ $ad{$gid}{idents} } ) { + if ( $ad{$gid}{idents}{$ident}{valid} == 0 ) { push @invalid, $ident; } } @@ -1692,9 +1691,9 @@ # Find and report groups which don't have statistics { my @identical; - foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { + foreach my $ident ( sort keys %{ $ad{$gid}{idents} } ) { push @identical, $ident - unless ( $ad{$gid}{'idents'}{$ident}{'statistics'} ); + unless ( $ad{$gid}{idents}{$ident}{statistics} ); } if ( $#identical != -1 ) { $missing_self++; @@ -1712,23 +1711,22 @@ } } - if ( $ad{$gid}{'active'} ) { + if ( $ad{$gid}{active} ) { $i_count++; # For all collective calls which we are interested in - foreach my $s ( keys %{ $ad{$gid}{'active'} } ) { + foreach my $s ( keys %{ $ad{$gid}{active} } ) { my %active; my %inactive; - foreach my $ident ( keys %{ $ad{$gid}{'idents'} } ) { - if ( defined $ad{$gid}{'idents'}{$ident}{'active'} - and $ad{$gid}{'idents'}{$ident}{'active'}{$s} ) - { - my $number = $ad{$gid}{'idents'}{$ident}{'active'}{$s}; + foreach my $ident ( keys %{ $ad{$gid}{idents} } ) { + if ( defined $ad{$gid}{idents}{$ident}{active} + and $ad{$gid}{idents}{$ident}{active}{$s} ) + { + my $number = $ad{$gid}{idents}{$ident}{active}{$s}; push @{ $active{$number} }, $ident; - } elsif ( $ad{$gid}{'idents'}{$ident}{'inactive'}{$s} ) { - my $number = - $ad{$gid}{'idents'}{$ident}{'inactive'}{$s}; + } elsif ( $ad{$gid}{idents}{$ident}{inactive}{$s} ) { + my $number = $ad{$gid}{idents}{$ident}{inactive}{$s}; push @{ $inactive{$number} }, $ident; } } @@ -1750,9 +1748,9 @@ { my @inactive; - foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { - if ( $ad{$gid}{'idents'}{$ident}{'statistics'} - and not defined $ad{$gid}{'idents'}{$ident}{'active'} ) + foreach my $ident ( sort keys %{ $ad{$gid}{idents} } ) { + if ( $ad{$gid}{idents}{$ident}{statistics} + and not defined $ad{$gid}{idents}{$ident}{active} ) { push @inactive, $ident; } @@ -3301,9 +3299,9 @@ my $status = shift; my %rc; - $rc{'rc'} = $status >> 8; - $rc{'core'} = ( $status & 128 ) >> 7; - $rc{'signal'} = $status & 127; + $rc{rc} = $status >> 8; + $rc{core} = ( $status & 128 ) >> 7; + $rc{signal} = $status & 127; return %rc; } @@ -5433,10 +5431,9 @@ my $count = $gd->{coll}{$coll}{count}; if ( defined $gd->{coll}{$coll}{active} ) { $ad{$gid}{active}{$coll}++; - $ad{$gid}{idents}{ $gd->{rank} }{'active'}{$coll} = $count; + $ad{$gid}{idents}{ $gd->{rank} }{active}{$coll} = $count; } else { - $ad{$gid}{idents}{ $gd->{rank} }{'inactive'}{$coll} = - $count; + $ad{$gid}{idents}{ $gd->{rank} }{inactive}{$coll} = $count; } } } @@ -5466,23 +5463,22 @@ } } - if ( $ad{$gid}{'active'} ) { + if ( $ad{$gid}{active} ) { $i_count++; # For all collective calls which we are interested in - foreach my $s ( keys %{ $ad{$gid}{'active'} } ) { + foreach my $s ( keys %{ $ad{$gid}{active} } ) { my %active; my %inactive; - foreach my $ident ( keys %{ $ad{$gid}{'idents'} } ) { - if ( defined $ad{$gid}{'idents'}{$ident}{'active'} - and $ad{$gid}{'idents'}{$ident}{'active'}{$s} ) - { - my $number = $ad{$gid}{'idents'}{$ident}{'active'}{$s}; + foreach my $ident ( keys %{ $ad{$gid}{idents} } ) { + if ( defined $ad{$gid}{idents}{$ident}{active} + and $ad{$gid}{idents}{$ident}{active}{$s} ) + { + my $number = $ad{$gid}{idents}{$ident}{active}{$s}; push @{ $active{$number} }, $ident; - } elsif ( $ad{$gid}{'idents'}{$ident}{'inactive'}{$s} ) { - my $number = - $ad{$gid}{'idents'}{$ident}{'inactive'}{$s}; + } elsif ( $ad{$gid}{idents}{$ident}{inactive}{$s} ) { + my $number = $ad{$gid}{idents}{$ident}{inactive}{$s}; push @{ $inactive{$number} }, $ident; } } @@ -5506,8 +5502,8 @@ { my @inactive; - foreach my $ident ( sort keys %{ $ad{$gid}{'idents'} } ) { - if ( not defined $ad{$gid}{'idents'}{$ident}{'active'} ) { + foreach my $ident ( sort keys %{ $ad{$gid}{idents} } ) { + if ( not defined $ad{$gid}{idents}{$ident}{active} ) { push @inactive, $ident; } } From codesite-noreply at google.com Fri Sep 4 22:51:14 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 21:51:14 +0000 Subject: [padb-devel] [padb] r179 committed - Convert a number of variables to lowercase. Message-ID: <001636283c48cc4bdf0472c77fe8@google.com> Revision: 179 Author: apittman Date: Fri Sep 4 14:50:45 2009 Log: Convert a number of variables to lowercase. http://code.google.com/p/padb/source/detail?r=179 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 14:43:54 2009 +++ /branches/cleanup/src/padb Fri Sep 4 14:50:45 2009 @@ -575,7 +575,7 @@ my $input_file; my $compress; -my $compress_C; +my $compress_c; my $tree; my @config_options; @@ -638,7 +638,7 @@ 'any|A' => \$any, 'version|V' => \&show_version, 'compress|c' => \$compress, - 'compress-long|C' => \$compress_C, + 'compress-long|C' => \$compress_c, 'tree|t' => \$tree, 'input-file|file|i=s' => \$input_file, 'config-option|O=s' => \@config_options, @@ -1085,23 +1085,23 @@ $process_details{localid} = $raw_data[2]; $process_details{nlocal} = $raw_data[3]; - my $instBase = 4; - - while ( $instBase != 0 ) { - my $sysId = _hex( $raw_data[$instBase] ); - my $sysname = get_sub_name( $sysId, $header ); + my $instbase = 4; + + while ( $instbase != 0 ) { + my $sysid = _hex( $raw_data[$instbase] ); + my $sysname = get_sub_name( $sysid, $header ); my %inst; - $inst{sysId} = _hex( $raw_data[$instBase] ); - $inst{name} = get_sub_name( $sysId, $header ); - $inst{id} = _hex $raw_data[ $instBase + 1 ]; - $inst{handle} = $raw_data[ $instBase + 2 ]; - $inst{stats} = _hex $raw_data[ $instBase + 6 ]; - $inst{rail} = find_rail $raw_data[ $instBase + 4 ]; - $inst{next} = _hex $raw_data[ $instBase + 5 ]; - $inst{valid} = _hex $raw_data[ $instBase + 3 ]; - $inst{debugFlags} = $raw_data[ $instBase + 7 ]; + $inst{sysid} = _hex( $raw_data[$instbase] ); + $inst{name} = get_sub_name( $sysid, $header ); + $inst{id} = _hex $raw_data[ $instbase + 1 ]; + $inst{handle} = $raw_data[ $instbase + 2 ]; + $inst{stats} = _hex $raw_data[ $instbase + 6 ]; + $inst{rail} = find_rail $raw_data[ $instbase + 4 ]; + $inst{next} = _hex $raw_data[ $instbase + 5 ]; + $inst{valid} = _hex $raw_data[ $instbase + 3 ]; + $inst{debugFlags} = $raw_data[ $instbase + 7 ]; if ( $inst{stats} ) { my %stats; @@ -1110,7 +1110,7 @@ for ( my $type = 0 ; $type < $#stat_types + 1 ; $type++ ) { my $typename = $stat_types[$type]; - my $count = get_sub_stat_count( $inst{sysId}, $type, $header ); + my $count = get_sub_stat_count( $inst{sysid}, $type, $header ); next if $count == 0; my %type; @@ -1127,7 +1127,7 @@ $offset++; } $data{name} = - get_sub_stat_name( $inst{sysId}, $type, $idx, $header ); + get_sub_stat_name( $inst{sysid}, $type, $idx, $header ); $data{raw} = \@raw; $type{ $data{name} } = \%data; @@ -1139,11 +1139,11 @@ $process_details{complete} = 0; } - $instBase = $inst{next}; + $instbase = $inst{next}; delete $inst{stats}; delete $inst{next}; - delete $inst{sysId}; + delete $inst{sysid}; delete $inst{debugFlags} if ( !$inst{debugFlags} ); $process_details{subsystems}{ $inst{name} }{ $inst{id} } = \%inst; @@ -1909,10 +1909,10 @@ # Move $endlevel on as far as we can... if ( $#identical >= 0 ) { - my $nextIdentical; + my $nextidentical; do { - $nextIdentical = 0; - my $nextFound = 0; + $nextidentical = 0; + my $nextfound = 0; $endlevel++; if ( defined $lines->{$tag}[$endlevel] ) { foreach my $tag2 (@identical) { @@ -1920,14 +1920,14 @@ and $lines->{$tag}[$endlevel] eq $lines->{$tag2}[$endlevel] ) { - $nextFound++; + $nextfound++; } } } - if ( ( $#identical + 1 ) == $nextFound ) { - $nextIdentical = 1; - } - } while $nextIdentical; + if ( ( $#identical + 1 ) == $nextfound ) { + $nextidentical = 1; + } + } while $nextidentical; $endlevel--; } else { $endlevel = ( $#{ $lines->{$tag} } ); @@ -2190,16 +2190,16 @@ sub rms_job_to_nhosts { my $job = shift; - my $nodeSpec = `rmsquery "select hostnames from jobs where name=\'$job\'"`; - - chomp $nodeSpec; + my $nodespec = `rmsquery "select hostnames from jobs where name=\'$job\'"`; + + chomp $nodespec; my $i; - my @nodeList; + my @nodelist; my $prefix; my $suffix; # deal with multiple entries - foreach ( split( " ", $nodeSpec ) ) { + foreach ( split( " ", $nodespec ) ) { if (m/([^\[]+)\[([0-9-,]+)\]([^\[]*)/) { $prefix = $1; $suffix = $3; @@ -2214,12 +2214,12 @@ # square braces with range, eg 'machine[0-3]' for ( $i = $1 ; $i <= $2 ; $i++ ) { - push @nodeList, $prefix . $i . $suffix; + push @nodelist, $prefix . $i . $suffix; } } else { # no range, just suffix - push @nodeList, $prefix . $1 . $suffix; + push @nodelist, $prefix . $1 . $suffix; } } } else { @@ -2230,11 +2230,11 @@ exit 1; } - push @nodeList, $1 . $2 . $3; + push @nodelist, $1 . $2 . $3; } } - return $#nodeList + 1; + return $#nodelist + 1; } sub rms_res_to_partition { @@ -3147,7 +3147,7 @@ print("$data\n"); } } - } elsif ($compress_C) { + } elsif ($compress_c) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { print("----------------\n"); print("$tag\n"); @@ -4533,7 +4533,7 @@ ); } - my $style_count = ( grep { $_ } ( $compress, $compress_C, $tree ) ); + my $style_count = ( grep { $_ } ( $compress, $compress_c, $tree ) ); if ( $style_count > 1 ) { cmdline_error( "$prog: Error: only specify one of --compress, --compress-long or --tree\n" @@ -4614,7 +4614,7 @@ my $of; $of = 'tree' if $tree; $of = 'compress' if $compress; - $of = 'compress_c' if $compress_C; + $of = 'compress_c' if $compress_c; push_command( $mode, $of, $conf{mode_options}{$mode} ); go_job($jobid); } @@ -5855,7 +5855,7 @@ # Load the data about a given RMS job id, # return a array of hashes sub load_rms_procs { - my $jobId = shift; + my $job = shift; # This is actually perfectly legitimate, it's because you # can do for example allocate -N4 prun -N2 . Because @@ -5864,7 +5864,7 @@ # # Of course it could mean that whatever jobs were supposed # to be running on this node aren't. - open( my $PIDFILE, "/proc/rms/programs/$jobId/pids" ) or return; + open( my $PIDFILE, "/proc/rms/programs/$job/pids" ) or return; my @procs; From codesite-noreply at google.com Fri Sep 4 22:55:34 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 21:55:34 +0000 Subject: [padb-devel] [padb] r180 committed - Don't put braces round calls to chomp either. Message-ID: <001636283c483c89800472c78f11@google.com> Revision: 180 Author: apittman Date: Fri Sep 4 14:52:16 2009 Log: Don't put braces round calls to chomp either. http://code.google.com/p/padb/source/detail?r=180 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 14:50:45 2009 +++ /branches/cleanup/src/padb Fri Sep 4 14:52:16 2009 @@ -5996,7 +5996,7 @@ my @fdi = (<$FDI>); close $FDI; foreach my $fdi (@fdi) { - chomp($fdi); + chomp $fdi; my ( $key, $value ) = split( ":", $fdi ); $value =~ s/\t//g; $fdhash{$key} = $value; From codesite-noreply at google.com Fri Sep 4 23:03:50 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Fri, 04 Sep 2009 22:03:50 +0000 Subject: [padb-devel] [padb] r181 committed - Remove braces from calls to shift. Message-ID: <0016368e1fecdbe1d70472c7ac99@google.com> Revision: 181 Author: apittman Date: Fri Sep 4 15:03:20 2009 Log: Remove braces from calls to shift. http://code.google.com/p/padb/source/detail?r=181 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 14:52:16 2009 +++ /branches/cleanup/src/padb Fri Sep 4 15:03:20 2009 @@ -701,7 +701,7 @@ } if (@ranks) { - $rank_rng = rng_convert_from_user( shift(@ranks) ); + $rank_rng = rng_convert_from_user( shift @ranks ); foreach my $rank (@ranks) { rng_merge( $rank_rng, rng_convert_from_user($rank) ); @@ -3005,7 +3005,7 @@ my @all = array_from_target_namespace( $lines->{target_data}{state} ); my $o = ""; - while ( defined( my $v = shift(@all) ) ) { + while ( defined( my $v = shift @all ) ) { $o .= $v; } print("$o\n"); @@ -3392,7 +3392,7 @@ my @leaves; - my $root = shift( @{$a} ); + my $root = shift @{$a}; my @joints; push @joints, $root; @@ -3515,7 +3515,7 @@ if ($watch) { $cmd = $commands[0]; } else { - $cmd = shift(@commands); + $cmd = shift @commands; } my $req; @@ -3922,7 +3922,7 @@ my $value = $rg->[0]->{l}; if ( $rg->[0]->{l} == $rg->[0]->{u} ) { - shift( @{$rg} ); + shift @{$rg}; } else { $rg->[0]->{l}++; } @@ -3997,8 +3997,8 @@ sub rng_create_from_array { my (@r) = @_; - my $rng = rng_convert_from_user( shift(@r) ); - while ( defined( my $v = shift(@r) ) ) { + my $rng = rng_convert_from_user( shift @r ); + while ( defined( my $v = shift @r ) ) { rng_add_value( $rng, $v ); } return $rng; @@ -6029,7 +6029,7 @@ my $jiffies = 0; # Remove the "cpu" prefix. - shift(@usecc); + shift @usecc; foreach my $usecv (@usecc) { $jiffies += $usecv; } From codesite-noreply at google.com Sat Sep 5 01:28:37 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sat, 05 Sep 2009 00:28:37 +0000 Subject: [padb-devel] [padb] r182 committed - Factor out calls to opendir and friends to a pair of common functions, ... Message-ID: <005045017e329c1c7d0472c9b233@google.com> Revision: 182 Author: apittman Date: Fri Sep 4 17:28:14 2009 Log: Factor out calls to opendir and friends to a pair of common functions, slurm_dir and get_process_list, the first of which returns the same as readdir() and the latter returns the list of process directories found in proc for a specified user. http://code.google.com/p/padb/source/detail?r=182 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 15:03:20 2009 +++ /branches/cleanup/src/padb Fri Sep 4 17:28:14 2009 @@ -621,6 +621,29 @@ $debugModes{ctree} = undef; $debugModes{tdata} = undef; +sub slurp_dir { + my ($dir) = @_; + opendir( my $DIR, $dir ) or return; + my @files = readdir($DIR); + closedir($DIR); + return @files; +} + +sub get_process_list { + my ($user) = @_; + my $uid = getpwnam($user); + return unless defined $uid; + my @pids = slurp_dir('/proc'); + my @userpids; + foreach my $pid (@pids) { + next unless ( $pid =~ m{\A\d+\z}xms ); + my ( undef, undef, undef, undef, $owner ) = stat("/proc/$pid"); + next unless $owner == $uid; + push @userpids, $pid; + } + return @userpids; +} + sub parse_args_outer { Getopt::Long::Configure('bundling'); @@ -1822,9 +1845,7 @@ # Show stats for all jobs on this node. sub local_stats { - opendir( DH, '/proc/rms/programs' ); - my @files = readdir(DH); - closedir(DH); + my @files = slurp_dir('/proc/rms/programs'); foreach my $job (@files) { next if ( $job eq '..' ); @@ -2337,52 +2358,19 @@ sub local_get_jobs { my $user = shift; - opendir( DIR, '/proc/' ); - my @pids = readdir(DIR); - closedir(DIR); - my @jobs; - my $tuid = getpwnam($user); - return unless defined $tuid; - - foreach my $pid (@pids) { - next unless ( $pid =~ /^\d+$/ ); - - my ( - $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, - $size, $atime, $mtime, $ctime, $blksize, $blocks - ) = stat("/proc/$pid"); - - next unless ( $uid eq $tuid ); - - push @jobs, $pid; - } - - return @jobs; + return get_process_list($user); } sub local_fd_get_jobs_real { my $user = shift; my $file = shift; - opendir( DIR, '/proc/' ); - my @pids = readdir(DIR); - closedir(DIR); - my @jobs; - my $tuid = getpwnam($user); - return unless defined $tuid; - - foreach my $pid (@pids) { - next unless ( $pid =~ /^\d+$/ ); - - my ( - $dev, $ino, $mode, $nlink, $uid, $gid, $rdev, - $size, $atime, $mtime, $ctime, $blksize, $blocks - ) = stat("/proc/$pid"); - - next unless ( $uid eq $tuid ); - - opendir( DIR, "/proc/$pid/fd" ); - my @fds = readdir(DIR); - closedir(DIR); + + my @pids = get_process_list($user); + + my @jobs; + + foreach my $pid (@pids) { + my @fds = slurp_dir("/proc/$pid/fd"); foreach my $fd (@fds) { my $target = readlink("/proc/$pid/fd/$fd"); next unless $target; @@ -5975,9 +5963,7 @@ } if ( $carg->{proc_shows_fds} ) { - opendir( my $FDS, "$dir/fd" ); - my @fds = readdir($FDS); - closedir($FDS); + my @fds = slurp_dir("$dir/fd"); my @all_fddata; foreach my $fd (@fds) { next if ( $fd eq '.' ); @@ -6219,9 +6205,7 @@ my $threads = 0; # 2.6 kernel. (ntpl) - opendir( DIR, "/proc/$pid/task" ); - my @tasks = readdir(DIR); - closedir(DIR); + my @tasks = slurp_dir("/proc/$pid/task"); foreach my $task (@tasks) { next if ( $task eq '.' ); next if ( $task eq '..' ); @@ -6987,12 +6971,7 @@ # more interesting pids, in particular look for pids which appear to be # scripts and, if they have any children, look at the children instead. sub convert_pids_to_child_pids { - - opendir( DIR, '/proc/' ); - my @pids = readdir(DIR); - closedir(DIR); - - my $uid = $<; + my @pids = get_process_list( getpwuid $< ); my %scripts; map { $scripts{$_}++ } split( ",", $confInner{scripts} ); @@ -7001,13 +6980,6 @@ foreach my $pid (@pids) { - # Ignore entries that aren't numeric. - next unless ( $pid =~ /^\d+$/ ); - - # Ignore processes with the wrong ownership. - my ( undef, undef, undef, undef, $owner ) = stat("/proc/$pid"); - next unless $owner == $uid; - # The resource manager pid this pid is associated with. my $rmpid; From codesite-noreply at google.com Sat Sep 5 19:43:17 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sat, 05 Sep 2009 18:43:17 +0000 Subject: [padb-devel] [padb] r183 committed - Simplify rng_convert_to_user by using map to create the range list. Message-ID: <001485f7d6ce71bc310472d8fdaa@google.com> Revision: 183 Author: apittman Date: Sat Sep 5 11:42:29 2009 Log: Simplify rng_convert_to_user by using map to create the range list. http://code.google.com/p/padb/source/detail?r=183 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Fri Sep 4 17:28:14 2009 +++ /branches/cleanup/src/padb Sat Sep 5 11:42:29 2009 @@ -1965,7 +1965,9 @@ my %this; $this{txt} = $lines->{$tag}[$l]; @{ $this{vps} } = ( $tag, @identical ); - $this{vpspec} = compress( @identical, $tag ); + + $this{vpspec} = + rng_convert_to_user( rng_create_from_array( @{ $this{vps} } ) ); if ( defined $prev ) { push @{ $prev->{children} }, \%this; @@ -3890,15 +3892,8 @@ sub rng_convert_to_user { my ($rg) = @_; - my @entries; - foreach my $part ( @{$rg} ) { - if ( $part->{l} == $part->{u} ) { - push @entries, $part->{l}; - } else { - push @entries, "$part->{l}-$part->{u}"; - } - } - my $range = join( ",", @entries ); + my $range = join q{,}, + map { $_->{l} == $_->{u} ? $_->{l} : $_->{l} . q{-} . $_->{u} } @{$rg}; return "[$range]"; } From codesite-noreply at google.com Sat Sep 5 21:54:57 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sat, 05 Sep 2009 20:54:57 +0000 Subject: [padb-devel] [padb] r184 committed - Add two new functions, slurp_cmd and slurp_file which load and return... Message-ID: <0016e640d47e4f330f0472dad4ab@google.com> Revision: 184 Author: apittman Date: Sat Sep 5 13:54:28 2009 Log: Add two new functions, slurp_cmd and slurp_file which load and return the contents of a file or the output of a command using the correct open modes. http://code.google.com/p/padb/source/detail?r=184 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sat Sep 5 11:42:29 2009 +++ /branches/cleanup/src/padb Sat Sep 5 13:54:28 2009 @@ -621,6 +621,22 @@ $debugModes{ctree} = undef; $debugModes{tdata} = undef; +sub slurp_file { + my ($file) = @_; + open( my $FD, '<', $file ) or return; + my @contents = <$FD>; + close($FD); + return @contents; +} + +sub slurp_cmd { + my ($cmd) = @_; + open( my $CFD, '-|', $cmd ) or return; + my @out = <$CFD>; + close $CFD; + return @out; +} + sub slurp_dir { my ($dir) = @_; opendir( my $DIR, $dir ) or return; @@ -2420,9 +2436,7 @@ } sub mpd_get_data { - open( my $MPD, "mpdlistjobs|" ) or return; - my @out = <$MPD>; - close $MPD; + my @out = slurp_cmd('mpdlistjobs'); my %jobs; my $job; my $host; @@ -2533,9 +2547,7 @@ my $job; - open( my $open, "ompi-ps|" ) or return; - my @out = <$open>; - close $open; + my @out = slurp_cmd('ompi-ps'); # Handle being called multiple times, zero the hash every # time we are called. Of course we could just return the @@ -4159,9 +4171,7 @@ exit 1; } - open( my $SFD, $file ) or return; - my @l = <$SFD>; - close($SFD); + my @l = slurp_file($file); if ( $#l != 0 ) { return; } @@ -4275,17 +4285,16 @@ my $file = shift; print "Loading config from \"$file\"\n" if ( $conf{verbose} ); - open( my $CFILE, $file ) or return; - - while (<$CFILE>) { - if (/^([\w-]+)\s*\=\s*(.*)/) { + + foreach my $line ( slurp_file($file) ) { + if ( $line =~ /^([\w-]+)\s*\=\s*(.*)/ ) { my $key = $1; my $value = $2; $key =~ s/\-/\_/g; config_set( $key, $value ); } } - close($CFILE); + return; } @@ -5872,9 +5881,7 @@ sub show_task_file { my ( $vp, $file, $prefix ) = @_; return unless ( -f $file ); - open( my $FD, "$file" ) or return; - my @all = <$FD>; - close $FD; + my @all = slurp_file($file); foreach my $l (@all) { chomp $l; if ( defined $prefix ) { @@ -5898,11 +5905,8 @@ nswap cnswap exit_signal processor rt_ptiority policy delayacct_blkio_ticks guest_time cguest_time); return unless ( -f $file ); - open( my $FD, "$file" ) or return; - my @all = <$FD>; - close $FD; - - foreach my $l (@all) { + + foreach my $l ( slurp_file($file) ) { chomp $l; my @stats = split( / /, $l ); for ( my $i = 0 ; $i <= $#stats ; $i++ ) { @@ -5930,11 +5934,8 @@ } if ( -f "$dir/maps" ) { - open( my $MAP, "$dir/maps" ); - my @map = (<$MAP>); - close($MAP); my %totals; - foreach my $rgn (@map) { + foreach my $rgn ( slurp_file("$dir/maps") ) { my ( $area, $perm, $offset, $time, $inode, $file ) = split( " ", $rgn ); if ( $file =~ '/dev/elan4/sdram(\d+)' ) { @@ -5973,9 +5974,7 @@ # if requested by -O proc-shows-fds=full if ( $carg->{proc_shows_fds} eq 'full' ) { if ( -f "$dir/fdinfo/$fd" ) { - open( my $FDI, "$dir/fdinfo/$fd" ); - my @fdi = (<$FDI>); - close $FDI; + my @fdi = slurp_file("$dir/fdinfo/$fd"); foreach my $fdi (@fdi) { chomp $fdi; my ( $key, $value ) = split( ":", $fdi ); @@ -6501,10 +6500,8 @@ if ( defined $carg->{mpi_watch_file} ) { my %fns; - my $f = $carg->{mpi_watch_file}; - open( my $MW, $f ) or return; - my @d = (<$MW>); - close($MW); + + my @d = slurp_file( $carg->{mpi_watch_file} ); foreach my $mode (@d) { chomp $mode; @@ -6672,15 +6669,11 @@ my $pid = shift; my $key = shift; - open( my $PCMD, "/proc/$pid/status" ) or return; - while (<$PCMD>) { - my $l = $_; + foreach my $l ( slurp_file("/proc/$pid/status") ) { if ( $l =~ /$key:\t+(\w+)/ ) { - close $PCMD; return $1; } } - close $PCMD; return; } From codesite-noreply at google.com Sat Sep 5 22:26:26 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sat, 05 Sep 2009 21:26:26 +0000 Subject: [padb-devel] [padb] r185 committed - Wrap print(f) fd's in curly braces for clarity. Message-ID: <001636ed7841e6024f0472db4437@google.com> Revision: 185 Author: apittman Date: Sat Sep 5 14:25:28 2009 Log: Wrap print(f) fd's in curly braces for clarity. http://code.google.com/p/padb/source/detail?r=185 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sat Sep 5 13:54:28 2009 +++ /branches/cleanup/src/padb Sat Sep 5 14:25:28 2009 @@ -541,7 +541,7 @@ $usage =~ s!XXXX!$extra!; - print STDERR < $b } ( keys %$lines ) ) ); + print show_tree( + go_p( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); } elsif ($compress) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); @@ -3220,8 +3220,8 @@ } if ( $output eq 'tree' ) { - print show_tree go_p( 0, $lines, - ( sort { $a <=> $b } ( keys %$lines ) ) ); + print show_tree( + go_p( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); } elsif ( $output eq 'compress' ) { @@ -4238,7 +4238,7 @@ sub cmdline_error { my $str = shift; - print STDERR $str; + print {*STDERR} $str; exit 1; } @@ -4274,7 +4274,8 @@ print "Setting '$key' to '$value'\n" if ( $conf{verbose} ); if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { - print STDERR "Warning, unknown config option '$key' value '$value'.\n"; + print {*STDERR} + "Warning, unknown config option '$key' value '$value'.\n"; } config_set_internal( $key, $value ); @@ -4364,7 +4365,7 @@ my $mode = parse_args_outer(); if ( getpwnam($user) eq "" ) { - print STDERR "$prog: Error: no such user as '$user'\n"; + print {*STDERR} "$prog: Error: no such user as '$user'\n"; exit 1; } @@ -4467,7 +4468,7 @@ find_rmgr(); if ( not job_is_running($full_report) ) { - print STDERR + print {*STDERR} "Job $full_report is not active, use --show-jobs to see active jobs\n"; exit 1; } @@ -4588,7 +4589,7 @@ if ( job_is_running($jobid) ) { push @jobids, $jobid; } else { - print STDERR "Job $jobid is not active\n"; + print {*STDERR} "Job $jobid is not active\n"; } } } @@ -4770,7 +4771,7 @@ my ( $gdb, $cmd ) = @_; gdb_wait_for_prompt($gdb); my $handle = $gdb->{wtr}; - print $handle "$cmd\n"; + print {$handle} "$cmd\n"; my %r = gdb_n_next_result($gdb); $r{cmd} = $cmd; return %r; @@ -5177,7 +5178,7 @@ if ( $r =~ /^req:/ ) { my $res = handle_query( $gdb, $vp, $r, \%stats ); if ( defined $res ) { - print $out "$res\n"; + print {$out} "$res\n"; } # Some things *do* fail here, symbol lookups @@ -5730,7 +5731,7 @@ # Send a invalid command so the wait_for_prompt in dump_frames... can work. # Should probably do this in gdb_start() and return the output somehow. my $handle = $gdb->{wtr}; - print $handle "\n"; + print {$handle} "\n"; print "\n"; @@ -6460,8 +6461,8 @@ } my ( $fh, $file ) = tempfile('/tmp/padb.XXXXXXXX'); - print $fh "where full\n"; - print $fh "detach\n"; + print {$fh} "where full\n"; + print {$fh} "detach\n"; close $fh; foreach my $proc ( @{$list} ) { @@ -7193,7 +7194,7 @@ $netdata->{sel}->remove($s); $s->close(); $cdata->{dead} = 1; - print("debug\n"); + print "debug\n"; } else { print "Closing connection from $cdata->{desc} (Bad signon)\n"; $netdata->{sel}->remove($s); @@ -7259,7 +7260,7 @@ # For now just print the signon code to stdout and let the outer pick it up. my $signon_text = "connect $hostname $lport $key\n"; - print($signon_text); + print $signon_text; } my $netdata; From codesite-noreply at google.com Sat Sep 5 23:05:18 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sat, 05 Sep 2009 22:05:18 +0000 Subject: [padb-devel] [padb] r186 committed - Move away from using ! as regex delimiters. Message-ID: <001636284302ec109e0472dbcf1a@google.com> Revision: 186 Author: apittman Date: Sat Sep 5 15:04:21 2009 Log: Move away from using ! as regex delimiters. http://code.google.com/p/padb/source/detail?r=186 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sat Sep 5 14:25:28 2009 +++ /branches/cleanup/src/padb Sat Sep 5 15:04:21 2009 @@ -539,7 +539,8 @@ $allfns{$arg}{help} ); } - $usage =~ s!XXXX!$extra!; + $usage =~ s{XXXX} + {$extra}xms; print {*STDERR} < Revision: 187 Author: apittman Date: Sat Sep 5 16:44:45 2009 Log: Remove the quotes from the left hand side of hash assignments where possible. http://code.google.com/p/padb/source/detail?r=187 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sat Sep 5 15:04:21 2009 +++ /branches/cleanup/src/padb Sat Sep 5 16:44:45 2009 @@ -288,70 +288,70 @@ my %rmgr; $rmgr{rms} = { - 'is_installed' => \&rms_is_installed, - 'get_active_jobs' => \&rms_get_jobs, - 'job_is_running' => \&rms_job_is_running, - 'job_to_key' => \&rms_job_to_key, - 'setup_pcmd' => \&rms_setup_pcmd, - 'find_pids' => \&rms_find_pids, + is_installed => \&rms_is_installed, + get_active_jobs => \&rms_get_jobs, + job_is_running => \&rms_job_is_running, + job_to_key => \&rms_job_to_key, + setup_pcmd => \&rms_setup_pcmd, + find_pids => \&rms_find_pids, }; $rmgr{mpd} = { - 'is_installed' => \&mpd_is_installed, - 'get_active_jobs' => \&mpd_get_jobs, - 'setup_pcmd' => \&mpd_setup_pcmd, - 'cleanup_pcmd' => \&mpd_cleanup_pcmd, - 'find_pids' => \&mpd_find_pids, - 'require_inner_callback' => 1, + is_installed => \&mpd_is_installed, + get_active_jobs => \&mpd_get_jobs, + setup_pcmd => \&mpd_setup_pcmd, + cleanup_pcmd => \&mpd_cleanup_pcmd, + find_pids => \&mpd_find_pids, + require_inner_callback => 1, }; $rmgr{orte} = { - 'is_installed' => \&open_is_installed, - 'get_active_jobs' => \&open_get_jobs, - 'setup_pcmd' => \&open_setup_pcmd, - 'cleanup_pcmd' => \&open_cleanup_pcmd, - 'find_pids' => \&open_find_pids, + is_installed => \&open_is_installed, + get_active_jobs => \&open_get_jobs, + setup_pcmd => \&open_setup_pcmd, + cleanup_pcmd => \&open_cleanup_pcmd, + find_pids => \&open_find_pids, }; $rmgr{'lsf-rms'} = { - 'is_installed' => \&lsf_is_installed, - 'get_active_jobs' => \&lsf_get_jobs, - 'setup_pcmd' => \&lsf_setup_pcmd, - 'inner_rmgr' => 'rms', + is_installed => \&lsf_is_installed, + get_active_jobs => \&lsf_get_jobs, + setup_pcmd => \&lsf_setup_pcmd, + inner_rmgr => 'rms', }; $rmgr{slurm} = { - 'is_installed' => \&slurm_is_installed, - 'get_active_jobs' => \&slurm_get_jobs, - 'job_is_running' => \&slurm_job_is_running, - 'setup_pcmd' => \&slurm_setup_pcmd, - 'find_pids' => \&slurm_find_pids, - 'require_inner_callback' => 1, + is_installed => \&slurm_is_installed, + get_active_jobs => \&slurm_get_jobs, + job_is_running => \&slurm_job_is_running, + setup_pcmd => \&slurm_setup_pcmd, + find_pids => \&slurm_find_pids, + require_inner_callback => 1, }; $rmgr{local} = { - 'get_active_jobs' => \&local_get_jobs, - 'job_is_running' => \&local_job_is_running, - 'setup_pcmd' => \&local_setup_pcmd, - 'find_pids' => \&local_find_pids, - 'require_inner_callback' => 1, + get_active_jobs => \&local_get_jobs, + job_is_running => \&local_job_is_running, + setup_pcmd => \&local_setup_pcmd, + find_pids => \&local_find_pids, + require_inner_callback => 1, }; $rmgr{'local-qsnet'} = { - 'is_installed' => \&local_q_is_installed, - 'get_active_jobs' => \&local_q_get_jobs, - 'job_is_running' => \&local_job_is_running, - 'setup_pcmd' => \&local_setup_pcmd, - 'inner_rmgr' => 'local', - 'require_inner_callback' => 1, + is_installed => \&local_q_is_installed, + get_active_jobs => \&local_q_get_jobs, + job_is_running => \&local_job_is_running, + setup_pcmd => \&local_setup_pcmd, + inner_rmgr => 'local', + require_inner_callback => 1, }; $rmgr{'local-fd'} = { - 'get_active_jobs' => \&local_fd_get_jobs, - 'job_is_running' => \&local_job_is_running, - 'setup_pcmd' => \&local_setup_pcmd, - 'inner_rmgr' => 'local', - 'require_inner_callback' => 1, + get_active_jobs => \&local_fd_get_jobs, + job_is_running => \&local_job_is_running, + setup_pcmd => \&local_setup_pcmd, + inner_rmgr => 'local', + require_inner_callback => 1, }; ############################################################################### @@ -1321,9 +1321,9 @@ my $datastructure = shift; my %ret = ( - 'Bin' => 0, - 'Counter' => 0, - 'Tally' => 0 + Bin => 0, + Counter => 0, + Tally => 0 ); if ( defined $datastructure->{vp} ) { $ret{vp} = $datastructure->{vp}; @@ -1360,9 +1360,9 @@ sub collapse_summaries { my $summaries = shift; my %ret = ( - 'Bin' => 0, - 'Counter' => 0, - 'Tally' => 0 + Bin => 0, + Counter => 0, + Tally => 0 ); foreach my $summary ( @{$summaries} ) { foreach my $key ( keys %ret ) { @@ -3929,13 +3929,13 @@ my ( $rg, $value ) = @_; if ( ref( $rg->[0] ) eq "" ) { - push @{$rg}, { 'l' => $value, 'u' => $value }; + push @{$rg}, { l => $value, u => $value }; return; } # If it's after the last value then just add it. if ( $value > $rg->[-1]->{u} + 1 ) { - push @{$rg}, { 'l' => $value, 'u' => $value }; + push @{$rg}, { l => $value, u => $value }; return; } @@ -3950,7 +3950,7 @@ } elsif ( $value < $part->{l} ) { # If it's before the current entry then insert it. - splice( @{$rg}, $idx, 0, { 'l' => $value, 'u' => $value } ); + splice( @{$rg}, $idx, 0, { l => $value, u => $value } ); return; } elsif ( $value == $part->{u} + 1 ) { @@ -4481,7 +4481,7 @@ push_command('deadlock'); - my %c = ( 'strip_above_wait' => 0 ); + my %c = ( strip_above_wait => 0 ); push_command( 'stack', 'tree', \%c ); go_job($full_report); @@ -7423,84 +7423,84 @@ # Sort out secondary and options_i so they are handled in the same way. $allfns{queue} = { - 'arg_long' => 'message-queue', - 'qsnet' => 1, - 'arg_short' => 'q', - 'handler' => \&show_queue, - 'help' => 'Show the message queues', - 'options_i' => { 'mpi_dll' => undef, } + arg_long => 'message-queue', + qsnet => 1, + arg_short => 'q', + handler => \&show_queue, + help => 'Show the message queues', + options_i => { mpi_dll => undef, } }; $allfns{kill} = { - 'handler' => \&kill_proc, - 'arg_long' => 'kill', - 'help' => 'Deliver signal to processes', - 'secondary' => [ - { - 'arg_long' => 'signal', - 'type' => '=s', - 'default' => 'TERM' + handler => \&kill_proc, + arg_long => 'kill', + help => 'Deliver signal to processes', + secondary => [ + { + arg_long => 'signal', + type => '=s', + default => 'TERM' } ] }; $allfns{mqueue} = { - 'handler_all' => \&show_mpi_queue_all, - 'arg_long' => 'mpi-queue', - 'arg_short' => 'Q', - 'help' => 'Show MPI message queues', - 'options_i' => { 'mpi_dll' => undef, } + handler_all => \&show_mpi_queue_all, + arg_long => 'mpi-queue', + arg_short => 'Q', + help => 'Show MPI message queues', + options_i => { mpi_dll => undef, } }; $allfns{deadlock} = { - 'handler_all' => \&show_mpi_queue_for_deadlock_all, - 'arg_long' => 'deadlock', - 'arg_short' => 'j', - 'help' => 'Run deadlock detection algorithm', - 'out_handler' => \&deadlock_detect, - 'options_i' => { - 'mpi_dll' => undef, - 'show_group_members' => 0, - 'show_all_groups' => 0, + handler_all => \&show_mpi_queue_for_deadlock_all, + arg_long => 'deadlock', + arg_short => 'j', + help => 'Run deadlock detection algorithm', + out_handler => \&deadlock_detect, + options_i => { + mpi_dll => undef, + show_group_members => 0, + show_all_groups => 0, } }; $allfns{pinfo} = { - 'handler_all' => \&show_proc_all, - 'arg_long' => 'proc-info', - 'help' => 'Show process information', - 'options_i' => { - 'proc_shows_proc' => 1, - 'proc_shows_fds' => 1, - 'proc_shows_maps' => 0, - 'proc_shows_stat' => 0 + handler_all => \&show_proc_all, + arg_long => 'proc-info', + help => 'Show process information', + options_i => { + proc_shows_proc => 1, + proc_shows_fds => 1, + proc_shows_maps => 0, + proc_shows_stat => 0 } }; $allfns{proc_summary} = { - 'handler_all' => \&show_proc_all, - 'out_handler' => \&show_proc_format, - 'arg_long' => 'proc-summary', - 'help' => 'Show process information in top format', - 'options_i' => { - 'column_seperator' => ' ', - 'proc_shows_proc' => 1, - 'proc_shows_fds' => 0, - 'proc_shows_maps' => 0, - 'proc_shows_stat' => 1, - 'proc_sort_key' => 'vp', - 'proc_show_header' => 1, - 'reverse_sort_order' => 0, - 'nprocs_output' => undef, + handler_all => \&show_proc_all, + out_handler => \&show_proc_format, + arg_long => 'proc-summary', + help => 'Show process information in top format', + options_i => { + column_seperator => ' ', + proc_shows_proc => 1, + proc_shows_fds => 0, + proc_shows_maps => 0, + proc_shows_stat => 1, + proc_sort_key => 'vp', + proc_show_header => 1, + reverse_sort_order => 0, + nprocs_output => undef, }, - 'secondary' => [ - { - 'arg_long' => 'proc_format', - 'type' => '=s', - 'default' => + secondary => [ + { + arg_long => 'proc_format', + type => '=s', + default => 'vp=vpid,hostname,pid,vmsize,vmrss,stat.state=S,load1=uptime,pcpu=%cpu,stat.processor=lcore,name=command' } ] @@ -7508,69 +7508,69 @@ }; $allfns{stack} = { - 'handler_all' => \&stack_trace_from_pids, - 'arg_long' => 'stack-trace', - 'arg_short' => 'x', - 'help' => 'Show stack trace (see also -t)', - 'options_i' => { - 'stack_shows_params' => 0, - 'stack_shows_locals' => 0, - 'gdb_retry_count' => 3, - 'stack_strip_above' => + handler_all => \&stack_trace_from_pids, + arg_long => 'stack-trace', + arg_short => 'x', + help => 'Show stack trace (see also -t)', + options_i => { + stack_shows_params => 0, + stack_shows_locals => 0, + gdb_retry_count => 3, + stack_strip_above => 'elan_waitWord,elan_pollWord,elan_deviceCheck,opal_condition_wait,opal_progress', - 'stack_strip_below' => 'main', + stack_strip_below => 'main', }, - 'secondary' => [ - { - 'arg_long' => 'strip_below_main', - 'type' => '!', - 'default' => 1, + secondary => [ + { + arg_long => 'strip_below_main', + type => '!', + default => 1, }, { - 'arg_long' => 'strip_above_wait', - 'type' => '!', - 'default' => 1, + arg_long => 'strip_above_wait', + type => '!', + default => 1, }, ] }; $allfns{stack_long} = { - 'handler_all' => \&show_full_stacks, - 'arg_long' => 'stack-trace-full', - 'arg_short' => 'X', - 'help' => 'Show long stack trace (with locals)', + handler_all => \&show_full_stacks, + arg_long => 'stack-trace-full', + arg_short => 'X', + help => 'Show long stack trace (with locals)', }; $allfns{mpi_watch} = { - 'handler_all' => \&mpi_watch_all, - 'arg_long' => 'mpi-watch', - 'help' => 'Trace MPI programs', - 'pre_out_handler' => \&pre_mpi_watch, - 'out_handler' => \&show_mpi_watch, - 'options_i' => { - 'mpi_dll' => undef, - 'mpi_watch_file' => undef + handler_all => \&mpi_watch_all, + arg_long => 'mpi-watch', + help => 'Trace MPI programs', + pre_out_handler => \&pre_mpi_watch, + out_handler => \&show_mpi_watch, + options_i => { + mpi_dll => undef, + mpi_watch_file => undef } }; $allfns{ping} = { - 'handler' => \&ping_rank, - 'arg_long' => 'ping', - 'help' => "Internal ping", + handler => \&ping_rank, + arg_long => 'ping', + help => 'Internal ping', }; $allfns{set_debug} = { - 'handler' => \&set_debug, - 'qsnet' => 1, - 'arg_long' => 'set-debug', - 'arg_short' => 'D', - 'help' => 'Set debug flags (use --dflag=value)', - 'secondary' => [ - { - 'arg_long' => 'dflag', - 'type' => '=s', - 'default' => '0' + handler => \&set_debug, + qsnet => 1, + arg_long => 'set-debug', + arg_short => 'D', + help => 'Set debug flags (use --dflag=value)', + secondary => [ + { + arg_long => 'dflag', + type => '=s', + default => '0' } ] }; @@ -7583,30 +7583,30 @@ # The shared memory key needs to be calculated. # Config options need to be read locally rather than globally $allfns{qsnet_stats} = { - 'handler_all' => \&inner_show_stats, - 'out_handler' => \&show_stats, - 'qsnet' => 1, - 'arg_long' => 'statistics-total', - 'arg_short' => 's', - 'help' => 'Show the job-wide statistics.', - 'options_i' => { - 'stats_name' => undef, - 'stats_sort_key' => 'vp', - 'stats_reverse' => 0, - 'stats_short' => 0, - 'show_all_stats' => 0, + handler_all => \&inner_show_stats, + out_handler => \&show_stats, + qsnet => 1, + arg_long => 'statistics-total', + arg_short => 's', + help => 'Show the job-wide statistics.', + options_i => { + stats_name => undef, + stats_sort_key => 'vp', + stats_reverse => 0, + stats_short => 0, + show_all_stats => 0, } }; $allfns{qsnet_groups} = { - 'handler_all' => \&inner_show_stats, - 'out_handler' => \&group_status, - 'qsnet' => 1, - 'arg_long' => 'group', - 'arg_short' => 'g', - 'help' => 'Show the state of collective operations (groups).', - 'options_i' => { - 'show_group_members' => 0, - 'show_all_groups' => 0, + handler_all => \&inner_show_stats, + out_handler => \&group_status, + qsnet => 1, + arg_long => 'group', + arg_short => 'g', + help => 'Show the state of collective operations (groups).', + options_i => { + show_group_members => 0, + show_all_groups => 0, } }; From codesite-noreply at google.com Sun Sep 6 09:55:13 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 08:55:13 +0000 Subject: [padb-devel] [padb] r188 committed - Remove braces from join calls and correctly quote strings we pass to i... Message-ID: <0016364c6f452b892f0472e4e4ba@google.com> Revision: 188 Author: apittman Date: Sun Sep 6 01:54:33 2009 Log: Remove braces from join calls and correctly quote strings we pass to it. http://code.google.com/p/padb/source/detail?r=188 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sat Sep 5 16:44:45 2009 +++ /branches/cleanup/src/padb Sun Sep 6 01:54:33 2009 @@ -2526,7 +2526,7 @@ next unless ( -x "$dir/$name" ); my @d = split( "/", $dir ); pop @d; - my $prefix = join( "/", @d ); + my $prefix = join q{/}, @d; return "--prefix $prefix"; } return ""; @@ -3090,7 +3090,7 @@ $proc_format_header{$key} ); push @res, $l; } - my $line = join( $separator, @res ); + my $line = join $separator, @res; print "$line\n"; } my $count = $carg->{nprocs_output}; @@ -3103,7 +3103,7 @@ } push @res, sprintf( "%$proc_format_lengths{$key}s", $value ); } - my $line = join( $separator, @res ); + my $line = join $separator, @res; print "$line\n"; if ( defined($count) and ( --$count == 0 ) ) { return; @@ -3144,7 +3144,7 @@ } } print("----------------\n"); - printf "%s\n", join( ",", compress( @identical, $tag ) ); + printf "%s\n", join q{,}, compress( @identical, $tag ); print("----------------\n"); foreach my $data ( @{ $lines->{$tag} } ) { print("$data\n"); @@ -4434,7 +4434,7 @@ print "$r: "; my @jobs = $rmgr{$res}{get_active_jobs}($user); if ( $#jobs > -1 ) { - my $j = join( " ", sortn(@jobs) ); + my $j = join q{" }, sortn(@jobs); print "jobs($j)\n"; } else { print "No active jobs\n"; @@ -5768,7 +5768,7 @@ push @a, "$arg = ??"; } } - my $a = join( ", ", @a ); + my $a = join q{, }, @a; my $file = $frame->{file} || "?"; my $line = $frame->{line} || "?"; print "$frame->{func}($a) at $file:$line\n"; @@ -5840,7 +5840,7 @@ my @f = split "="; my $key = $f[0]; shift @f; - $env{$key} = join( "=", @f ); + $env{$key} = join q{=}, @f; } close $FD; return %env; @@ -6422,7 +6422,7 @@ push @a, "$arg = ??"; } } - my $a = join( ", ", @a ); + my $a = join q{, }, @a; my $file = $frame->{file} || '?'; my $line = $frame->{line} || '?'; output( $vp, "$frame->{func}($a) at $file:$line" ); From codesite-noreply at google.com Sun Sep 6 09:59:16 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 08:59:16 +0000 Subject: [padb-devel] [padb] r189 committed - Remove the out, outdated and no-longer used show_clever_full_stack() f... Message-ID: <00163623a7a5ab1dff0472e4f2d1@google.com> Revision: 189 Author: apittman Date: Sun Sep 6 01:55:49 2009 Log: Remove the out, outdated and no-longer used show_clever_full_stack() function. http://code.google.com/p/padb/source/detail?r=189 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 01:54:33 2009 +++ /branches/cleanup/src/padb Sun Sep 6 01:55:49 2009 @@ -6398,50 +6398,6 @@ show_mpi_queue( $carg, $vp, $pid ); return; } - -sub show_clever_full_stack { - my ( $vp, $pid ) = @_; - - my $gdb = gdb_start(); - - if ( gdb_attach( $gdb, $pid ) ) { - my @threads = gdb_dump_frames_per_thread( $gdb, 1 ); - gdb_detach($gdb); - gdb_quit($gdb); - - foreach my $thread ( sort { $a->{id} <=> $b->{id} } @threads ) { - my @frames = @{ $thread->{frames} }; - for ( my $i = $#frames ; $i >= 0 ; $i-- ) { - my $frame = $frames[$i]; - - my @a; - foreach my $arg ( @{ $frame->{params} } ) { - if ( defined $frame->{vals}{$arg} ) { - push @a, "$arg = $frame->{vals}{$arg}"; - } else { - push @a, "$arg = ??"; - } - } - my $a = join q{, }, @a; - my $file = $frame->{file} || '?'; - my $line = $frame->{line} || '?'; - output( $vp, "$frame->{func}($a) at $file:$line" ); - - my $show_locals = 0; - if ($show_locals) { - foreach my $arg ( @{ $frame->{locals} } ) { - if ( defined $frame->{vals}{$arg} ) { - output( $vp, " $arg = $frame->{vals}{$arg}" ); - } else { - output( $vp, " $arg = ??" ); - } - } - } - } - } - } - return; -} sub show_full_stack { my ( $vp, $pid, $file ) = @_; @@ -6452,15 +6408,6 @@ sub show_full_stacks { my ( $carg, $list ) = @_; - if (0) { - - # -x does this, just do what we used to. - foreach my $proc ( @{$list} ) { - show_clever_full_stack( $proc->{vp}, $proc->{pid} ); - } - return; - } - my ( $fh, $file ) = tempfile('/tmp/padb.XXXXXXXX'); print {$fh} "where full\n"; print {$fh} "detach\n"; From codesite-noreply at google.com Sun Sep 6 10:10:33 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 09:10:33 +0000 Subject: [padb-devel] [padb] r190 committed - Switch from using compress to rng_convert_to_user() in all cases... Message-ID: <001636ed7841038ef80472e51bcf@google.com> Revision: 190 Author: apittman Date: Sun Sep 6 02:09:39 2009 Log: Switch from using compress to rng_convert_to_user() in all cases and remove the compress and comp functions at the same time. http://code.google.com/p/padb/source/detail?r=190 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 01:55:49 2009 +++ /branches/cleanup/src/padb Sun Sep 6 02:09:39 2009 @@ -1612,8 +1612,8 @@ $are = $have; } - $ret .= - sprintf( "Group $members %s$sstr $are $str.\n", compress(@identical) ); + $ret .= sprintf( "Group $members %s$sstr $are $str.\n", + rng_convert_to_user( rng_create_from_array(@identical) ) ); return $ret; } @@ -2054,32 +2054,6 @@ debug_log( 'tree', $ref, 'Complete tree' ); return _show_tree( $ref, undef, "" ); } - -# This function is used to process the line tags, it changes fab0 fab1 fab10 into -# fab[0-1,10]. -sub compress { - my %rng = comp(@_); - my @list = (); - - # comp returns a hash of arrays, the hash keys are the machines names - # eg "fab" or "fabi", the arrays have zero or more elements in each one - # specifies a node-spec. If there is only one element in the array and - # it doesn't contain a "-" then don't put square braces around the list - # contents - - local $" = ","; # " - - @list = map { - $_ - . ( - @{ $rng{$_} } > 1 || ${ $rng{$_} }[0] =~ /-/ - ? "[@{$rng{$_}}]" - : "@{$rng{$_}}" - ) - } sort keys %rng; - - return wantarray ? @list : "@list"; -} # sortn: # @@ -2090,33 +2064,6 @@ map { $$_[0] } sort { ( $$a[1] || 0 ) <=> ( $$b[1] || 0 ) } map { [ $_, /(\d*)$/ ] } @_; } - -sub comp { - my (%i) = (); - my (%s) = (); - - # turn off warnings here to avoid perl complaints about - # uninitialized values for members of %i and %s - local ($^W) = 0; - push( - @{ - $s{ $$_[0] }[ - ( - $s{ $$_[0] }[ $i{ $$_[0] } ] - [ $#{ $s{ $$_[0] }[ $i{ $$_[0] } ] } ] == ( $$_[1] - 1 ) - ) ? $i{ $$_[0] } : ++$i{ $$_[0] } - ] - }, - ( $$_[1] ) - ) for map { [/(.*?)(\d*)$/] } sortn(@_); - - for my $key ( keys %s ) { - @{ $s{$key} } = - map { $#$_ > 0 ? "$$_[0]-$$_[$#$_]" : @{$_} } @{ $s{$key} }; - } - - return %s; -} ############################################################################### # @@ -3135,16 +3082,17 @@ } elsif ($compress) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); - my @identical = (); + my $rng = rng_create_empty(); + rng_add_value( $rng, $tag ); foreach my $tag2 ( keys %$lines ) { next if ( $tag2 eq $tag ); if ( cmp_list( \@{ $lines->{$tag} }, \@{ $lines->{$tag2} } ) ) { - push @identical, $tag2; + rng_add_value( $rng, $tag2 ); delete( $lines->{$tag2} ); } } print("----------------\n"); - printf "%s\n", join q{,}, compress( @identical, $tag ); + printf "%s\n", rng_convert_to_user($rng); print("----------------\n"); foreach my $data ( @{ $lines->{$tag} } ) { print("$data\n"); @@ -3228,16 +3176,17 @@ foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); - my @identical = (); + my $rng = rng_create_empty(); + rng_add_value( $rng, $tag ); foreach my $tag2 ( keys %$lines ) { next if ( $tag2 eq $tag ); if ( cmp_list( \@{ $lines->{$tag} }, \@{ $lines->{$tag2} } ) ) { - push @identical, $tag2; + rng_add_value( $rng, $tag2 ); delete( $lines->{$tag2} ); } } print("----------------\n"); - printf "%s\n", join( ",", compress( @identical, $tag ) ); + printf "%s\n", rng_convert_to_user($rng); print("----------------\n"); foreach my $data ( @{ $lines->{$tag} } ) { print("$data\n"); From codesite-noreply at google.com Sun Sep 6 10:18:47 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 09:18:47 +0000 Subject: [padb-devel] [padb] r191 committed - Remove sortn completely, replacing it either with numeric sort... Message-ID: <001636283c487b64c10472e5380f@google.com> Revision: 191 Author: apittman Date: Sun Sep 6 02:17:40 2009 Log: Remove sortn completely, replacing it either with numeric sort or plain old sort. http://code.google.com/p/padb/source/detail?r=191 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 02:09:39 2009 +++ /branches/cleanup/src/padb Sun Sep 6 02:17:40 2009 @@ -2054,16 +2054,6 @@ debug_log( 'tree', $ref, 'Complete tree' ); return _show_tree( $ref, undef, "" ); } - -# sortn: -# -# # sort a group of alphanumeric strings by the last group of numerals in -# that string -# -sub sortn { - map { $$_[0] } - sort { ( $$a[1] || 0 ) <=> ( $$b[1] || 0 ) } map { [ $_, /(\d*)$/ ] } @_; -} ############################################################################### # @@ -3203,7 +3193,8 @@ } } else { my $nprocesses = keys %{ $d->{target_output} }; - foreach my $process ( sortn( keys %{ $d->{target_output} } ) ) { + foreach my $process ( sort { $a <=> $b } keys %{ $d->{target_output} } ) + { foreach my $line ( @{ $d->{target_output}{$process} } ) { if ( $nprocesses == 1 ) { print "$line\n"; @@ -3382,7 +3373,7 @@ debug_log( 'signon', undef, 'Received last signon, connecting to inner' ); - @{ $comm_data->{host_ids} } = sortn( keys %{ $comm_data->{remote} } ); + @{ $comm_data->{host_ids} } = sort keys %{ $comm_data->{remote} }; $comm_data->{connection_tree} = generate_comm_tree( $comm_data->{host_ids} ); @@ -3578,7 +3569,7 @@ my $ret = "\n"; foreach my $name ( sort keys %{$td} ) { $ret .= "Namespace: \"$name\"\n"; - foreach my $value ( sortn( keys %{ $td->{$name} } ) ) { + foreach my $value ( sort( keys %{ $td->{$name} } ) ) { $ret .= " $value\t"; $ret .= rng_convert_to_user( $td->{$name}{$value} ) . "\n"; } @@ -4383,7 +4374,7 @@ print "$r: "; my @jobs = $rmgr{$res}{get_active_jobs}($user); if ( $#jobs > -1 ) { - my $j = join q{" }, sortn(@jobs); + my $j = join q{" }, sort { $a <=> $b } @jobs; print "jobs($j)\n"; } else { print "No active jobs\n"; From codesite-noreply at google.com Sun Sep 6 10:23:03 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 09:23:03 +0000 Subject: [padb-devel] [padb] r192 committed - Fix a output error I introduced in r188 Message-ID: <0016e6470f36bbe3690472e54775@google.com> Revision: 192 Author: apittman Date: Sun Sep 6 02:18:55 2009 Log: Fix a output error I introduced in r188 http://code.google.com/p/padb/source/detail?r=192 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 02:17:40 2009 +++ /branches/cleanup/src/padb Sun Sep 6 02:18:55 2009 @@ -4374,7 +4374,7 @@ print "$r: "; my @jobs = $rmgr{$res}{get_active_jobs}($user); if ( $#jobs > -1 ) { - my $j = join q{" }, sort { $a <=> $b } @jobs; + my $j = join q{ }, sort { $a <=> $b } @jobs; print "jobs($j)\n"; } else { print "No active jobs\n"; From codesite-noreply at google.com Sun Sep 6 10:35:06 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 09:35:06 +0000 Subject: [padb-devel] [padb] r193 committed - Re-name a couple of the worst named functions, go_p => make_tree for... Message-ID: <0016368e1fecd9a35c0472e5723f@google.com> Revision: 193 Author: apittman Date: Sun Sep 6 02:34:02 2009 Log: Re-name a couple of the worst named functions, go_p => make_tree for example. http://code.google.com/p/padb/source/detail?r=193 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 02:18:55 2009 +++ /branches/cleanup/src/padb Sun Sep 6 02:34:02 2009 @@ -1905,7 +1905,7 @@ # This function returns an reference to an array of hashes, each # hash containing the "txt" of the function name and a further array # of hash references called "children". -sub go_p { +sub make_tree { my ( $level, $lines, @tags ) = @_; my @peers; @@ -2002,7 +2002,7 @@ unshift @identical, $tag; } - $prev->{children} = go_p( $endlevel + 1, $lines, @identical ); + $prev->{children} = make_tree( $endlevel + 1, $lines, @identical ); } debug_log( @@ -2012,7 +2012,7 @@ ); if (@different) { - my $new = go_p( $level, $lines, @different ); + my $new = make_tree( $level, $lines, @different ); foreach my $n ( @{$new} ) { push @peers, $n; } @@ -3050,7 +3050,7 @@ } # XXX: Now only called when loading things from file. -sub show_results { +sub show_results_from_file { my ( $nlines, $mode, $handle ) = @_; my $lines = $nlines->{lines}; @@ -3068,7 +3068,7 @@ if ($tree) { print show_tree( - go_p( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); + make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); } elsif ($compress) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); @@ -3160,7 +3160,7 @@ if ( $output eq 'tree' ) { print show_tree( - go_p( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); + make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); } elsif ( $output eq 'compress' ) { @@ -3207,7 +3207,7 @@ return; } -sub go_file { +sub load_and_display_from_file { my $file = shift; my $mode = shift; @@ -3234,7 +3234,7 @@ process_line( $line, \%lines ); } post_process_lines( \%lines ); - show_results( \%lines, $mode, undef ); + show_results_from_file( \%lines, $mode, undef ); return; } @@ -4502,7 +4502,7 @@ if ( defined $mode ) { $m = $mode; } - go_file( $input_file, $m ); + load_and_display_from_file( $input_file, $m ); exit 0; } @@ -6155,7 +6155,7 @@ return; } -sub show_vars { +sub show_stack_vars { my ( $vp, $frame, $type ) = @_; my %l; $l{t} = 0; @@ -6294,10 +6294,10 @@ . ( $$frame{file} || '?' ) . ':' . ( $$frame{line} || '?' ) ); if ( $carg->{stack_shows_params} ) { - show_vars( $vp, $frame, 'params' ); + show_stack_vars( $vp, $frame, 'params' ); } if ( $carg->{stack_shows_locals} ) { - show_vars( $vp, $frame, 'locals' ); + show_stack_vars( $vp, $frame, 'locals' ); } } From codesite-noreply at google.com Sun Sep 6 10:39:23 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 09:39:23 +0000 Subject: [padb-devel] [padb] r194 committed - Enable warnings in-line rather than use the -w switch. We can do this... Message-ID: <001636d345b621180f0472e582f3@google.com> Revision: 194 Author: apittman Date: Sun Sep 6 02:36:14 2009 Log: Enable warnings in-line rather than use the -w switch. We can do this now because the comp() function used to disable them locally however we no longer have that function. http://code.google.com/p/padb/source/detail?r=194 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 02:34:02 2009 +++ /branches/cleanup/src/padb Sun Sep 6 02:36:14 2009 @@ -1,4 +1,4 @@ -#!/usr/bin/perl -w +#!/usr/bin/perl # padb. a simple parallel debugging aid. @@ -204,6 +204,7 @@ ############################################################################### +use warnings; use strict; use Getopt::Long; use File::Basename; From codesite-noreply at google.com Sun Sep 6 22:13:15 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 21:13:15 +0000 Subject: [padb-devel] [padb] r195 committed - Catch errors in the per-rank callback functions using eval and ... Message-ID: <0016364c6f459bc8b40472ef33be@google.com> Revision: 195 Author: apittman Date: Sun Sep 6 14:12:24 2009 Log: Catch errors in the per-rank callback functions using eval and report any errors correctly back to the output process. This means that any errors are contained to the node and the (padb) job is still viable and can produce meaningful results even with errors in the system. http://code.google.com/p/padb/source/detail?r=195 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 02:36:14 2009 +++ /branches/cleanup/src/padb Sun Sep 6 14:12:24 2009 @@ -6700,19 +6700,6 @@ ); return; } - -sub default_handler_all { - my ( $cmd, $list ) = @_; - my %gres; - foreach my $proc ( @{$list} ) { - my $vp = $proc->{vp}; - my $pid = $proc->{pid}; - my $res = $allfns{ $cmd->{mode} }{handler}( $cmd->{cargs}, $vp, $pid ); - $gres{$vp} = $res if ( defined $res ); - } - return if not %gres; - return \%gres; -} # Receive a reply from a child. # If it's the last reply then combine @@ -6886,6 +6873,7 @@ } # Now chose what pid to target. + my @apids; foreach my $key ( keys %{$ipids} ) { my $ip = $ipids->{$key}; @@ -6902,12 +6890,16 @@ my @ppids = sort @{ $ip->{notscripts} }; $newpid = $ppids[0]; } - my %pd; - $pd{pid} = $newpid; - $pd{vp} = $ip->{rank}; - push @{ $confInner{all_pids} }, \%pd; - - } + + push @apids, + { + pid => $newpid, + vp => $ip->{rank} + }; + } + + # Sort local pids by order of increasing rank. + @{ $confInner{all_pids} } = sort { $a->{vp} <=> $b->{vp} } @apids; return; } @@ -6947,6 +6939,8 @@ sub command_from_parent { my ( $netdata, $cmd ) = @_; + $netdata->{host_responce} = "ok"; + if ( $cmd->{mode} eq 'signon' ) { $netdata->{signon_cmd} = my_encode($cmd); @@ -7025,15 +7019,55 @@ $pid_list = $confInner{all_pids}; } - # Now do the work. - my $res; + # Now do the work by calling handler or handler_all. Catch any exception + # errors here and extract the top line of the error to report to the user. + # If calling handler then just report an error for that rank and move on, + # if using handler_all then report errors for all ranks on this node. + + # This has the advantage that even if there is an error with data + # collection on this node the rest of the application can carry and + # hopefully still give the user meaningful information or at least + # meaningful error messages. + + # Even if a exception is generated rank output may still exist for that + # or any other rank on this node, we'll have to see if that causes problems + # or if it's best to clear the target_key_pait() and output() data for this + # node/rank. if ( defined $allfns{ $cmd->{mode} }{handler_all} ) { - $res = $allfns{ $cmd->{mode} }{handler_all}( $cmd->{cargs}, $pid_list ); + eval { + $netdata->{target_responce} = + $allfns{ $cmd->{mode} }{handler_all}( $cmd->{cargs}, $pid_list ); + }; + if ($@) { + my $error = $@; + my @e = split qr{\n}, $error; + $netdata->{host_responce} = "error"; + foreach my $proc ( @{$pid_list} ) { + target_error( $proc->{vp}, "Critial error: ($e[0])" ); + } + } } else { - $res = default_handler_all( $cmd, $pid_list ); - } - if ($res) { - $netdata->{target_responce} = $res; + + my %gres; + foreach my $proc ( @{$pid_list} ) { + my $vp = $proc->{vp}; + my $pid = $proc->{pid}; + eval { + my $res = + $allfns{ $cmd->{mode} }{handler}( $cmd->{cargs}, $vp, $pid ); + $gres{$vp} = $res if ( defined $res ); + }; + if ($@) { + my $error = $@; + my @e = split qr{\n}, $error; + $netdata->{host_responce} = "error"; + target_error( $vp, "Critial error: ($e[0])" ); + } + } + + if (%gres) { + $netdata->{target_responce} = \%gres; + } } return; @@ -7055,7 +7089,8 @@ sub reply_to_parent { my ( $netdata, $cmd ) = @_; - $cmd->{host_responce}{ok}{ $confInner{hostname} } = 1; + $cmd->{host_responce}{ $netdata->{host_responce} }{ $confInner{hostname} } = + 1; my $reply = my_encode($cmd); $netdata->{parent}->{socket}->print("$reply\n"); From codesite-noreply at google.com Sun Sep 6 22:30:46 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Sun, 06 Sep 2009 21:30:46 +0000 Subject: [padb-devel] [padb] r196 committed - Redirect the output of slurped commands to /dev/null Message-ID: <005045017e3241f52d0472ef72e8@google.com> Revision: 196 Author: apittman Date: Sun Sep 6 14:30:15 2009 Log: Redirect the output of slurped commands to /dev/null http://code.google.com/p/padb/source/detail?r=196 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 14:12:24 2009 +++ /branches/cleanup/src/padb Sun Sep 6 14:30:15 2009 @@ -633,7 +633,7 @@ sub slurp_cmd { my ($cmd) = @_; - open( my $CFD, '-|', $cmd ) or return; + open( my $CFD, '-|', "$cmd 2>/dev/null" ) or return; my @out = <$CFD>; close $CFD; return @out; From codesite-noreply at google.com Mon Sep 7 09:37:03 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 08:37:03 +0000 Subject: [padb-devel] [padb] r197 committed - re-check that a given process exists when walking through /proc in a n... Message-ID: <0016e640d22212cbc50472f8c156@google.com> Revision: 197 Author: apittman Date: Mon Sep 7 01:36:34 2009 Log: re-check that a given process exists when walking through /proc in a number of places. http://code.google.com/p/padb/source/detail?r=197 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Sun Sep 6 14:30:15 2009 +++ /branches/cleanup/src/padb Mon Sep 7 01:36:34 2009 @@ -656,6 +656,11 @@ foreach my $pid (@pids) { next unless ( $pid =~ m{\A\d+\z}xms ); my ( undef, undef, undef, undef, $owner ) = stat("/proc/$pid"); + + # Check the stat worked, it's possible for processes to dissapear + # Take care to check for defined rather than true as root has a + # uid of zero. + next unless defined $owner; next unless $owner == $uid; push @userpids, $pid; } @@ -6570,7 +6575,7 @@ sub is_resmgr_process { my $pid = shift; my $name = find_from_status( $pid, 'Name' ); - my $mgrs = { 'rmsloader' => 1, 'slurmd' => 1, 'slurmstepd' => 1 }; + my $mgrs = { rmsloader => 1, slurmd => 1, slurmstepd => 1 }; return 1 if ( defined $mgrs->{$name} ); return; } @@ -6891,11 +6896,16 @@ $newpid = $ppids[0]; } - push @apids, - { - pid => $newpid, - vp => $ip->{rank} - }; + # The process might have died and we simply didn't find anything, + # if this is the case then just skip it, the outer will notice + # the missing signon and report an approtiate error. + if ( defined $newpid ) { + push @apids, + { + pid => $newpid, + vp => $ip->{rank} + }; + } } # Sort local pids by order of increasing rank. From codesite-noreply at google.com Mon Sep 7 13:35:58 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 12:35:58 +0000 Subject: [padb-devel] [padb] r198 committed - Cleanup and remove some dead code from the show_tree and make_tree fun... Message-ID: <0016e68ee20f7c8bdd0472fc17b5@google.com> Revision: 198 Author: apittman Date: Mon Sep 7 05:35:03 2009 Log: Cleanup and remove some dead code from the show_tree and make_tree functions. There should be no visable behaviour changes from this change. http://code.google.com/p/padb/source/detail?r=198 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 01:36:34 2009 +++ /branches/cleanup/src/padb Mon Sep 7 05:35:03 2009 @@ -1911,20 +1911,20 @@ # This function returns an reference to an array of hashes, each # hash containing the "txt" of the function name and a further array # of hash references called "children". -sub make_tree { +sub _make_tree { my ( $level, $lines, @tags ) = @_; my @peers; my $prev; - my $tag = $tags[0]; + my $tag = shift @tags; debug_log( 'tree', \@tags, 'called tag:%s, level:%d', $tag, $level ); return if ( !defined($tag) ); return if ( !defined( $lines->{$tag} ) ); - my @identical = (); - my @different = (); + my @identical; + my @different; my $endlevel = $level; @@ -1932,23 +1932,16 @@ my $line = $lines->{$tag}[$level]; if ( defined $line ) { foreach my $tag2 (@tags) { - next if ( $tag2 eq $tag ); if ( defined( $lines->{$tag2}[$level] ) and $line eq $lines->{$tag2}[$level] ) { push @identical, $tag2; - delete( $lines->{$tag2}[$level] ); } else { push @different, $tag2; } } } else { - foreach my $dtag (@tags) { - if ( $dtag != $tag ) { - push @different, $dtag; - } - } - + @different = @tags; } # Move $endlevel on as far as we can... @@ -1987,10 +1980,14 @@ my %this; $this{txt} = $lines->{$tag}[$l]; - @{ $this{vps} } = ( $tag, @identical ); - + + # @{ $this{vps} } = ( $tag, @identical ); + + # The plus two here is one for $tag and one to convert + # from array idx to number of entries. + $this{vpcount} = $#identical + 2; $this{vpspec} = - rng_convert_to_user( rng_create_from_array( @{ $this{vps} } ) ); + rng_convert_to_user( rng_create_from_array( ( $tag, @identical ) ) ); if ( defined $prev ) { push @{ $prev->{children} }, \%this; @@ -2008,7 +2005,7 @@ unshift @identical, $tag; } - $prev->{children} = make_tree( $endlevel + 1, $lines, @identical ); + $prev->{children} = _make_tree( $endlevel + 1, $lines, @identical ); } debug_log( @@ -2018,14 +2015,18 @@ ); if (@different) { - my $new = make_tree( $level, $lines, @different ); - foreach my $n ( @{$new} ) { - push @peers, $n; - } + my $new = _make_tree( $level, $lines, @different ); + push @peers, ( @{$new} ); } return \@peers; } + +# Convert the rank output into a tree based form suitable for use with show_tree. +sub make_tree { + my ($lines) = @_; + return _make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ); +} # Takes a ref to a array of hashes... sub _show_tree { @@ -2033,16 +2034,17 @@ my ( $ref, $parent, $indent ) = @_; my $ret = ""; - my @peers = sort { $a->{vps}[0] <=> $b->{vps}[0] } ( @{$ref} ); - + + # Don't need to sort the peers here because make_tree ensures + # the are sorted. + # my @peers = sort { $a->{vps}[0] <=> $b->{vps}[0] } ( @{$ref} ); + + my @peers = @{$ref}; foreach my $peer (@peers) { - if ( $#peers != 0 or not defined $parent or $parent ne $peer->{vpspec} ) - { - my $count = $#{ $peer->{vps} } + 1; - my $i_level = "$peer->{vpspec} ($count processes)"; + if ( $#peers != 0 or $parent ne $peer->{vpspec} ) { $ret .= "$indent-----------------\n"; - $ret .= "$indent$i_level\n"; + $ret .= "$indent$peer->{vpspec} ($peer->{vpcount} processes)\n"; $ret .= "$indent-----------------\n"; } @@ -2058,7 +2060,7 @@ sub show_tree { my $ref = shift; debug_log( 'tree', $ref, 'Complete tree' ); - return _show_tree( $ref, undef, "" ); + return _show_tree( $ref, "no-parent", "" ); } ############################################################################### @@ -3073,8 +3075,7 @@ #} if ($tree) { - print show_tree( - make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); + print show_tree( make_tree($lines) ); } elsif ($compress) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { next if ( !defined( $lines->{$tag} ) ); @@ -3165,9 +3166,7 @@ } if ( $output eq 'tree' ) { - print show_tree( - make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ) ); - + print show_tree( make_tree($lines) ); } elsif ( $output eq 'compress' ) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { From codesite-noreply at google.com Mon Sep 7 14:09:29 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 13:09:29 +0000 Subject: [padb-devel] [padb] r199 committed - Convert make_tree to use the rng_ functions rather than arrays for pas... Message-ID: <001636c5bd416288780472fc8f3e@google.com> Revision: 199 Author: apittman Date: Mon Sep 7 06:09:03 2009 Log: Convert make_tree to use the rng_ functions rather than arrays for passing around lists of ranks. http://code.google.com/p/padb/source/detail?r=199 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 05:35:03 2009 +++ /branches/cleanup/src/padb Mon Sep 7 06:09:03 2009 @@ -1912,36 +1912,38 @@ # hash containing the "txt" of the function name and a further array # of hash references called "children". sub _make_tree { - my ( $level, $lines, @tags ) = @_; + my ( $level, $lines, $trange ) = @_; my @peers; my $prev; - my $tag = shift @tags; - - debug_log( 'tree', \@tags, 'called tag:%s, level:%d', $tag, $level ); + my $tag = rng_shift($trange); + + debug_log( 'tree', undef, 'called tag:%s, level:%d tags %s', + $tag, $level, rng_convert_to_user($trange) ); return if ( !defined($tag) ); return if ( !defined( $lines->{$tag} ) ); my @identical; - my @different; + my $different_rng; my $endlevel = $level; # Populate the two lists, @identical and @different my $line = $lines->{$tag}[$level]; if ( defined $line ) { - foreach my $tag2 (@tags) { + $different_rng = rng_create_empty(); + while ( defined( my $tag2 = rng_shift($trange) ) ) { if ( defined( $lines->{$tag2}[$level] ) and $line eq $lines->{$tag2}[$level] ) { push @identical, $tag2; } else { - push @different, $tag2; + rng_add_value( $different_rng, $tag2 ); } } } else { - @different = @tags; + $different_rng = $trange; } # Move $endlevel on as far as we can... @@ -1971,9 +1973,11 @@ } debug_log( - 'tree', undef, - -"level $level, endlevel $endlevel, identical:@identical different:@different" + 'tree', + undef, + "level $level, endlevel $endlevel, identical:%s different: %s", + rng_convert_to_user( rng_create_from_array(@identical) ), + rng_convert_to_user($different_rng) ); for ( my $l = $level ; $l <= $endlevel ; $l++ ) { @@ -2005,17 +2009,20 @@ unshift @identical, $tag; } - $prev->{children} = _make_tree( $endlevel + 1, $lines, @identical ); + my $r = rng_create_from_array(@identical); + $prev->{children} = _make_tree( $endlevel + 1, $lines, $r ); } debug_log( - 'tree', undef, - -"returning level:$level endlevel:$endlevel identical:@identical different:@different" + 'tree', + undef, + "returning level:$level endlevel:$endlevel identical:%s different: %s", + rng_convert_to_user( rng_create_from_array(@identical) ), + rng_convert_to_user($different_rng) ); - if (@different) { - my $new = _make_tree( $level, $lines, @different ); + if ( not rng_empty($different_rng) ) { + my $new = _make_tree( $level, $lines, $different_rng ); push @peers, ( @{$new} ); } @@ -2025,7 +2032,8 @@ # Convert the rank output into a tree based form suitable for use with show_tree. sub make_tree { my ($lines) = @_; - return _make_tree( 0, $lines, ( sort { $a <=> $b } ( keys %$lines ) ) ); + my $rng = rng_create_from_array( keys(%$lines) ); + return _make_tree( 0, $lines, $rng ); } # Takes a ref to a array of hashes... From codesite-noreply at google.com Mon Sep 7 15:07:54 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 14:07:54 +0000 Subject: [padb-devel] [padb] r200 committed - Remove the braces from calls to defined and sprintf. Message-ID: <001636d345b649d9300472fd60a7@google.com> Revision: 200 Author: apittman Date: Mon Sep 7 07:07:37 2009 Log: Remove the braces from calls to defined and sprintf. http://code.google.com/p/padb/source/detail?r=200 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 06:09:03 2009 +++ /branches/cleanup/src/padb Mon Sep 7 07:07:37 2009 @@ -521,9 +521,9 @@ } else { $extra .= " "; } - $extra .= sprintf( " --%-18s%s.\n", - $allfns{$arg}{arg_long}, - $allfns{$arg}{help} ); + $extra .= sprintf " --%-18s%s.\n", + $allfns{$arg}{arg_long}, + $allfns{$arg}{help}; } $extra .= "\nQsNet specific modes\n"; @@ -535,9 +535,9 @@ } else { $extra .= " "; } - $extra .= sprintf( " --%-18s%s.\n", - $allfns{$arg}{arg_long}, - $allfns{$arg}{help} ); + $extra .= sprintf " --%-18s%s.\n", + $allfns{$arg}{arg_long}, + $allfns{$arg}{help}; } $usage =~ s{XXXX} @@ -724,7 +724,7 @@ foreach my $f ( split( ",", $debugflag ) ) { my ( $name, $v ) = split( "=", $f ); if ( exists $debugModes{$name} ) { - $debugModes{$name} = defined($v) ? $v : 'basic'; + $debugModes{$name} = defined $v ? $v : 'basic'; } else { print "Attempt to set unknown debug flag \"$name\".\n"; } @@ -928,11 +928,10 @@ my $ret = ""; foreach my $tally ( sort keys %{$d} ) { if ( $d->{$tally}{raw}[0] or $conf{show_all_stats} ) { - $ret .= sprintf( - "%16s: Total: %d Active: %d HWM: %d\n", - $d->{$tally}{name}, $d->{$tally}{raw}[0], - $d->{$tally}{raw}[1], $d->{$tally}{raw}[2] - ); + $ret .= sprintf + "%16s: Total: %d Active: %d HWM: %d\n", + $d->{$tally}{name}, $d->{$tally}{raw}[0], + $d->{$tally}{raw}[1], $d->{$tally}{raw}[2]; } } return $ret; @@ -955,25 +954,25 @@ $scale++; } - $ret .= sprintf( + $ret .= sprintf "%16s: min $d->{$bin}{raw}[32] max $d->{$bin}{raw}[33] total $d->{$bin}{raw}[34] (%0.2f $scales[$scale])\n", - $d->{$bin}{name}, $total ); + $d->{$bin}{name}, $total; my @vals; for ( my $j = 0 ; $j < 32 ; $j++ ) { if ( $d->{$bin}{raw}[$j] or $conf{show_all_stats} > 1 ) { push @vals, - sprintf( '%9s: %10d', - $bin_names[$j], $d->{$bin}{raw}[$j] ); + sprintf '%9s: %10d', + $bin_names[$j], $d->{$bin}{raw}[$j]; if ( $#vals == 2 ) { - $ret .= sprintf( " %s\n", join( " ", @vals ) ); + $ret .= sprintf " %s\n", join( " ", @vals ); undef @vals; } } } if ( $#vals != -1 ) { - $ret .= sprintf( " %s\n", join( " ", @vals ) ); + $ret .= sprintf " %s\n", join( " ", @vals ); undef @vals; } } @@ -1618,8 +1617,8 @@ $are = $have; } - $ret .= sprintf( "Group $members %s$sstr $are $str.\n", - rng_convert_to_user( rng_create_from_array(@identical) ) ); + $ret .= sprintf "Group $members %s$sstr $are $str.\n", + rng_convert_to_user( rng_create_from_array(@identical) ); return $ret; } @@ -1921,8 +1920,8 @@ debug_log( 'tree', undef, 'called tag:%s, level:%d tags %s', $tag, $level, rng_convert_to_user($trange) ); - return if ( !defined($tag) ); - return if ( !defined( $lines->{$tag} ) ); + return if ( not defined $tag ); + return if ( not defined $lines->{$tag} ); my @identical; my $different_rng; @@ -1934,7 +1933,7 @@ if ( defined $line ) { $different_rng = rng_create_empty(); while ( defined( my $tag2 = rng_shift($trange) ) ) { - if ( defined( $lines->{$tag2}[$level] ) + if ( defined $lines->{$tag2}[$level] and $line eq $lines->{$tag2}[$level] ) { push @identical, $tag2; @@ -1955,7 +1954,7 @@ $endlevel++; if ( defined $lines->{$tag}[$endlevel] ) { foreach my $tag2 (@identical) { - if ( defined( $lines->{$tag2}[$endlevel] ) + if ( defined $lines->{$tag2}[$endlevel] and $lines->{$tag}[$endlevel] eq $lines->{$tag2}[$endlevel] ) { @@ -2203,7 +2202,7 @@ exit 1; } - if ( defined($2) ) { + if ( defined $2 ) { # square braces with range, eg 'machine[0-3]' for ( $i = $1 ; $i <= $2 ; $i++ ) { @@ -2463,7 +2462,7 @@ } sub mpd_cleanup_pcmd { - unlink($mpd_dfile) if ( defined($mpd_dfile) ); + unlink($mpd_dfile) if ( defined $mpd_dfile ); return; } @@ -2579,7 +2578,7 @@ } sub open_cleanup_pcmd { - unlink($open_dfile) if ( defined($open_dfile) ); + unlink($open_dfile) if ( defined $open_dfile ); return; } @@ -2821,7 +2820,7 @@ sub cleanup_pcmd { my $job = shift; - if ( defined( $rmgr{ $conf{rmgr} }{cleanup_pcmd} ) ) { + if ( defined $rmgr{ $conf{rmgr} }{cleanup_pcmd} ) { $rmgr{ $conf{rmgr} }{cleanup_pcmd}(); } return; @@ -2857,7 +2856,7 @@ $main_idx = $l; } if ( defined $above{$1} ) { - if ( defined($main_idx) ) { + if ( defined $main_idx ) { $wait_idx = $l; last; } @@ -3039,8 +3038,8 @@ if ( $carg->{proc_show_header} ) { my @res; foreach my $key (@proc_format_array) { - my $l .= sprintf( "%-$proc_format_lengths{$key}s", - $proc_format_header{$key} ); + my $l .= sprintf "%-$proc_format_lengths{$key}s", + $proc_format_header{$key}; push @res, $l; } my $line = join $separator, @res; @@ -3054,11 +3053,11 @@ if ( defined $hash->{$key} ) { $value = $hash->{$key}; } - push @res, sprintf( "%$proc_format_lengths{$key}s", $value ); + push @res, sprintf "%$proc_format_lengths{$key}s", $value; } my $line = join $separator, @res; print "$line\n"; - if ( defined($count) and ( --$count == 0 ) ) { + if ( defined $count and ( --$count == 0 ) ) { return; } } @@ -3086,7 +3085,7 @@ print show_tree( make_tree($lines) ); } elsif ($compress) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { - next if ( !defined( $lines->{$tag} ) ); + next if ( not defined $lines->{$tag} ); my $rng = rng_create_empty(); rng_add_value( $rng, $tag ); foreach my $tag2 ( keys %$lines ) { @@ -3178,7 +3177,7 @@ } elsif ( $output eq 'compress' ) { foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { - next if ( !defined( $lines->{$tag} ) ); + next if ( not defined $lines->{$tag} ); my $rng = rng_create_empty(); rng_add_value( $rng, $tag ); foreach my $tag2 ( keys %$lines ) { @@ -3451,8 +3450,8 @@ my %cmd; $cmd{mode} = $mode; - $cmd{out_format} = $out_format if defined($out_format); - $cmd{args} = $args if defined($args); + $cmd{out_format} = $out_format if defined $out_format; + $cmd{args} = $args if defined $args; push @commands, \%cmd; return; } @@ -3495,7 +3494,7 @@ # are already defined. if ( defined $allfns{ $req->{mode} }{secondary} ) { foreach my $sec ( @{ $allfns{ $req->{mode} }{secondary} } ) { - if ( not defined( $req->{cargs}{ $sec->{arg_long} } ) ) { + if ( not defined $req->{cargs}{ $sec->{arg_long} } ) { $req->{cargs}{ $sec->{arg_long} } = $sec->{value}; } } @@ -3655,7 +3654,7 @@ print "========\n"; } - if ( defined( $allfns{$mode}{out_handler} ) ) { + if ( defined $allfns{$mode}{out_handler} ) { $allfns{$mode}{out_handler}( $conf{mode_options}{$mode}, $d ); } else { default_output_handler( $comm_data->{current_req}, $d ); @@ -3747,7 +3746,7 @@ my $nb = sysread( $h, $data, 65536 ); if ( $nb == 0 ) { - if ( defined( $cdata->{eof_cb} ) ) { + if ( defined $cdata->{eof_cb} ) { $cdata->{eof_cb}( $comm_data, $cdata ); } $comm_data->{sel}->remove($h); @@ -4364,7 +4363,7 @@ config_help(); exit 1; } - if ( !defined $val ) { + if ( not defined $val ) { print "Error, config option '$name' requires value\n"; config_help(); exit 1; @@ -4496,7 +4495,7 @@ } # If delivering a signal check that it's valid. - if ( defined($mode) and ( $mode eq 'kill' ) ) { + if ( defined $mode and ( $mode eq 'kill' ) ) { my $signal = uc( $secondary_args{signal} ); my %sig_names; map { $sig_names{$_} = 1 } split( " ", $Config{sig_name} ); @@ -4510,7 +4509,7 @@ cmdline_error("$prog: Error: --tree only works with --stack-trace\n"); } - if ( defined($input_file) ) { + if ( defined $input_file ) { my $m = 'input'; if ( defined $mode ) { $m = $mode; @@ -5042,11 +5041,11 @@ my $offset = 0; my $str = ""; my @s = gdb_read_raw( $gdb, $strp, 128 ); - return if ( not defined( $s[0] ) ); + return if ( not defined $s[0] ); foreach my $d (@s) { my $v = hex($d); return $str if ( $v == 0 ); - $str .= sprintf( '%c', $v ); + $str .= sprintf '%c', $v; } return $str; } @@ -5079,7 +5078,7 @@ $stats->{symbol}++; } elsif ( $cmd eq 'data' ) { my @r = gdb_read_raw( $gdb, $params[0], $params[1] ); - if ( defined( $r[0] ) ) { + if ( defined $r[0] ) { $res = "@r"; $stats->{datareads}++; $stats->{databytes} += $params[1]; @@ -5194,7 +5193,7 @@ } my $base = gdb_var_addr( $g, 'MPIR_dll_name' ); - if ( !defined $base ) { + if ( not defined $base ) { target_error( $vp, 'Process does not appear to be using MPI (No MPIR_dll_name symbol)' ); @@ -5203,7 +5202,7 @@ if ( defined $carg->{mpi_dll} ) { $ENV{MPINFO_DLL} = $carg->{mpi_dll}; } else { - if ( !defined $base ) { + if ( not defined $base ) { gdb_detach($g); gdb_quit($g); return; @@ -5221,7 +5220,7 @@ my ( $carg, $vp, $pid, $g ) = @_; my $base = gdb_var_addr( $g, 'MPIR_dll_name' ); - if ( !defined $base ) { + if ( not defined $base ) { target_error( $vp, 'Process does not appear to be using MPI (No MPIR_dll_name symbol)' ); @@ -5230,7 +5229,7 @@ if ( defined $carg->{mpi_dll} ) { $ENV{MPINFO_DLL} = $carg->{mpi_dll}; } else { - if ( !defined $base ) { + if ( not defined $base ) { return; } } @@ -5987,7 +5986,7 @@ my @post = split( " ", $end ); my $jused = $post[13] - $pre[13]; my $used = ( $jused / $elapsed ) * $cpucount * 100; - return sprintf( "%d", $used ); + return sprintf "%d", $used; } sub pcpu_sys { @@ -5996,7 +5995,7 @@ my @post = split( " ", $end ); my $jused = $post[14] - $pre[14]; my $used = ( $jused / $elapsed ) * $cpucount * 100; - return sprintf( "%d", $used ); + return sprintf "%d", $used; } sub pcpu_total { @@ -6005,7 +6004,7 @@ my @post = split( " ", $end ); my $jused = $post[13] - $pre[13] + $post[14] - $pre[14]; my $used = ( $jused / $elapsed ) * $cpucount * 100; - return sprintf( "%d", $used ); + return sprintf "%d", $used; } my %proc_keys; @@ -6173,18 +6172,18 @@ my %l; $l{t} = 0; $l{n} = 0; - return unless defined( $frame->{$type} ); + return unless defined $frame->{$type}; return if ( @{ $frame->{$type} } == 0 ); foreach my $arg ( @{ $frame->{$type} } ) { $l{t} = length( $arg->{type} ) if ( length( $arg->{type} ) > $l{t} ); $l{n} = length( $arg->{name} ) if ( length( $arg->{name} ) > $l{n} ); } - my $header = sprintf(" $type:"); + my $header = sprintf " $type:"; output( $vp, $header ); foreach my $arg ( @{ $frame->{$type} } ) { my $value = ( defined $arg->{value} ? $arg->{value} : '??' ); - my $output = - sprintf( " %-$l{t}s %$l{n}s = $value", $arg->{type}, $arg->{name} ); + my $output = sprintf " %-$l{t}s %$l{n}s = $value", $arg->{type}, + $arg->{name}; output( $vp, $output ); } return; @@ -6877,7 +6876,7 @@ next unless defined $rmpid; - if ( defined( $scripts{ pid_to_name($pid) } ) ) { + if ( defined $scripts{ pid_to_name($pid) } ) { push @{ $ipids->{$rmpid}{scripts} }, $pid; } else { push @{ $ipids->{$rmpid}{notscripts} }, $pid; @@ -6891,14 +6890,14 @@ my $newpid; - if ( defined( $ip->{scripts} ) ) { + if ( defined $ip->{scripts} ) { my @ppids = sort @{ $ip->{scripts} }; $newpid = $ppids[0]; } # If there are any pids which aren't scripts then target the # first one. - if ( defined( $ip->{notscripts} ) ) { + if ( defined $ip->{notscripts} ) { my @ppids = sort @{ $ip->{notscripts} }; $newpid = $ppids[0]; } From codesite-noreply at google.com Mon Sep 7 15:46:17 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 14:46:17 +0000 Subject: [padb-devel] [padb] r201 committed - Remove a lot more un-necesary braces from builtin functions. Message-ID: <0016e640d222888cfd0472fde90f@google.com> Revision: 201 Author: apittman Date: Mon Sep 7 07:45:09 2009 Log: Remove a lot more un-necesary braces from builtin functions. http://code.google.com/p/padb/source/detail?r=201 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 07:07:37 2009 +++ /branches/cleanup/src/padb Mon Sep 7 07:45:09 2009 @@ -603,7 +603,7 @@ exit 1; } return unless $debugModes{$type}; - my $time = time() - $start_time; + my $time = time - $start_time; printf "DEBUG ($type): %3d: $str\n", $time, @params; return if $debugModes{$type} eq 'basic'; return unless defined $handle; @@ -625,15 +625,15 @@ sub slurp_file { my ($file) = @_; - open( my $FD, '<', $file ) or return; + open my $FD, '<', $file or return; my @contents = <$FD>; - close($FD); + close $FD; return @contents; } sub slurp_cmd { my ($cmd) = @_; - open( my $CFD, '-|', "$cmd 2>/dev/null" ) or return; + open my $CFD, '-|', "$cmd 2>/dev/null" or return; my @out = <$CFD>; close $CFD; return @out; @@ -641,21 +641,21 @@ sub slurp_dir { my ($dir) = @_; - opendir( my $DIR, $dir ) or return; - my @files = readdir($DIR); - closedir($DIR); + opendir my $DIR, $dir or return; + my @files = readdir $DIR; + closedir $DIR; return @files; } sub get_process_list { my ($user) = @_; - my $uid = getpwnam($user); + my $uid = getpwnam $user; return unless defined $uid; my @pids = slurp_dir('/proc'); my @userpids; foreach my $pid (@pids) { next unless ( $pid =~ m{\A\d+\z}xms ); - my ( undef, undef, undef, undef, $owner ) = stat("/proc/$pid"); + my ( undef, undef, undef, undef, $owner ) = stat "/proc/$pid"; # Check the stat worked, it's possible for processes to dissapear # Take care to check for defined rather than true as root has a @@ -721,7 +721,7 @@ GetOptions(%optionhash) or exit 1; if ( defined $debugflag ) { - foreach my $f ( split( ",", $debugflag ) ) { + foreach my $f ( split ',', $debugflag ) { my ( $name, $v ) = split( "=", $f ); if ( exists $debugModes{$name} ) { $debugModes{$name} = defined $v ? $v : 'basic'; @@ -784,7 +784,7 @@ } else { if ( length $str < 10 ) { - return hex($str); + return hex $str; } # It was hard to write, it's supposed to be hard to read. @@ -943,7 +943,7 @@ my $ret = ""; foreach my $bin ( sort keys %{$d} ) { - if ( $d->{$bin}{raw}[0] || $d->{$bin}{raw}[34] + if ( ( $d->{$bin}{raw}[0] || $d->{$bin}{raw}[34] ) or $conf{show_all_stats} ) { my $total = $d->{$bin}{raw}[34]; @@ -1599,7 +1599,7 @@ my $str = shift; # tagged onto the end of the line. my $possessive = shift; # syntax to use (possessive/attributive) my $size = shift; # size of the group - my @identical = @_; # member list + my @identical = (@_); # member list my $ret; my $sstr = defined $size ? " (size $size)" : ""; @@ -2888,7 +2888,7 @@ sub sort_proc_hashes { my $carg = shift; my $key = shift; - my @all = @_; + my @all = (@_); if ( $carg->{reverse_sort_order} ) { return ( reverse( sort { $a->{$key} <=> $b->{$key} } @all ) ); @@ -3144,7 +3144,7 @@ sub post_process_lines { my $lines = shift; - return unless exists( $lines->{base64} ); + return unless exists $lines->{base64}; foreach my $tag ( keys %{ $lines->{base64} } ) { $lines->{raw}{$tag} = thaw( decode_base64( join( "\n", @{ $lines->{base64}{$tag} } ) ) ); @@ -4041,7 +4041,7 @@ $sel->add( $pcmd->{err} ); $comm_data->{sel} = $sel; - my $start = time(); + my $start = time; my %op; $op{str} = ""; @@ -4071,7 +4071,7 @@ } } } - my $t2 = time() - $start; + my $t2 = time - $start; my $count = $sel->count(); if ( $count > 0 ) { @@ -4226,7 +4226,9 @@ my ( $key, $value ) = @_; print "Setting '$key' to '$value'\n" if ( $conf{verbose} ); - if ( !exists $conf{$key} and !exists $conf{mode_options_reverse}{$key} ) { + if ( not exists $conf{$key} + and not exists $conf{mode_options_reverse}{$key} ) + { print {*STDERR} "Warning, unknown config option '$key' value '$value'.\n"; } @@ -4317,7 +4319,7 @@ my $mode = parse_args_outer(); - if ( getpwnam($user) eq "" ) { + if ( getpwnam $user eq "" ) { print {*STDERR} "$prog: Error: no such user as '$user'\n"; exit 1; } @@ -4356,8 +4358,8 @@ exit 1; } - if ( !exists $conf{$key} - and !exists $conf{mode_options_reverse}{$key} ) + if ( not exists $conf{$key} + and not exists $conf{mode_options_reverse}{$key} ) { print "Error, unknown config option '$name'\n"; config_help(); @@ -4505,7 +4507,9 @@ } } - if ( $tree and !( ( defined $mode && $mode eq 'stack' ) or $input_file ) ) { + if ( $tree + and not( ( defined $mode and $mode eq 'stack' ) or $input_file ) ) + { cmdline_error("$prog: Error: --tree only works with --stack-trace\n"); } @@ -7018,7 +7022,7 @@ # If supplied with a rank list then use it now to generate a list of # processes to inspect. - if ( exists( $cmd->{ranks} ) ) { + if ( exists $cmd->{ranks} ) { my $rng = rng_dup( $cmd->{ranks} ); # Loop over ranks first as there are potentially more of them. @@ -7183,7 +7187,7 @@ my $lport = $server->sockport(); my $hostname = $confInner{hostname}; - my $key = rand(); + my $key = rand; if ( defined $outerloc ) { my ( $ohost, $oport ) = split( ":", $outerloc ); @@ -7193,7 +7197,7 @@ Proto => 'tcp', ) or confess('Failed to connect to outer'); my $secret = find_padb_secret(); - die('No secret') if not defined $secret; + die 'No secret' if not defined $secret; $os->print("Hello $secret $hostname $lport $key\n"); $os->close(); } else { @@ -7212,7 +7216,7 @@ my $sel = $netdata->{sel}; - my $stime = time(); + my $stime = time; while ( $sel->count() > 0 ) { while ( my @data = $sel->can_read(5) ) { @@ -7220,10 +7224,10 @@ if ( $s == $server ) { my $new = $server->accept() or confess('Failed accept'); $sel->add($new); - my $peer = getpeername($new); + my $peer = getpeername $new; my ( $port, $addr ) = unpack_sockaddr_in($peer); my $ip = inet_ntoa($addr); - my $hostname = gethostbyaddr( $addr, AF_INET ); + my $hostname = gethostbyaddr $addr, AF_INET; my %sinfo; $sinfo{hostname} = $hostname; @@ -7238,12 +7242,12 @@ my $sinfo = $netdata->{connections}{$s}; my $d; - my $count = sysread( $s, $d, 65536 ); + my $count = sysread $s, $d, 65536; # Dead connection. if ( not defined $d or $count == 0 ) { - if ( eof($s) ) { + if ( eof $s ) { $sel->remove($s); $s->close(); $sinfo->{trusted} = 0; @@ -7258,7 +7262,7 @@ } } - my $time = time(); + my $time = time; # Should probably handle this better, if the outer or tree never signons # for whatever reason silently die as it's probably the best thing do to. From codesite-noreply at google.com Mon Sep 7 15:54:56 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 14:54:56 +0000 Subject: [padb-devel] [padb] r202 committed - Cleanup the use of open by always calling the three-argunment version. Message-ID: <0016e64714d0826de40472fe0874@google.com> Revision: 202 Author: apittman Date: Mon Sep 7 07:54:01 2009 Log: Cleanup the use of open by always calling the three-argunment version. http://code.google.com/p/padb/source/detail?r=202 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 07:45:09 2009 +++ /branches/cleanup/src/padb Mon Sep 7 07:54:01 2009 @@ -1848,7 +1848,7 @@ } my @data; - open( my $PCMD, "edb -k $key --stats-raw 2>/dev/null|" ) + open( my $PCMD, '-|', "edb -k $key --stats-raw 2>/dev/null" ) or confess "$prog: cant open file: $!\n"; local $/ = "\n\n"; while (<$PCMD>) { @@ -2600,9 +2600,7 @@ my @jobs; - open( my $LSF, "bjobs -r -u $user 2>/dev/null|" ) or return; - my @out = <$LSF>; - close $LSF; + my @out = slurp_cmd("bjobs -r -u $user"); foreach my $l (@out) { my ( $job, $user, $stat, $queue, $from, $exec, $name, $time ) = split( " ", $l ); @@ -2630,12 +2628,9 @@ my ( $res, $ncpus ) = split( " ", $result ); - open( - my $QUERY, -"rmsquery \"select name from jobs where jobs.resource=\'$res\' and status = \'running\' order by name\"|" + my @out = slurp_cmd( +"rmsquery \"select name from jobs where jobs.resource=\'$res\' and status = \'running\' order by name\"" ); - my @out = <$QUERY>; - close $QUERY; my $rjob; @@ -3236,7 +3231,7 @@ # return; #} - open( my $PCMD, "$file" ) or die "$prog: cant open file $file: $!\n"; + open( my $PCMD, '<', "$file" ) or die "$prog: cant open file $file: $!\n"; my @data = <$PCMD>; close($PCMD); @@ -5759,7 +5754,7 @@ my $lines = 0; send_cont_signal($pid); - open( my $CMD, "$cmd 2>/dev/null|" ) + open( my $CMD, '-|', "$cmd 2>/dev/null" ) || p_die( $vp, "cant start command $cmd" ); while (<$CMD>) { chomp $_; @@ -5774,7 +5769,7 @@ sub run_command { my ( $vp, $cmd ) = @_; debug $vp, "running $cmd"; - open( my $CMDS, "$cmd|" ) || p_die $vp, 'cant fork subcommand'; + open( my $CMDS, '-|', "$cmd" ) || p_die $vp, 'cant fork subcommand'; while (<$CMDS>) { chomp $_; output $vp, $_; @@ -5790,7 +5785,7 @@ my %env; local $/ = "\0"; - open( my $FD, "/proc/$pid/environ" ) or return; + open( my $FD, '<', "/proc/$pid/environ" ) or return; while (<$FD>) { chomp; my @f = split "="; @@ -5814,7 +5809,7 @@ # # Of course it could mean that whatever jobs were supposed # to be running on this node aren't. - open( my $PIDFILE, "/proc/rms/programs/$job/pids" ) or return; + open( my $PIDFILE, '<', "/proc/rms/programs/$job/pids" ) or return; my @procs; @@ -6046,10 +6041,10 @@ if ( $carg->{proc_shows_proc} ) { foreach my $proc ( @{$list} ) { my $pid = $proc->{pid}; - open( $proc->{handle}, "/proc/$pid/stat" ); + open( $proc->{handle}, '<', "/proc/$pid/stat" ); } - open( $SFD, "/proc/stat\n" ); + open( $SFD, '<', '/proc/stat' ); # Begin critical path. my $stat = <$SFD>; @@ -6067,7 +6062,7 @@ # End critical path. $jiffies_start = add_and_divide_jiffies( $stat, $stat2 ); - open( my $LFD, '/proc/loadavg' ); + open( my $LFD, '<', '/proc/loadavg' ); $load_avg = <$LFD>; close $LFD; } From codesite-noreply at google.com Mon Sep 7 19:25:16 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 18:25:16 +0000 Subject: [padb-devel] [padb] r203 committed - More fixes - be more rhobust about using eval and catch a few more err... Message-ID: <0016e68ea0b2b1bd53047300f8a2@google.com> Revision: 203 Author: apittman Date: Mon Sep 7 11:24:28 2009 Log: More fixes - be more rhobust about using eval and catch a few more errors along the way. http://code.google.com/p/padb/source/detail?r=203 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 07:54:01 2009 +++ /branches/cleanup/src/padb Mon Sep 7 11:24:28 2009 @@ -444,7 +444,7 @@ exit 0; } -my $usage = <= [,=...]] [-i ] [-r ] [-u ] -a|-A| @@ -506,6 +506,7 @@ -v --verbose Verbose. -V --version Show version number and exit. -h --help print this usage message. + EOF sub usage { @@ -543,9 +544,7 @@ $usage =~ s{XXXX} {$extra}xms; - print {*STDERR} <{gdbpid} = open3( $gdb->{wtr}, $gdb->{rdr}, $gdb->{err}, $cmd ) - or die "Unable to popen() gdb: $!\n"; + or croak "Unable to popen() gdb: $!"; return $gdb; } @@ -6379,7 +6376,7 @@ return; } -my $mpi_watch_data = <{target_responce} = $allfns{ $cmd->{mode} }{handler_all}( $cmd->{cargs}, $pid_list ); - }; - if ($@) { + 1; + } or do { my $error = $@; my @e = split qr{\n}, $error; $netdata->{host_responce} = "error"; foreach my $proc ( @{$pid_list} ) { target_error( $proc->{vp}, "Critial error: ($e[0])" ); } - } + } } else { my %gres; @@ -7071,13 +7068,13 @@ my $res = $allfns{ $cmd->{mode} }{handler}( $cmd->{cargs}, $vp, $pid ); $gres{$vp} = $res if ( defined $res ); - }; - if ($@) { + 1; + } or do { my $error = $@; my @e = split qr{\n}, $error; $netdata->{host_responce} = "error"; target_error( $vp, "Critial error: ($e[0])" ); - } + } } if (%gres) { @@ -7191,9 +7188,9 @@ PeerPort => $oport, Proto => 'tcp', ) or confess('Failed to connect to outer'); - my $secret = find_padb_secret(); - die 'No secret' if not defined $secret; - $os->print("Hello $secret $hostname $lport $key\n"); + my $sec = find_padb_secret(); + die 'No secret' if not defined $sec; + $os->print("Hello $sec $hostname $lport $key\n"); $os->close(); } else { @@ -7222,13 +7219,13 @@ my $peer = getpeername $new; my ( $port, $addr ) = unpack_sockaddr_in($peer); my $ip = inet_ntoa($addr); - my $hostname = gethostbyaddr $addr, AF_INET; + my $remhost = gethostbyaddr $addr, AF_INET; my %sinfo; - $sinfo{hostname} = $hostname; + $sinfo{hostname} = $remhost; $sinfo{trusted} = 0; $sinfo{port} = $port; - $sinfo{desc} = "$hostname:$port"; + $sinfo{desc} = "$remhost:$port"; $sinfo{socket} = $new; $sinfo{line_cb} = \&command_from_outer; $netdata->{connections}{$new} = \%sinfo; From codesite-noreply at google.com Mon Sep 7 21:55:23 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 20:55:23 +0000 Subject: [padb-devel] [padb] r204 committed - Merge the complex bits of default_output_handler and show_results_from... Message-ID: <00163628430295292e047303117f@google.com> Revision: 204 Author: apittman Date: Mon Sep 7 13:54:28 2009 Log: Merge the complex bits of default_output_handler and show_results_from_file into one function called complex_output_handler. http://code.google.com/p/padb/source/detail?r=204 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 11:24:28 2009 +++ /branches/cleanup/src/padb Mon Sep 7 13:54:28 2009 @@ -3068,6 +3068,11 @@ $allfns{$mode}{out_handler}( undef, $nlines ); return; } + + my $of = 'raw'; + $of = 'tree' if $tree; + $of = 'compress' if $compress; + $of = 'compress_c' if $compress_c; #if ( $mode eq "stack" or $input_file ) { # if ( $strip_below_main or $strip_above_wait ) { @@ -3075,37 +3080,8 @@ # } #} - if ($tree) { - print show_tree( make_tree($lines) ); - } elsif ($compress) { - foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { - next if ( not defined $lines->{$tag} ); - my $rng = rng_create_empty(); - rng_add_value( $rng, $tag ); - foreach my $tag2 ( keys %$lines ) { - next if ( $tag2 eq $tag ); - if ( cmp_list( \@{ $lines->{$tag} }, \@{ $lines->{$tag2} } ) ) { - rng_add_value( $rng, $tag2 ); - delete( $lines->{$tag2} ); - } - } - print("----------------\n"); - printf "%s\n", rng_convert_to_user($rng); - print("----------------\n"); - foreach my $data ( @{ $lines->{$tag} } ) { - print("$data\n"); - } - } - } elsif ($compress_c) { - foreach my $tag ( sort { $a <=> $b } ( keys %$lines ) ) { - print("----------------\n"); - print("$tag\n"); - print("----------------\n"); - foreach my $data ( @{ $lines->{$tag} } ) { - print("$data\n"); - } - } - } + complex_output_handler( $of, $lines ); + return; } @@ -3154,11 +3130,8 @@ # Warn on missing output here... return unless exists $d->{target_output}; - my $lines = $d->{target_output}; - my $mode = $req->{mode}; - my $output = 'raw'; - - $output = $req->{out_format} if defined $req->{out_format}; + my $lines = $d->{target_output}; + my $mode = $req->{mode}; if ( $mode eq 'stack' or $input_file ) { if ( $cargs->{strip_below_main} or $cargs->{strip_above_wait} ) { @@ -3166,6 +3139,27 @@ } } + if ( defined $req->{out_format} ) { + complex_output_handler( $req->{out_format}, $lines ); + } else { + my $nprocesses = keys %{ $d->{target_output} }; + foreach my $process ( sort { $a <=> $b } keys %{ $d->{target_output} } ) + { + foreach my $line ( @{ $d->{target_output}{$process} } ) { + if ( $nprocesses == 1 ) { + print "$line\n"; + } else { + print "$process:$line\n"; + } + } + } + } + return; +} + +sub complex_output_handler { + my ( $output, $lines ) = @_; + if ( $output eq 'tree' ) { print show_tree( make_tree($lines) ); } elsif ( $output eq 'compress' ) { @@ -3198,17 +3192,7 @@ } } } else { - my $nprocesses = keys %{ $d->{target_output} }; - foreach my $process ( sort { $a <=> $b } keys %{ $d->{target_output} } ) - { - foreach my $line ( @{ $d->{target_output}{$process} } ) { - if ( $nprocesses == 1 ) { - print "$line\n"; - } else { - print "$process:$line\n"; - } - } - } + die("Unexpected output mode $output"); } return; } From codesite-noreply at google.com Mon Sep 7 22:12:52 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 21:12:52 +0000 Subject: [padb-devel] [padb] r205 committed - Effectively disable the code to re-try getting stack traces with gdb b... Message-ID: <0016e646417e16cadb0473035083@google.com> Revision: 205 Author: apittman Date: Mon Sep 7 14:11:38 2009 Log: Effectively disable the code to re-try getting stack traces with gdb by setting gdb-retry-count to zero. This used to be helpful on ia64 but just costs time on machines where gdb is more capable. http://code.google.com/p/padb/source/detail?r=205 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 13:54:28 2009 +++ /branches/cleanup/src/padb Mon Sep 7 14:11:38 2009 @@ -6174,6 +6174,15 @@ # not spinning whilst gdb is doing it's thing which will mean a quicker runtime # but also that the resulting stack traces will have less artifacts because running # processes bunch up behind the non-running ones. + +# We used to reguarly get garbage from gdb so there is a test here for finding +# main, with code to detach and try again if we don't. This served us well on +# ia64 where gdb isn't very good however it as on most machines gdb gives +# you results below main (__libc_start_main()) this test fails which causes +# padb to loop a number of times for each procees on a node. For now I've left +# the code to loop here but have set the default gdb_retry_count to zero to +# disable the code in the simple case. This option will probably be removed +# completely soon. sub stack_trace_from_pids { my ( $carg, $list ) = @_; @@ -7434,7 +7443,7 @@ options_i => { stack_shows_params => 0, stack_shows_locals => 0, - gdb_retry_count => 3, + gdb_retry_count => 0, stack_strip_above => 'elan_waitWord,elan_pollWord,elan_deviceCheck,opal_condition_wait,opal_progress', stack_strip_below => 'main', From codesite-noreply at google.com Mon Sep 7 22:58:14 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Mon, 07 Sep 2009 21:58:14 +0000 Subject: [padb-devel] [padb] r206 committed - Move the code to strip stack traces (remove functions above main) from... Message-ID: <005045017e3251a69b047303f2cc@google.com> Revision: 206 Author: apittman Date: Mon Sep 7 14:57:54 2009 Log: Move the code to strip stack traces (remove functions above main) from the outer process to the node-agent, this should both help performance (code run on the nodes is run in parallel, in the outer process is serial) and is a necessairy per-curser to output reduction in the network. http://code.google.com/p/padb/source/detail?r=206 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 14:11:38 2009 +++ /branches/cleanup/src/padb Mon Sep 7 14:57:54 2009 @@ -2826,6 +2826,8 @@ # ############################################################################### +# This function isn't called but I've kept it for now in case it becomes +# needed when dealing with files. sub strip_stack_traces { my ( $cargs, $lines ) = @_; @@ -3133,11 +3135,12 @@ my $lines = $d->{target_output}; my $mode = $req->{mode}; - if ( $mode eq 'stack' or $input_file ) { - if ( $cargs->{strip_below_main} or $cargs->{strip_above_wait} ) { - strip_stack_traces( $cargs, $lines ); - } - } + # This is done internally by the node-agent now. + #if ( $mode eq 'stack' or $input_file ) { + # if ( $cargs->{strip_below_main} or $cargs->{strip_above_wait} ) { + # strip_stack_traces( $cargs, $lines ); + # } + #} if ( defined $req->{out_format} ) { complex_output_handler( $req->{out_format}, $lines ); @@ -6187,6 +6190,17 @@ my ( $carg, $list ) = @_; my @all; + + my %above; + my %below; + + if ( $carg->{strip_above_wait} ) { + map { $above{$_} = 1 } split qr{,}, $carg->{stack_strip_above}; + } + + if ( $carg->{strip_below_main} ) { + map { $below{$_} = 1 } split qr{,}, $carg->{stack_strip_below}; + } foreach my $proc ( @{$list} ) { my $vp = $proc->{vp}; @@ -6265,12 +6279,13 @@ and ( $tries < $carg->{gdb_retry_count} ) ); if ( not defined $threads[0]{id} ) { - output( $vp, 'Could not extract stack trace from application' ); + target_error( $vp, + 'Could not extract stack trace from application' ); return; } if ( defined $threads[0]{error} ) { - output( $vp, $threads[0]{error} ); + target_error( $vp, $threads[0]{error} ); return; } @@ -6279,21 +6294,43 @@ my @frames = @{ $thread->{frames} }; output( $vp, "ThreadId: $thread->{id}" ) if ( $#threads != 0 ); + + my $strip_below; + + # Find a funtion to strip above. Only actually enable + # this if there is a function present which we are targeting + # or else no output will be generated! + if ( $carg->{strip_below_main} ) { + foreach my $frame (@frames) { + next unless exists $frame->{func}; + if ( defined $below{ $frame->{func} } ) { + $strip_below = $frame->{func}; + } + } + } for ( my $i = $#frames ; $i >= 0 ; $i-- ) { my $frame = $frames[$i]; - output( $vp, "ERROR: $$frame{error}" ) - if exists $$frame{error}; - - next unless exists $$frame{level}; - next unless exists $$frame{func}; + target_error( $vp, "error from gdb: $frame->{error}" ) + if exists $frame->{error}; + + next unless exists $frame->{level}; + next unless exists $frame->{func}; + + # This seemingly always gets set by gdb even if it is + # sometimes set to '??' + my $function = $frame->{func}; + + next if ( defined $strip_below and $strip_below ne $function ); + + $strip_below = undef; output( $vp, - ( $$frame{func} || '?' ) + $function . '() at ' - . ( $$frame{file} || '?' ) . ':' - . ( $$frame{line} || '?' ) ); + . ( $frame->{file} || '?' ) . ':' + . ( $frame->{line} || '?' ) ); if ( $carg->{stack_shows_params} ) { show_stack_vars( $vp, $frame, 'params' ); } @@ -6301,6 +6338,10 @@ show_stack_vars( $vp, $frame, 'locals' ); } + # Strip below this function if we need to. + if ( defined $above{$function} ) { + last; + } } } } From codesite-noreply at google.com Tue Sep 8 19:38:09 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 18:38:09 +0000 Subject: [padb-devel] [padb] r207 committed - Don't quote backticks in the usage message, it's not needed now the st... Message-ID: <001636283c489d7f9304731544ff@google.com> Revision: 207 Author: apittman Date: Tue Sep 8 11:37:33 2009 Log: Don't quote backticks in the usage message, it's not needed now the string is quoted itself. http://code.google.com/p/padb/source/detail?r=207 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Mon Sep 7 14:57:54 2009 +++ /branches/cleanup/src/padb Tue Sep 8 11:37:33 2009 @@ -459,8 +459,8 @@ XXXX --full-report= Generate a full report of job state. - --nostrip-below-main Don\'t strip stack traces below main. - --nostrip-above-wait Don\'t strip stack traces about elan_waitWord. + --nostrip-below-main Don't strip stack traces below main. + --nostrip-above-wait Don't strip stack traces about elan_waitWord. --proc-format Specify information to show about processes. From codesite-noreply at google.com Tue Sep 8 19:42:14 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 18:42:14 +0000 Subject: [padb-devel] [padb] r208 committed - if ( 0 ) out the debug code from make_tree, it was increasing the runt... Message-ID: <0016368e1d7e3d09aa0473155346@google.com> Revision: 208 Author: apittman Date: Tue Sep 8 11:40:20 2009 Log: if ( 0 ) out the debug code from make_tree, it was increasing the runtime required by a factor of three! http://code.google.com/p/padb/source/detail?r=208 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 11:37:33 2009 +++ /branches/cleanup/src/padb Tue Sep 8 11:40:20 2009 @@ -1916,8 +1916,10 @@ my $prev; my $tag = rng_shift($trange); - debug_log( 'tree', undef, 'called tag:%s, level:%d tags %s', - $tag, $level, rng_convert_to_user($trange) ); + if (0) { + debug_log( 'tree', undef, 'called tag:%s, level:%d tags %s', + $tag, $level, rng_convert_to_user($trange) ); + } return if ( not defined $tag ); return if ( not defined $lines->{$tag} ); @@ -1970,13 +1972,15 @@ $endlevel = ( $#{ $lines->{$tag} } ); } - debug_log( - 'tree', - undef, - "level $level, endlevel $endlevel, identical:%s different: %s", - rng_convert_to_user( rng_create_from_array(@identical) ), - rng_convert_to_user($different_rng) - ); + if (0) { + debug_log( + 'tree', + undef, + "level $level, endlevel $endlevel, identical:%s different: %s", + rng_convert_to_user( rng_create_from_array(@identical) ), + rng_convert_to_user($different_rng) + ); + } for ( my $l = $level ; $l <= $endlevel ; $l++ ) { @@ -2011,13 +2015,15 @@ $prev->{children} = _make_tree( $endlevel + 1, $lines, $r ); } - debug_log( - 'tree', - undef, - "returning level:$level endlevel:$endlevel identical:%s different: %s", - rng_convert_to_user( rng_create_from_array(@identical) ), - rng_convert_to_user($different_rng) - ); + if (0) { + debug_log( + 'tree', + undef, +"returning level:$level endlevel:$endlevel identical:%s different: %s", + rng_convert_to_user( rng_create_from_array(@identical) ), + rng_convert_to_user($different_rng) + ); + } if ( not rng_empty($different_rng) ) { my $new = _make_tree( $level, $lines, $different_rng ); From codesite-noreply at google.com Tue Sep 8 20:16:46 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 19:16:46 +0000 Subject: [padb-devel] [padb] r209 committed - Check that at least one process has been found in check_signon and abo... Message-ID: <0016368e1fecba867e047315ced1@google.com> Revision: 209 Author: apittman Date: Tue Sep 8 12:16:20 2009 Log: Check that at least one process has been found in check_signon and abort with a friendly error message if none are found. http://code.google.com/p/padb/source/detail?r=209 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 11:40:20 2009 +++ /branches/cleanup/src/padb Tue Sep 8 12:16:20 2009 @@ -3442,14 +3442,18 @@ push @commands, \%cmd; return; } + +sub last_command { + my $req; + $req->{mode} = 'exit'; + return $req; +} sub next_command { my $comm_data = shift; if ( $#commands == -1 ) { - my $req; - $req->{mode} = 'exit'; - return $req; + return last_command(); } my $cmd; @@ -3512,9 +3516,19 @@ return; } +# Check all processes are detected and report an error to the user. Return true if +# there is no processes are detected. sub check_signon { my ( $comm_data, $data ) = @_; return if ( $conf{check_signon} eq 'none' ); + + if ( not defined $data->{target_data}{found}{yes} + or rng_empty( $data->{target_data}{found}{yes} ) ) + { + printf "Warning, failed to locate any ranks\n"; + return 1; + } + my %here; while ( defined( my $proc = rng_shift( $data->{target_data}{found}{yes} ) ) ) @@ -3594,10 +3608,19 @@ # The inner process has signed on. if ( $comm_data->{current_req}->{mode} eq 'signon' ) { - $comm_data->{current_req} = next_command($comm_data); + + # Check the signon messages, reporting minor errors to the user, if no + # processes are found then don't bother processing any commands but just + # tell the inner to exit. + my $error = check_signon( $comm_data, $d ); + if ($error) { + $comm_data->{current_req} = last_command(); + } else { + $comm_data->{current_req} = next_command($comm_data); + } + issue_command_to_inner( $cdata, $comm_data->{current_req} ); $comm_data->{state} = 'live'; - check_signon( $comm_data, $d ); return; } From codesite-noreply at google.com Tue Sep 8 20:20:07 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 19:20:07 +0000 Subject: [padb-devel] [padb] r210 committed - Improve and document the performance of the rng_add_value() function i... Message-ID: <001485f854beb7a4ca047315da71@google.com> Revision: 210 Author: apittman Date: Tue Sep 8 12:19:39 2009 Log: Improve and document the performance of the rng_add_value() function in the common case, don't abort if a value is already in the range. http://code.google.com/p/padb/source/detail?r=210 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 12:16:20 2009 +++ /branches/cleanup/src/padb Tue Sep 8 12:19:39 2009 @@ -3887,6 +3887,11 @@ return $value; } +# Note the performance of this function is much higher when adding +# values at the top of the range than at the start, persumably it's +# easier to make an array longer than it is to unshift something onto +# the start. +# Quietly return if the value is already in the range. sub rng_add_value { my ( $rg, $value ) = @_; @@ -3896,7 +3901,13 @@ } # If it's after the last value then just add it. - if ( $value > $rg->[-1]->{u} + 1 ) { + if ( $value > $rg->[-1]->{u} ) { + + if ( $value == $rg->[-1]->{u} + 1 ) { + $rg->[-1]->{u}++; + return; + } + push @{$rg}, { l => $value, u => $value }; return; } @@ -3928,7 +3939,8 @@ } return; } elsif ( $value >= $part->{l} and $value <= $part->{u} ) { - carp('Failed to add value to range (Value already in range)'); + + # Already in range. return; } $idx++; From codesite-noreply at google.com Tue Sep 8 20:25:31 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 19:25:31 +0000 Subject: [padb-devel] [padb] r211 committed - Look after gdb handles better, don't create them as empty string but a... Message-ID: <0016e640d22208a0b7047315ee1c@google.com> Revision: 211 Author: apittman Date: Tue Sep 8 12:24:56 2009 Log: Look after gdb handles better, don't create them as empty string but allow perl to create them itself and only close them if they have actually been opened. http://code.google.com/p/padb/source/detail?r=211 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 12:19:39 2009 +++ /branches/cleanup/src/padb Tue Sep 8 12:24:56 2009 @@ -4658,7 +4658,9 @@ return is_resmgr_process($parent_pid); } -$SIG{PIPE} = 'IGNORE'; +# This used to happen on ia64 when gdb segfaulted, I've not seen that for a number +# of years however so lets try not doing it for a while and see where that gets us. +#$SIG{PIPE} = 'IGNORE'; sub gdb_start { my ( $exe, $core ) = @_; @@ -4666,9 +4668,6 @@ gdbpid => -1, tracepid => -1, attached => 0, - rdr => "", - wtr => "", - err => "", }; my $cmd = 'gdb --interpreter=mi -q'; @@ -4686,9 +4685,10 @@ my ($gdb) = @_; my $result = gdb_send( $gdb, 'quit' ); waitpid( $gdb->{gdbpid}, 0 ); - close( $gdb->{rdr} ); - close( $gdb->{wtr} ); - close( $gdb->{err} ); + foreach my $fdname (qw(rdr wtr err)) { + next unless exists $gdb->{$fdname}; + close( $gdb->{$fdname} ); + } return; } From codesite-noreply at google.com Tue Sep 8 20:35:47 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 19:35:47 +0000 Subject: [padb-devel] [padb] r212 committed - Re-enable the gdb_retry_count code by default but lower it's cost by r... Message-ID: <001636ed69f9b797d704731612fe@google.com> Revision: 212 Author: apittman Date: Tue Sep 8 12:34:43 2009 Log: Re-enable the gdb_retry_count code by default but lower it's cost by removing the sleep(1). http://code.google.com/p/padb/source/detail?r=212 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 12:24:56 2009 +++ /branches/cleanup/src/padb Tue Sep 8 12:34:43 2009 @@ -6223,10 +6223,11 @@ # main, with code to detach and try again if we don't. This served us well on # ia64 where gdb isn't very good however it as on most machines gdb gives # you results below main (__libc_start_main()) this test fails which causes -# padb to loop a number of times for each procees on a node. For now I've left -# the code to loop here but have set the default gdb_retry_count to zero to -# disable the code in the simple case. This option will probably be removed -# completely soon. +# padb to loop a number of times for each procees on a node. +# We still sometimes get garbage (due to hand-rolled memcpy()) so leave the loop +# in but don't sleep every iteration. +# This could be handled better by checking for the presence of one of the +# stack_strip_below functions in the stack trace. sub stack_trace_from_pids { my ( $carg, $list ) = @_; @@ -6278,7 +6279,6 @@ if ($tries) { debug $vp, "Re-attaching to $pid, $tries"; send_cont_signal($pid); - sleep(1); my $g = gdb_start(); if ( gdb_attach( $g, $pid ) ) { $gdb = $g; @@ -6322,12 +6322,12 @@ if ( not defined $threads[0]{id} ) { target_error( $vp, 'Could not extract stack trace from application' ); - return; + next; } if ( defined $threads[0]{error} ) { target_error( $vp, $threads[0]{error} ); - return; + next; } foreach my $thread ( sort { $a->{id} <=> $b->{id} } @threads ) { @@ -7118,7 +7118,7 @@ # Even if a exception is generated rank output may still exist for that # or any other rank on this node, we'll have to see if that causes problems - # or if it's best to clear the target_key_pait() and output() data for this + # or if it's best to clear the target_key_pair() and output() data for this # node/rank. if ( defined $allfns{ $cmd->{mode} }{handler_all} ) { eval { @@ -7525,10 +7525,10 @@ options_i => { stack_shows_params => 0, stack_shows_locals => 0, - gdb_retry_count => 0, + gdb_retry_count => 3, stack_strip_above => 'elan_waitWord,elan_pollWord,elan_deviceCheck,opal_condition_wait,opal_progress', - stack_strip_below => 'main', + stack_strip_below => 'main,__libc_start_main', }, secondary => [ { From codesite-noreply at google.com Tue Sep 8 20:40:06 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 19:40:06 +0000 Subject: [padb-devel] [padb] r213 committed - Bug fix: If when re-attaching to a process to get a better stack trace... Message-ID: <001636ed71702a1fc9047316224f@google.com> Revision: 213 Author: apittman Date: Tue Sep 8 12:39:08 2009 Log: Bug fix: If when re-attaching to a process to get a better stack trace the attach fails check the correct value when reporting an error message. Furthermore checking the wrong value was causing $gdb to be created which made a further test in the code incorrectly pass and a invalid $gdb handle being passed to gdb_dump_frames_per_thread() which was causing the code to crash with invalid fd messages. http://code.google.com/p/padb/source/detail?r=213 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 12:34:43 2009 +++ /branches/cleanup/src/padb Tue Sep 8 12:39:08 2009 @@ -6283,8 +6283,8 @@ if ( gdb_attach( $g, $pid ) ) { $gdb = $g; } else { - if ( defined $gdb->{error} ) { - target_error( $vp, $gdb->{error} ); + if ( defined $g->{error} ) { + target_error( $vp, $g->{error} ); } else { target_error( $vp, 'Failed to attach to process' ); } From codesite-noreply at google.com Tue Sep 8 21:04:07 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 20:04:07 +0000 Subject: [padb-devel] [padb] r214 committed - Guard against errors if the target process dies whilst we are initiali... Message-ID: <001636b2b3ff1559170473167811@google.com> Revision: 214 Author: apittman Date: Tue Sep 8 13:03:00 2009 Log: Guard against errors if the target process dies whilst we are initialising, check the return code of all calls to query it's status and ignore it completely if it disappears. This removes a number of errors when the process dies. http://code.google.com/p/padb/source/detail?r=214 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 12:39:08 2009 +++ /branches/cleanup/src/padb Tue Sep 8 13:03:00 2009 @@ -6648,6 +6648,19 @@ } return; } + +sub hash_from_status { + my ($pid) = @_; + my %status; + my @pairs = slurp_file("/proc/$pid/status"); + return unless @pairs; + foreach my $pair (@pairs) { + if ( $pair =~ m{\A(\w+):\s*(.+)}x ) { + $status{$1} = $2; + } + } + return \%status; +} sub is_resmgr_process { my $pid = shift; @@ -6947,7 +6960,13 @@ next unless defined $rmpid; - if ( defined $scripts{ pid_to_name($pid) } ) { + # Handle with the process going away whilst we look here, + # if we don't have a name then it's gone and we should + # continue without it. + my $name = pid_to_name($pid); + next unless defined $name; + + if ( defined $scripts{$name} ) { push @{ $ipids->{$rmpid}{scripts} }, $pid; } else { push @{ $ipids->{$rmpid}{notscripts} }, $pid; @@ -6976,13 +6995,17 @@ # The process might have died and we simply didn't find anything, # if this is the case then just skip it, the outer will notice # the missing signon and report an approtiate error. - if ( defined $newpid ) { - push @apids, - { - pid => $newpid, - vp => $ip->{rank} - }; - } + next unless defined $newpid; + + my $status = hash_from_status($newpid); + next unless defined $status; + push @apids, + { + pid => $newpid, + vp => $ip->{rank}, + status => $status, + }; + } # Sort local pids by order of increasing rank. @@ -7006,13 +7029,11 @@ convert_pids_to_child_pids(); foreach my $proc ( @{ $confInner{all_pids} } ) { - my $pid = $proc->{pid}; - my $vp = $proc->{vp}; - my $name = readlink("/proc/$pid/exe"); - my $state = find_from_status( $pid, 'State' ); + my $pid = $proc->{pid}; + my $vp = $proc->{vp}; target_key_pair( $vp, 'found', 'yes' ); - target_key_pair( $vp, 'name', $name ); - target_key_pair( $vp, 'state', $state ); + target_key_pair( $vp, 'name', $proc->{status}->{Name} ); + target_key_pair( $vp, 'state', $proc->{status}->{State} ); } return; } @@ -7095,8 +7116,7 @@ # Loop over ranks first as there are potentially more of them. while ( defined( my $rank = rng_shift($rng) ) ) { foreach my $proc ( @{ $confInner{all_pids} } ) { - my $vp = $proc->{vp}; - my $pid = $proc->{pid}; + my $vp = $proc->{vp}; if ( $vp == $rank ) { push @{$pid_list}, $proc; } From codesite-noreply at google.com Tue Sep 8 21:58:35 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Tue, 08 Sep 2009 20:58:35 +0000 Subject: [padb-devel] [padb] r215 committed - An epic change to make striping of stack traces from an input file wor... Message-ID: <00163623a7a5de2d300473173a19@google.com> Revision: 215 Author: apittman Date: Tue Sep 8 13:57:32 2009 Log: An epic change to make striping of stack traces from an input file work, re-organise the way secondary args are handled so the code can access them the same way as they do config options. http://code.google.com/p/padb/source/detail?r=215 Modified: /branches/cleanup/src/padb ======================================= --- /branches/cleanup/src/padb Tue Sep 8 13:03:00 2009 +++ /branches/cleanup/src/padb Tue Sep 8 13:57:32 2009 @@ -584,10 +584,6 @@ my %ic_names; my %ic_names_cmd; -# Populated in the outer args section so that outer code -# can access secondary comamnd line argunments by name. -my %secondary_args; - # Debugging: this function is called periodically with # a mode, an abritary ref and a string, it can either print simply # the string or call dumper on the ref as well. @@ -700,19 +696,24 @@ 'debug=s' => \$debugflag, ); + # The primary modes, one of these only must be set. my %config_hash; + + # The secondary args, specify all of them for now as we only + # call GetOptions once. + my %sec_args; + foreach my $arg ( keys %allfns ) { + + # Set the primary mode in the hash. $optionhash{ $allfns{$arg}{arg} } = \$config_hash{$arg}; + if ( defined $allfns{$arg}{secondary} ) { foreach my $sec ( @{ $allfns{$arg}{secondary} } ) { - $sec->{value} = $sec->{default}; - $optionhash{ $sec->{arg} } = \$sec->{value}; - } - } - if ( defined $allfns{$arg}{options_i} ) { - foreach my $o ( keys %{ $allfns{$arg}{options_i} } ) { - $conf{mode_options}{$arg}{$o} = $allfns{$arg}{options_i}{$o}; - $conf{mode_options_reverse}{$o}{$arg} = 1; + + # Set this option in the option hash. + $optionhash{ $sec->{arg} } = \$sec_args{ $sec->{arg_long} }; + } } } @@ -753,10 +754,30 @@ } } - # Put the args in a hash so that they can be referenced by name. - if ( defined $mode and defined $allfns{$mode}{secondary} ) { - foreach my $sec ( @{ $allfns{$mode}{secondary} } ) { - $secondary_args{ $sec->{arg_long} } = $sec->{value}; + foreach my $arg ( keys %allfns ) { + if ( defined $allfns{$arg}{options_i} ) { + foreach my $o ( keys %{ $allfns{$arg}{options_i} } ) { + $conf{mode_options}{$arg}{$o} = $allfns{$arg}{options_i}{$o}; + $conf{mode_options_reverse}{$o}{$arg} = 1; + } + } + + if ( defined $allfns{$arg}{secondary} ) { + foreach my $sec ( @{ $allfns{$arg}{secondary} } ) { + + # If this is set then take the value it was set to. + if ( defined $sec_args{ $sec->{arg_long} } ) { + $conf{mode_options}{$arg}{ $sec->{arg_long} } = + $sec_args{ $sec->{arg_long} }; + } else { + + # Else set it to the default for this mode. + $conf{mode_options}{$arg}{ $sec->{arg_long} } = + $sec->{default}; + } + + $conf{mode_options_reverse}{ $sec->{arg_long} }{$arg} = 1; + } } } @@ -3066,9 +3087,8 @@ return; } -# XXX: Now only called when loading things from file. sub show_results_from_file { - my ( $nlines, $mode, $handle ) = @_; + my ( $nlines, $mode ) = @_; my $lines = $nlines->{lines}; @@ -3082,11 +3102,13 @@ $of = 'compress' if $compress; $of = 'compress_c' if $compress_c; - #if ( $mode eq "stack" or $input_file ) { - # if ( $strip_below_main or $strip_above_wait ) { - # strip_stack_traces(undef,$lines); - # } - #} + if ( $mode eq 'stack' ) { + if ( $conf{mode_options}{stack}{strip_above_wait} + or $conf{mode_options}{stack}{strip_below_main} ) + { + strip_stack_traces( $conf{mode_options}{stack}, $lines ); + } + } complex_output_handler( $of, $lines ); @@ -3233,7 +3255,7 @@ process_line( $line, \%lines ); } post_process_lines( \%lines ); - show_results_from_file( \%lines, $mode, undef ); + show_results_from_file( \%lines, $mode ); return; } @@ -3480,16 +3502,6 @@ if ( defined $cmd->{out_format} ) { $req->{out_format} = $cmd->{out_format}; } - - # Send along the secondary args, taking care not to override any that - # are already defined. - if ( defined $allfns{ $req->{mode} }{secondary} ) { - foreach my $sec ( @{ $allfns{ $req->{mode} }{secondary} } ) { - if ( not defined $req->{cargs}{ $sec->{arg_long} } ) { - $req->{cargs}{ $sec->{arg_long} } = $sec->{value}; - } - } - } if ( $conf{verbose} and defined $req->{cargs} ) { print "Mode '$req->{mode}' mode specific flags:\n"; @@ -4373,13 +4385,6 @@ $key =~ s/\-/\_/g; - if ( $key eq 'scriptDir' ) { - print( -"$prog: -OscriptDir deprecated, use -Oedb=/path/to/edb instead\n" - ); - exit 1; - } - if ( not exists $conf{$key} and not exists $conf{mode_options_reverse}{$key} ) { @@ -4520,7 +4525,7 @@ # If delivering a signal check that it's valid. if ( defined $mode and ( $mode eq 'kill' ) ) { - my $signal = uc( $secondary_args{signal} ); + my $signal = uc $conf{mode_options}{kill}{signal}; my %sig_names; map { $sig_names{$_} = 1 } split( " ", $Config{sig_name} ); @@ -7029,8 +7034,8 @@ convert_pids_to_child_pids(); foreach my $proc ( @{ $confInner{all_pids} } ) { - my $pid = $proc->{pid}; - my $vp = $proc->{vp}; + my $pid = $proc->{pid}; + my $vp = $proc->{vp}; target_key_pair( $vp, 'found', 'yes' ); target_key_pair( $vp, 'name', $proc->{status}->{Name} ); target_key_pair( $vp, 'state', $proc->{status}->{State} ); From codesite-noreply at google.com Wed Sep 9 11:23:24 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Wed, 09 Sep 2009 10:23:24 +0000 Subject: [padb-devel] [padb] r216 committed - Rename ga.html to footer.html Message-ID: <0016367b65c61e85a6047322794b@google.com> Revision: 216 Author: apittman Date: Wed Sep 9 03:22:19 2009 Log: Rename ga.html to footer.html http://code.google.com/p/padb/source/detail?r=216 Added: /trunk/doc/footer.html Deleted: /trunk/doc/ga.html Modified: /trunk/doc/upload_website ======================================= --- /dev/null +++ /trunk/doc/footer.html Wed Sep 9 03:22:19 2009 @@ -0,0 +1,19 @@ + + + + + + + ======================================= --- /trunk/doc/ga.html Mon Jun 8 13:34:11 2009 +++ /dev/null @@ -1,10 +0,0 @@ - - - ======================================= --- /trunk/doc/upload_website Mon Jun 15 13:38:38 2009 +++ /trunk/doc/upload_website Wed Sep 9 03:22:19 2009 @@ -15,7 +15,7 @@ TFILE=`mktemp` cat header.html > $TFILE cat $FILE.html >> $TFILE - cat ga.html >> $TFILE + cat footer.html >> $TFILE ftp-upload --host padb.pittman.org.uk -u padb at pittman.co.uk --password $PASSWORD --as $FILE.html $TFILE ftp-upload --host padb.pittman.org.uk -u padb at pittman.co.uk --password $PASSWORD --as $FILE/index.html $TFILE rm $TFILE From codesite-noreply at google.com Wed Sep 9 11:34:30 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Wed, 09 Sep 2009 10:34:30 +0000 Subject: [padb-devel] [padb] r217 committed - Add svn Revision and Date tags. Message-ID: <0016e6470f36c467b7047322a074@google.com> Revision: 217 Author: apittman Date: Wed Sep 9 03:33:45 2009 Log: Add svn Revision and Date tags. http://code.google.com/p/padb/source/detail?r=217 Modified: /trunk/doc/upload_website ======================================= --- /trunk/doc/upload_website Wed Sep 9 03:22:19 2009 +++ /trunk/doc/upload_website Wed Sep 9 03:33:45 2009 @@ -1,5 +1,9 @@ #!/bin/sh +# upload_website: Basic formating and upload script for http://padb.pittman.co.uk +# $Revision$ +# $Date$ + set -e echo Uploading website to http://padb.pittman.org.uk From codesite-noreply at google.com Wed Sep 9 11:56:49 2009 From: codesite-noreply at google.com (codesite-noreply at google.com) Date: Wed, 09 Sep 2009 10:56:49 +0000 Subject: [padb-devel] [padb] r218 committed - Modify the website to use css and do basic formatting of content. Message-ID: <001485f854be9ac284047322f0c2@google.com> Revision: 218 Author: apittman Date: Wed Sep 9 03:55:53 2009 Log: Modify the website to use css and do basic formatting of content. http://code.google.com/p/padb/source/detail?r=218 Added: /trunk/doc/build_website /trunk/doc/layout.css Modified: /trunk/doc/download.html /trunk/doc/email.html /trunk/doc/extensions.html /trunk/doc/footer.html /trunk/doc/header.html /trunk/doc/index.html /trunk/doc/modes.html /trunk/doc/usage.html ======================================= --- /dev/null +++ /trunk/doc/build_website Wed Sep 9 03:55:53 2009 @@ -0,0 +1,27 @@ +#!/bin/sh + +# build_website: Basic formating script for http://padb.pittman.co.uk +# $Revision$ +# $Date$ + +set -e + +echo Uploading website to http://padb.pittman.org.uk + +FILES="index usage download email extensions modes" + +TDIR=public + +mkdir -p public + +cp layout.css $TDIR +for FILE in $FILES +do + echo Uploading $FILE + cat header.html > $TDIR/$FILE + cat $FILE.html >> $TDIR/$FILE + cat footer.html >> $TDIR/$FILE +done + +echo All done. +exit 0 ======================================= --- /dev/null +++ /trunk/doc/layout.css Wed Sep 9 03:55:53 2009 @@ -0,0 +1,19 @@ + +#header { + clear: both; +} + +#navigation { + float: left; + width: 14em; +} + +#content { + margin-left: 15em; +} + + +#footer { + clear: both; +} + ======================================= --- /trunk/doc/download.html Wed Jun 24 01:08:32 2009 +++ /trunk/doc/download.html Wed Sep 9 03:55:53 2009 @@ -1,4 +1,4 @@ - +

Current stable release

The latest stable release, 2.5 can be downloaded direct from the google downloads section. @@ -32,4 +32,10 @@ 
  svn checkout http://padb.googlecode.com/svn/trunk/ padb
- +
+ ======================================= --- /trunk/doc/email.html Thu May 28 14:55:06 2009 +++ /trunk/doc/email.html Wed Sep 9 03:55:53 2009 @@ -1,3 +1,4 @@ +

Mailing Lists

Mailing lists for padb discussion and development are available for public use, @@ -10,3 +11,10 @@
  • padb-users (archives)for discussion on the use of padb and general questions.
    • +
    + ======================================= --- /trunk/doc/extensions.html Wed Jun 10 06:43:10 2009 +++ /trunk/doc/extensions.html Wed Sep 9 03:55:53 2009 @@ -1,4 +1,4 @@ - +

    MPI collective debugger extension proposal

    Overview

    @@ -107,3 +107,10 @@

    Patch for OpenMPI trunk. +

    + ======================================= --- /trunk/doc/footer.html Wed Sep 9 03:22:19 2009 +++ /trunk/doc/footer.html Wed Sep 9 03:55:53 2009 @@ -1,12 +1,3 @@ - - - -