bin/add-perl-meta.pl

   1 #!/usr/local/bin/perl
   2
   3 =pod
   4
   5 Part of "megainstall"
   6
   7  $0 --logs=megainstalldir
   8
   9 looks at one dirent that tells us which perl we are talking about
  10
  11 Ask that perl for its config and store it as perl-V.txt
  12
  13 =cut
  14
  15
  16 use strict;
  17 use warnings;
  18
  19 use FindBin ();
  20 use Getopt::Long;
  21 use XML::LibXML;
  22 our %Opt;
  23
  24 sub Usage (){
  25   "Usage: $0 [--logs=logsdirector]";
  26 }
  27
  28 GetOptions(\%Opt, "logs=s"
  29           ) or die Usage;
  30
  31 my $logdir = $Opt{logs} || "$FindBin::Bin/../logs";
  32 opendir my $dh, $logdir or die "cannot opendir '$logdir': $!";
  33
  34 my $p = XML::LibXML->new;
  35 for my $dirent (sort readdir $dh) {
  36   next if $dirent =~ /^\./;
  37   my $abs = "$logdir/$dirent";
  38   next unless $abs =~ /(?:^|\/)megainstall\.(\d+T\d+)\.d(?:\/|$)/;
  39   my $time = $1;
  40   my $xfile = sprintf "%s/%s", $logdir, $dirent;
  41   next unless $xfile =~ /\.xml$/;
  42   next unless -e $xfile;
  43   my $xml = $p->parse_file($xfile);
  44   my($ok,$seq,$perl);
  45   $ok = $xml->findvalue("/distro/\@ok");
  46   $seq = $xml->findvalue("/distro/\@seq") || 0;
  47   $perl = $xml->findvalue("/distro/\@perl");
  48   $perl .= "/bin/perl";
  49   unless (-e $perl) {
  50     die "perl[$perl] n'exists";
  51   }
  52   open my $fh, ">", "$logdir/perl-V.txt" or die "Could not open >$logdir/perl-V.txt: $!";
  53   open my $pfh, "-|", $perl, "-V" or die "cannot fork: $!";
  54   while (<$pfh>) {
  55     print $fh $_;
  56   }
  57   close $pfh or die "perl died during -V";
  58   close $fh or die "could not write: $!";
  59   last;
  60 }