setup/common/setup.pm

   1 #!/usr/bin/env perl
   2 #
   3 # Common setup functions for building release packages
   4 #
   5
   6 # Gef - Jan3 2002
   7 # - Initial framework for migrating setup/release building to perl
   8
   9 # TODO:
  10 # Gef - Cleaner handling of cons builds, currently doesn't catch cons errors
  11
  12 package setup;
  13
  14 # Package constructor
  15 sub new
  16 {
  17   my $this = {};
  18   bless $this;
  19
  20   return $this;
  21 }
  22
  23 # Replace in file parm-1; parm-2 with parm-3
  24 sub replace
  25 {
  26   shift;
  27   my $file = shift(@_);
  28   my $search = shift(@_);
  29   my $replace_with = shift(@_);
  30
  31   # need to use | instead of / with sed since the variables will contain /'s which confuse it
  32   system("cat '$file' | sed -e 's|$search|$replace_with|g' > '$file.tmp'");
  33   system("cp '$file.tmp' '$file'; rm '$file.tmp'");
  34 }
  35
  36 # Not exactly common (between win32/linux), but useful here all the same
  37 sub cons_build
  38 {
  39   shift;
  40   my $BUILD_DIR = shift(@_);
  41   my $BUILD_CMD = shift(@_);
  42   # use a direct system() call since syscmd doesnt catch cons errors
  43   system("cd $BUILD_DIR; $BUILD_CMD");
  44 }
  45
  46 # Maintain a list of errors that have occured
  47 sub collate_error
  48 {
  49   #shift;
  50   my $err_type = shift(@_);     # unused
  51   my $err_command = shift(@_);
  52
  53   @errors[$err_count++] = "$err_command";
  54 }
  55
  56 # Output the list of errors stored
  57 sub print_errors
  58 {
  59   my $count = 0;
  60
  61   if($err_count gt 0)
  62   {
  63     if($err_count > 25)
  64     {
  65       print("$err_count Errors!! Ouch, looks like something screwed up.\n");
  66     }
  67     else
  68     {
  69       print("$err_count Error(s) encountered\n");
  70     }
  71
  72     for($count; $count lt $err_count; $count++)
  73     {
  74       if(@errors[$count] ne "")
  75       {
  76         print("-> @errors[$count]\n");
  77       }
  78     }
  79   }
  80   #else
  81   #{
  82   #  print("No errors encountered.\n");
  83   #}
  84 }
  85
  86 # A wrapper for system() calls that catches errors
  87 sub syscmd
  88 {
  89   shift;
  90   my $command_string = shift(@_);
  91
  92   # todo: identify multiple commands (commands split with ;'s)
  93   # todo: catch cons errors (cons doesn't return a value)
  94   system("$command_string");
  95   my $sysretval = $?;
  96
  97   if(($sysretval gt 0) && ($sysretval lt 257))
  98   {
  99     @cmdlist = split(" ", $command_string);
 100     if(@cmdlist[0] eq "cp")
 101     {
 102       collate_error("copy", $command_string);
 103     }
 104     elsif(@cmdlist[0] eq "mv")
 105     {
 106       collate_error("move", $command_string);
 107     }
 108     elsif(@cmdlist[0] eq "cons")
 109     {
 110       collate_error("cons", $command_string);
 111     }
 112     elsif(@cmdlist[0] eq "cd")
 113     {
 114       collate_error("changed dir", $command_string);
 115     }
 116     elsif(@cmdlist[0] eq "mkdir")
 117     {
 118       collate_error("make dir", $command_string);
 119     }
 120     elsif(@cmdlist[0] eq "cat")
 121     {
 122       collate_error("cat", $command_string);
 123     }
 124     elsif(@cmdlist[0] eq "rm")
 125     {
 126       collate_error("remove", $command_string);
 127     }
 128     else
 129     {
 130       collate_error("unhandled", $command_string);
 131     }
 132   }
 133
 134   return $sysretval;
 135 }
 136
 137
 138 # Close package
 139 1;