#!<<perl_header>>

use INSTALL::common;

use INSTALL::parameter;
use INSTALL::os;
use INSTALL::process_info;

my $pParameters = \%INSTALL::parameter::variables;

#==============================================================================
#------------------------ Default global values
#==============================================================================

my $pOS = \%INSTALL::os::Details;

#Process format:

#<processes>
#   <process>
#     <pid> [0-9]+ </pid>
#     <parent-pid> [0-9]+ </parent-pid>
#     <binary> "[full path to binary name]" </binary>
#     <name> "[name of binary (without path)]" </name>
#     <ruid> [0-9]+ </ruid>
#     <euid> [0-9]+ </euid>
#     <rgid> [0-9]+ </rgid>
#     <egid> [0-9]+ </egid>
#     <vm-size> [allocated virtual memory size] </vm-size>
#     <resident-size> [allocated real (resident) memory size] </resident-size>
#     <shared-size> [memory size which is shared] </shared-size>
#     <aguments>
#       <argument> "[argument 0]" </argument>
#       <argument> "[argument 1]" </argument>
#       <argument> "[argument 2]" </argument>
#       ...
#     </arguments>
#   </process>
#   ...
#<processes>

open(OUTPUT,">&STDOUT");

sub dump_process
{
  ($#_ == 0) || die "Invalid number of arguments.";

  my ($pid) = @_;
  my %process_info = INSTALL::process_info::process_info($pid);

  if (scalar(keys %process_info)) {
    print OUTPUT (
                  "  <process pid=$process_info{pid} name=\"$process_info{name}\">\n",
                  "    <pid> $process_info{pid} </pid>\n",
                  "    <parent-pid> $process_info{ppid} </parent-pid>\n",
                  "    <binary> \"$process_info{binary}\" </binary>\n",
                  "    <name> \"$process_info{name}\" </name>\n",
                  "    <ruid> $process_info{ruid} </ruid>\n",
                  "    <euid> $process_info{euid} </euid>\n",
                  "    <rgid> $process_info{rgid} </rgid>\n",
                  "    <egid> $process_info{egid} </egid>\n",
                  "    <vm-size> $process_info{vmsize} </vm-size>\n",
                  "    <resident-size> $process_info{residentsize} </resident-size>\n",
                  "    <shared-size> $process_info{sharedsize} </shared-size>\n",
                  "    <arguments>\n",
                  map
                  (
                   "      <argument> \"$_\" </argument>\n",
                   @{$process_info{pArgv}}
                  ),
                  "    </arguments>\n",
                  "  </process>\n"
                 );
  }
  else {
    return(undef);
  }
}

sub build_process_info
{
  ($#_ < 0) || die "Invalid number of arguments.";

  my %prochash = INSTALL::process_info::retrieve_prochash;

  my (@procs,@names);

  @procs = keys %prochash;
  @names = map { s@^.*/([^/]+)$@$1@; $_ } values %prochash;

  # print "Process pid list:\n  ",join("  ",map("$_\n",@procs)),"\n";
  # print "Process name list:\n  ",join("  ",map("$_\n",@names)),"\n";
  return(\@procs,\@names);
}

sub usage
{
  print STDERR ("Usage: $0 <arguments>\n",
                "Arguments:\n",
                "  [pid=<pid>[,<pid2>,...,<pidn>]]\n",
                "  [name=<name1>[,<name2>,...,<namen>]]\n",
                "\n",
                "Note: If both pid and name is specified, the results will be the union\n",
                "      of the pids listed with the pids of those processes with names\n",
                "      matching those in the names listed.\n",
                "\n");

  exit(1);
}

sub main
{
  if (scalar(keys %$pParameters)) {
    (grep { ($_ eq "pid") || ($_ eq "name") } keys %$pParameters) || usage;
  }

  my (@procs,@names);

  if (exists $pParameters->{pid}) {
    my $pids = $pParameters->{pid};
    while(length($pids)) {
      if ($pids =~ s/^([0-9]+),?//) {
        push @procs,$1;
      }
      else {
        print STDERR ("Error: Invalid pid list.");
        usage();
      }
    }
  }

  if (exists $pParameters->{name}) {
    my $names = $pParameters->{name};
    while(length($names)) {
      if ($names =~ s@^((\\.|[^,])+),?@@) {
        push @names,$1;
      }
      else {
        print STDERR ("Error: Invalid name list.");
        usage();
      }
    }
  }

  my ($pProcs, $pNames) = build_process_info;

  if (not ((exists $pParameters->{name}) or (exists $pParameters->{pid}))) {
    @procs = @$pProcs;
  }
  else {
    if (exists $pParameters->{name}) {
      # Match names agains $pNames, record indexes.
      my @indexes;

      foreach(@names) {
        my $name = $_;
        
        for(my $i=0; $i < scalar(@$pNames); $i++) {
          if ($pNames->[$i] eq $name) {
            push @indexes, $i;
          }
        }
      }

      my @addedprocs = map($pProcs->[$_],@indexes);
      @procs = sort(@procs,@addedprocs);
    }
  }
                
  print OUTPUT ("<processes>\n");

  my $result = 0;

  foreach(@procs) {
    $result |= dump_process($_);
  }

  print OUTPUT ("</processes>\n");

  return($result);
}

exit(not main);