#!/usr/bin/perl
#: report the parent of the current process, and its parent, etc...
#======================================================================
# Time-stamp: "2008-12-05 02:55:10 AKST sburke@cpan.org"
# sburke@cpan.org
use constant DEBUG => 0;
use strict; use warnings;
#======================================================================

# Do "lns parentage lineage", and this the program will behave
# differently depending on how you call it.  I.e., parentage is
# lineage minus the first line.

# To explain:
my $Skip_Target;
if(     $0 =~ m/lineage/i  ) { # ...a process's lineage includes itself,
  $Skip_Target = 0;
} elsif($0 =~ m/parentage/i) { # ...but its parentage doesn't.
  $Skip_Target = 1;
} else {
  #die "I can't tell whether I was called as 'lineage' or 'parentage'\n Aborting";
  ##Nah, just assume lineage
  $Skip_Target = 0;  
}

# End of anything interesting.
#======================================================================

$| = 1;
my $A = "\n Aborting";
my $Proc = "/proc/";
die "I can't work-- I can't see a /proc filesystem on this machine$A"
 unless -e $Proc;

my $Iteration_Depth = 0;
my $Iteration_Depth_Limit = 40;

my $My_Pid = $$;
die "WHAT?!?! MY PID IS $My_Pid?!?!" if $My_Pid == 1 or $My_Pid == 0;
die "The /proc on this machine seems broken-- I can't find my own process$A"
 unless "$Proc/$My_Pid";


Main();
exit;
my $Skip_First_Few = 0;
sub Main {
  DEBUG and print "I am $$ = $0\n";
  my $pid= parse_args();
  #lineage($pid);
  lineage();
  return;
}
#======================================================================

sub lineage {
  #my($procnum) = @_;
  my $procnum;

  $procnum = parse_args($procnum);

  while(1) {
    DEBUG > 20 and print "On loop start, procnum = $procnum\n";
    die "TOO MUCH LOOPING"
     if ++$Iteration_Depth
      and $Iteration_Depth_Limit
      and $Iteration_Depth  > $Iteration_Depth_Limit;
    $procnum = details_about($procnum);
    last unless $procnum;
    DEBUG and sleep 1;
  }
  return;
}
#======================================================================

sub parse_args {
  $Skip_First_Few = 0 + $Skip_Target;

  if(@ARGV == 0) {
    $Skip_First_Few++; # Skip myself!
    return $$;

  } elsif(@ARGV == 1) {
    my $proc = $ARGV[0];

    die "A PID has to be an integer, not like \"$proc\"$A"
     unless $proc =~ m<\A [0-9]{1,7} \z>x;  # sanity

    return $proc;

  } else {
    Usage();
  }
}

#======================================================================

sub details_about {  # return parent proc num
  my( $num ) = $_[0];

  my $proc_file = "/proc/$num/stat";
  DEBUG and print "Reading $proc_file\n";
  die "Can't find proc # $num : no $proc_file" unless -e $proc_file;

  open my $IN, "<", $proc_file or die "Can't open $num: $!";
  chomp(my $line = readline($IN));
  die "No line from $proc_file!?" unless defined $line and $line =~ m/\S/;
  DEBUG and print "Got line: {$line}\n";

  close($IN);
  undef $IN;

  my($my_pid, $my_execname, $parent_pid, $etc) =
   $line =~
    m<\A
     #All from "man 5 proc":
     #  "9357 (csh) S 19945 9357 19945 34816..."

     ( [0-9]+ )       # our PID
         \s+
  \( ( [^\(\)]+ ) \)  # our own executable name
         \s+
       [A-Z]          # state
         \s+
     ( [0-9]+ )       # parent's pid
         \s+
     (.+)             # whole rest of the line
    >x
  ;

  die "Unparseable structure in $proc_file: <$line>$A"
   unless defined $my_pid;
  die "$proc_file\'s output says its own PID is $my_pid !?"
   unless $my_pid == $num;

  DEBUG and printf "======= %s\t%s\n", $my_pid, $my_execname;

  print "$my_pid\t$my_execname\n"
   unless $Skip_First_Few and $Iteration_Depth <= $Skip_First_Few;

  return $parent_pid;
}


__END__

=head1 LICENSE

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See http://www.perl.com/perl/misc/Artistic.html

=head1 AUTHOR

Sean M. Burke, E<lt>sburke@cpan.orgE<gt>