Subversion Repositories gelsvn

Rev

Rev 107 | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
107 bj 1 
eval '(exit $?0)' && eval 'exec perl -w -S $0 ${1+"$@"}'
2 
    & eval 'exec perl -w -S $0 $argv:q'
3 
    if 0;
4 
 
5 
# ******************************************************************
6 
#      Author: Chad Elliott
7 
# Create Date: 3/09/2004
8 
#         $Id: prj_install.pl 107 2005-09-02 16:42:23Z bj $
9 
# ******************************************************************
10 
 
11 
# ******************************************************************
12 
# Pragma Section
13 
# ******************************************************************
14 
 
15 
use strict;
16 
use FileHandle;
17 
use File::Copy;
18 
use File::Basename;
19 
 
20 
# ******************************************************************
21 
# Data Section
22 
# ******************************************************************
23 
 
24 
my($insext)  = 'ins';
25 
my($version) = '$Id: prj_install.pl 107 2005-09-02 16:42:23Z bj $';
26 
$version =~ s/.*\s+(\d+[\.\d]+)\s+.*/$1/;
27 
 
28 
my(%defaults) = ('header_files'   => 1,
29 
                 'idl_files'      => 1,
30 
                 'inline_files'   => 1,
31 
                 'pidl_files'     => 1,
32 
                 'template_files' => 1,
33 
                );
34 
 
35 
my(%special)  = ('exe_output' => 1,
36 
                 'lib_output' => 1,
37 
                );
38 
 
39 
my(%actual)    = ();
40 
my(%base)      = ();
41 
my(%override)  = ();
42 
my($keepgoing) = 0;
43 
 
44 
# ******************************************************************
45 
# Subroutine Section
46 
# ******************************************************************
47 
 
48 
sub copyFiles {
49 
  my($files)   = shift;
50 
  my($insdir)  = shift;
51 
  my($verbose) = shift;
52 
 
53 
  foreach my $file (@$files) {
54 
    my($dest) = $insdir . '/' .
55 
                (defined $actual{$file} ?
56 
                         "$actual{$file}/" . basename($file) : $file);
57 
    my($fulldir) = dirname($dest);
58 
    if (! -d $fulldir) {
59 
      my($tmp) = '';
60 
      foreach my $part (split(/[\/\\]/, $fulldir)) {
61 
        $tmp .= $part . '/';
62 
        mkdir($tmp, 0755);
63 
      }
64 
    }
65 
 
66 
    if (! -e $dest || (-M $file) < (-M $dest)) {
67 
      if ($verbose) {
68 
        print "Copying to $dest\n";
69 
      }
70 
      if (!copy($file, $dest)) {
71 
        print STDERR "ERROR: Unable to copy $file to $dest\n";
72 
        if (!$keepgoing) {
73 
          return 0;
74 
        }
75 
      }
76 
    }
77 
    else {
78 
      if ($verbose) {
79 
        print "Skipping $file\n";
80 
      }
81 
    }
82 
  }
83 
  return 1;
84 
}
85 
 
86 
 
87 
sub determineSpecialName {
88 
  my($tag)  = shift;
89 
  my($dir)  = shift;
90 
  my($info) = shift;
91 
 
92 
  my($insdir, $name) = split(/\s+/, $info);
93 
  if (defined $name) {
94 
    $insdir .= '/';
95 
  }
96 
  else {
97 
    $name = $insdir;
98 
    $insdir = '';
99 
  }
100 
 
101 
  my($odir) = ($dir eq '' ? '.' : $dir) . '/' . $insdir;
102 
  if ($tag eq 'exe_output') {
103 
    my(@exes) = ();
104 
    my($fh)   = new FileHandle();
105 
    if (opendir($fh, $odir)) {
106 
      foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
107 
        if ($file =~ /^$name$/ ||
108 
            $file =~ /^$name.*\.exe$/i) {
109 
          push(@exes, "$dir$insdir$file");
110 
        }
111 
      }
112 
      closedir($fh);
113 
    }
114 
    return @exes;
115 
  }
116 
  elsif ($tag eq 'lib_output') {
117 
    my(@libs) = ();
118 
    my($fh)   = new FileHandle();
119 
    if (opendir($fh, $odir)) {
120 
      foreach my $file (grep(!/^\.\.?$/, readdir($fh))) {
121 
        if ($file =~ /^lib$name\.(a|so|sl)/ ||
122 
            $file =~ /^$name.*\.(dll|lib)$/i) {
123 
          push(@libs, "$dir$insdir$file");
124 
        }
125 
      }
126 
      closedir($fh);
127 
    }
128 
    return @libs;
129 
  }
130 
 
131 
  return "$dir$name";
132 
}
133 
 
134 
 
135 
sub replaceVariables {
136 
  my($line) = shift;
137 
  while($line =~ /(\$\(([^)]+)\))/) {
138 
    my($whole) = $1;
139 
    my($name)  = $2;
140 
    my($val)   = (defined $ENV{$name} ? $ENV{$name} : '');
141 
    $line =~ s/\$\([^)]+\)/$val/;
142 
  }
143 
  return $line;
144 
}
145 
 
146 
 
147 
sub loadInsFiles {
148 
  my($files)   = shift;
149 
  my($tags)    = shift;
150 
  my($verbose) = shift;
151 
  my($fh)      = new FileHandle();
152 
  my(@copy)    = ();
153 
 
154 
  foreach my $file (@$files) {
155 
    if (open($fh, $file)) {
156 
      if ($verbose) {
157 
        print "Loading $file\n";
158 
      }
159 
      my($base) = dirname($file);
160 
      if ($base eq '.') {
161 
        $base = '';
162 
      }
163 
      else {
164 
        $base =~ s/^\.[\/\\]+//;
165 
        $base .= '/';
166 
      }
167 
 
168 
      my($current) = undef;
169 
      while(<$fh>) {
170 
        my($line) = $_;
171 
        $line =~ s/^\s+//;
172 
        $line =~ s/\s+$//;
173 
 
174 
        if ($line ne '') {
175 
          if ($line =~ /^(\w+):$/) {
176 
            if (defined $$tags{$1}) {
177 
              $current = $1;
178 
            }
179 
            else {
180 
              $current = undef;
181 
            }
182 
          }
183 
          elsif (defined $current) {
184 
            $line = replaceVariables($line);
185 
            my($start) = $#copy + 1;
186 
            if (defined $special{$current}) {
187 
              push(@copy, determineSpecialName($current, $base, $line));
188 
            }
189 
            else {
190 
              push(@copy, "$base$line");
191 
            }
192 
            if (defined $override{$current}) {
193 
              for(my $i = $start; $i <= $#copy; ++$i) {
194 
                $actual{$copy[$i]} = $override{$current};
195 
              }
196 
            }
197 
            elsif (defined $base{$current}) {
198 
              for(my $i = $start; $i <= $#copy; ++$i) {
199 
                $actual{$copy[$i]} = $base{$current} . '/' .
200 
                                     dirname($copy[$i]);
201 
              }
202 
            }
203 
          }
204 
        }
205 
      }
206 
      close($fh);
207 
    }
208 
    else {
209 
      print STDERR "Unable to open $file\n";
210 
      return ();
211 
    }
212 
  }
213 
 
214 
  return @copy;
215 
}
216 
 
217 
 
218 
sub getInsFiles {
219 
  my($file)  = shift;
220 
  my(@files) = ();
221 
 
222 
  if (-d $file) {
223 
    my($fh) = new FileHandle();
224 
    if (opendir($fh, $file)) {
225 
      foreach my $f (grep(!/^\.\.?$/, readdir($fh))) {
226 
        push(@files, getInsFiles("$file/$f"));
227 
      }
228 
      closedir($fh);
229 
    }
230 
  }
231 
  elsif ($file =~ /\.$insext$/) {
232 
    push(@files, $file);
233 
  }
234 
  return @files;
235 
}
236 
 
237 
 
238 
sub usageAndExit {
239 
  my($msg) = shift;
240 
  if (defined $msg) {
241 
    print STDERR "$msg\n";
242 
  }
243 
  my($base) = basename($0);
244 
  my($spc)  = ' ' x (length($base) + 8);
245 
  print STDERR "$base v$version\n",
246 
               "Usage: $base [-a tag1[,tagN]] [-b tag=dir] [-o tag=dir]\n",
247 
               $spc, "[-s tag1[,tagN]] [-v] [install directory]\n",
248 
               $spc, "[$insext files or directories]\n\n",
249 
               "Install files matching the tag specifications found ",
250 
               "in $insext files.\n\n",
251 
               "-a  Adds to the default set of tags that get copied.\n",
252 
               "-b  Install tag into dir underneath the install directory.\n",
253 
               "-o  Install tag into dir.\n",
254 
               "-s  Sets the tags that get copied.\n",
255 
               "-v  Enables verbose mode.\n",
256 
               "\n",
257 
               "The default set of tags are:\n";
258 
  my($first) = 1;
259 
  foreach my $key (sort keys %defaults) {
260 
    print STDERR '', ($first ? '' : ', '), $key;
261 
    $first = 0;
262 
  }
263 
  print STDERR "\n";
264 
 
265 
  exit(0);
266 
}
267 
 
268 
# ******************************************************************
269 
# Main Section
270 
# ******************************************************************
271 
 
272 
my($verbose)  = undef;
273 
my($first)    = 1;
274 
my($insdir)   = undef;
275 
my(@insfiles) = ();
276 
my(%tags)     = %defaults;
277 
 
278 
for(my $i = 0; $i <= $#ARGV; ++$i) {
279 
  my($arg) = $ARGV[$i];
280 
  if ($arg =~ /^-/) {
281 
    if ($arg eq '-a') {
282 
      ++$i;
283 
      if (defined $ARGV[$i]) {
284 
        foreach my $tag (split(',', $ARGV[$i])) {
285 
          $tags{$tag} = 1;
286 
        }
287 
      }
288 
      else {
289 
        usageAndExit('-a requires a parameter.');
290 
      }
291 
    }
292 
    elsif ($arg eq '-b') {
293 
      ++$i;
294 
      if (defined $ARGV[$i]) {
295 
        if ($ARGV[$i] =~ /([^=]+)=(.*)/) {
296 
          $base{$1} = $2;
297 
        }
298 
        else {
299 
          usageAndExit("Invalid parameter to -b: $ARGV[$i]");
300 
        }
301 
      }
302 
      else {
303 
        usageAndExit('-b requires a parameter.');
304 
      }
305 
    }
306 
    elsif ($arg eq '-k') {
307 
      $keepgoing = 1;
308 
    }
309 
    elsif ($arg eq '-o') {
310 
      ++$i;
311 
      if (defined $ARGV[$i]) {
312 
        if ($ARGV[$i] =~ /([^=]+)=(.*)/) {
313 
          $override{$1} = $2;
314 
        }
315 
        else {
316 
          usageAndExit("Invalid parameter to -o: $ARGV[$i]");
317 
        }
318 
      }
319 
      else {
320 
        usageAndExit('-o requires a parameter.');
321 
      }
322 
    }
323 
    elsif ($arg eq '-s') {
324 
      ++$i;
325 
      if (defined $ARGV[$i]) {
326 
        %tags = ();
327 
        foreach my $tag (split(',', $ARGV[$i])) {
328 
          $tags{$tag} = 1;
329 
        }
330 
      }
331 
      else {
332 
        usageAndExit('-s requires a parameter.');
333 
      }
334 
    }
335 
    elsif ($arg eq '-v') {
336 
      $verbose = 1;
337 
    }
338 
    else {
339 
      usageAndExit('Unkown option: ' . $arg);
340 
    }
341 
  }
342 
  elsif (!defined $insdir) {
343 
    $arg =~ s/\\/\//g;
344 
    $insdir = $arg;
345 
  }
346 
  else {
347 
    if ($first) {
348 
      $first = 0;
349 
      if ($verbose) {
350 
        print "Collecting $insext files...\n";
351 
      }
352 
    }
353 
    $arg =~ s/\\/\//g;
354 
    push(@insfiles, getInsFiles($arg));
355 
  }
356 
}
357 
 
358 
if (!defined $insdir) {
359 
  usageAndExit();
360 
}
361 
elsif (!defined $insfiles[0]) {
362 
  print "No $insext files were found.\n";
363 
  exit(1);
364 
}
365 
 
366 
my($status) = 1;
367 
my(@files)  = loadInsFiles(\@insfiles, \%tags, $verbose);
368 
if (defined $files[0]) {
369 
  $status = (copyFiles(\@files, $insdir, $verbose) ? 0 : 1);
370 
}
371 
 
372 
exit($status);