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
12package setup;
13
14# Package constructor
15sub 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
24sub 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
37sub 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
47sub 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
57sub 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
87sub 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
1391;
140