Subversion Repositories DevTools

Rev

Rev 255 | Rev 5709 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 255 Rev 321
Line 46... Line 46...
46
$VERSION = 1.00;
46
$VERSION = 1.00;
47
@ISA = qw(Exporter);
47
@ISA = qw(Exporter);
48
 
48
 
49
# Symbols to autoexport (:DEFAULT tag)
49
# Symbols to autoexport (:DEFAULT tag)
50
@EXPORT = qw( rmlitter
50
@EXPORT = qw( rmlitter
-
 
51
              rm_opr
51
              rm_rf
52
              rm_rf
52
              rm_f
53
              rm_f
53
              mkpath
54
              mkpath
54
              printenv
55
              printenv
55
              printargs
56
              printargs
-
 
57
              echo
56
            );
58
            );
57
 
59
 
58
use File::Path qw(rmtree);
60
use File::Path qw(rmtree);
-
 
61
our %opts;
59
 
62
 
60
#BEGIN
63
#BEGIN
61
#{
64
#{
62
#    print "-------jats_runtime initiated\n";
65
#    print "-------jats_runtime initiated\n";
63
#}
66
#}
64
 
67
 
65
#-------------------------------------------------------------------------------
68
#-------------------------------------------------------------------------------
-
 
69
# Function        : process_options
-
 
70
#
-
 
71
# Description     : Extract options from the front of the command stream
-
 
72
#                   Stops at the first argument that doesn't start with a
-
 
73
#                   '--'
-
 
74
#
-
 
75
#                   Options of the form --Opt=Val are split out
-
 
76
#                   Options of the form --Opt will set (or increment a value)
-
 
77
#
-
 
78
# Inputs          : None: Uses global ARGV
-
 
79
#
-
 
80
# Returns         : None: Resets global argv
-
 
81
#                         Populates the %opts hash
-
 
82
#
-
 
83
sub process_options
-
 
84
{
-
 
85
    while ( my $entry = shift @ARGV )
-
 
86
    {
-
 
87
        last if ( $entry eq '--' );
-
 
88
        if ( $entry =~  m/^--(.*)/  )
-
 
89
        {
-
 
90
            if ( $1 =~ m/(.*)=(.*)/ )
-
 
91
            {
-
 
92
                $opts{$1} = $2;
-
 
93
            }
-
 
94
            else
-
 
95
            {
-
 
96
                $opts{$1}++;
-
 
97
            }
-
 
98
        }
-
 
99
        else
-
 
100
        {
-
 
101
            unshift @ARGV, $entry;
-
 
102
            last;
-
 
103
        }
-
 
104
    }
-
 
105
    #
-
 
106
    #   Process some known options
-
 
107
    #
-
 
108
    $opts{'Progress'} = $opts{'Verbose'}    if ( $opts{'Verbose'} );
-
 
109
    ErrorConfig( 'name', $opts{Name})       if ( $opts{'Name'} );
-
 
110
    ErrorConfig( 'verbose', $opts{Verbose}) if ( $opts{'Verbose'} );
-
 
111
    DebugDumpData("RunTime Opts", \%opts )  if ( $opts{'ShowOpts'} );;
-
 
112
    Message ("RunTime args: @ARGV")         if ( $opts{'ShowArgs'} );
-
 
113
    printenv()                              if ( $opts{'ShowEnv'} );
-
 
114
    Message ($opts{'Message'})              if ( $opts{'Message'} );
-
 
115
}
-
 
116
 
-
 
117
#-------------------------------------------------------------------------------
66
# Function        : rmlitter
118
# Function        : rmlitter
67
#
119
#
68
# Description     : Remove litter from a build directory
120
# Description     : Remove litter from a build directory
69
#
121
#
70
# Inputs          : ARGV    A list of files (with wildcards) to delete in the
122
# Inputs          : ARGV    A list of files (with wildcards) to delete in the
Line 78... Line 130...
78
#
130
#
79
# Returns         : 0
131
# Returns         : 0
80
#
132
#
81
sub rmlitter
133
sub rmlitter
82
{
134
{
-
 
135
    process_options();
-
 
136
 
83
    my @flist;
137
    my @flist;
84
    my @dlist = '.';
138
    my @dlist = '.';
85
 
139
 
86
    #
140
    #
87
    #   Parse arguments
141
    #   Parse arguments
Line 113... Line 167...
113
            my $path = "$dir/$file";
167
            my $path = "$dir/$file";
114
            $path =~ s~ ~\\ ~g;
168
            $path =~ s~ ~\\ ~g;
115
            my @del = glob ( $path );
169
            my @del = glob ( $path );
116
            if ( @del )
170
            if ( @del )
117
            {
171
            {
-
 
172
                Message ("rmlitter. @del") if ($opts{'Progress'} );
118
                chmod '777', @del;
173
                chmod '777', @del;
119
                unlink @del;
174
                unlink @del;
120
            }
175
            }
121
        }
176
        }
122
    }
177
    }
Line 157... Line 212...
157
#
212
#
158
# Returns         : Nothing
213
# Returns         : Nothing
159
#
214
#
160
sub rm_rf
215
sub rm_rf
161
{
216
{
-
 
217
    process_options();
162
    expand_wildcards();
218
    expand_wildcards();
163
    my @dirs =  grep -e $_,@ARGV;
219
    my @dirs =  grep -e $_,@ARGV;
164
    if ( @dirs )
220
    if ( @dirs )
165
    {
221
    {
166
        rmtree(\@dirs,0,0);
222
        rmtree(\@dirs,0,0);
Line 171... Line 227...
171
# Function        : rm_f
227
# Function        : rm_f
172
#
228
#
173
# Description     : Remove all named files
229
# Description     : Remove all named files
174
#                   Will not remove directores - even if named
230
#                   Will not remove directores - even if named
175
#
231
#
-
 
232
#                   Unix Note:
-
 
233
#                   Need to handle broken soft links
-
 
234
#
-
 
235
#
176
# Inputs          : @ARGV       - A list of files to delete
236
# Inputs          : @ARGV       - A list of files to delete
177
#
237
#
178
# Returns         :
238
# Returns         :
179
#
239
#
180
sub rm_f {
240
sub rm_f {
-
 
241
    process_options();
181
    expand_wildcards();
242
    expand_wildcards();
182
 
243
 
183
    foreach my $file (@ARGV) {
244
    foreach my $file (@ARGV) {
184
        next unless -f $file;
245
        Message ("Delete: $file") if ($opts{'Progress'} );
185
 
-
 
186
        next if _unlink($file);
246
        next if -d $file;
187
 
-
 
188
        chmod(0777, $file);
247
        next unless ( -e $file || -l $file );
189
 
-
 
190
        next if _unlink($file);
248
        next if _unlink($file);
191
        Warning "Cannot delete $file: $!";
249
        Warning "Cannot delete $file: $!";
192
    }
250
    }
193
}
251
}
194
 
252
 
195
#-------------------------------------------------------------------------------
253
#-------------------------------------------------------------------------------
-
 
254
# Function        : rm_opr
-
 
255
#
-
 
256
# Description     : Combo deletion operation
-
 
257
#                   Parameter driven to delete many things in one command
-
 
258
#
-
 
259
# Inputs          : Options and paths
-
 
260
#                   Options. Set mode for following paths
-
 
261
#                       -f   remove named file
-
 
262
#                       -d   remove named directory if empty
-
 
263
#                       -rf  remove directory or file
-
 
264
#                       -fd  remove file and directory if empty
-
 
265
#
-
 
266
# Returns         : 
-
 
267
#
-
 
268
sub rm_opr
-
 
269
{
-
 
270
    my $mode = '-f';
-
 
271
    process_options();
-
 
272
    foreach my $file (@ARGV) {
-
 
273
        if ( $file eq '-f' ) {
-
 
274
            $mode = $file;
-
 
275
        } elsif ( $file eq '-d' ) {
-
 
276
            $mode =$file;
-
 
277
        } elsif ( $file eq '-rf' ) {
-
 
278
            $mode =$file;
-
 
279
        } elsif ( $file eq '-fd' ) {
-
 
280
            $mode =$file;
-
 
281
        } elsif ( $file =~ m/^-/ ) {
-
 
282
            Error ("rm_opr - unknown option: $file");
-
 
283
        } else {
-
 
284
            #
-
 
285
            #   Not an option must be a file/dir to delete
-
 
286
            #
-
 
287
            if ( $mode eq '-f' ) {
-
 
288
                Message ("Delete File: $file") if ($opts{'Progress'} );
-
 
289
                _unlink($file);
-
 
290
 
-
 
291
            } elsif ( $mode eq '-d' ) {
-
 
292
                Message ("Delete Empty Dir: $file") if ($opts{'Progress'} );
-
 
293
                rmdir $file;
-
 
294
 
-
 
295
            } elsif ( $mode eq '-rf' ) {
-
 
296
                Message ("Delete Dir: $file") if ($opts{'Progress'} );
-
 
297
                rmtree($file,0,0);
-
 
298
 
-
 
299
            } elsif ( $mode eq '-fd' ) {
-
 
300
                Message ("Delete File: $file") if ($opts{'Progress'} );
-
 
301
                _unlink($file);
-
 
302
                my $dir = $file;
-
 
303
                $dir =~ tr~\\/~/~s;
-
 
304
                Message ("Remove Empty Dir: $dir") if ($opts{'Progress'} );
-
 
305
                if ( $dir =~ s~/[^/]+$~~ )
-
 
306
                {
-
 
307
                    rmdir $dir;
-
 
308
                }
-
 
309
            }
-
 
310
        }
-
 
311
    }
-
 
312
}
-
 
313
 
-
 
314
 
-
 
315
#-------------------------------------------------------------------------------
196
# Function        : mkpath
316
# Function        : mkpath
197
#
317
#
198
# Description     : Create a directory tree
318
# Description     : Create a directory tree
199
#                   This will create all the parent directories in the path
319
#                   This will create all the parent directories in the path
200
#
320
#
Line 202... Line 322...
202
#
322
#
203
# Returns         :
323
# Returns         :
204
#
324
#
205
sub mkpath
325
sub mkpath
206
{
326
{
-
 
327
    process_options();
207
    expand_wildcards();
328
    expand_wildcards();
208
    File::Path::mkpath([@ARGV],0,0777);
329
    File::Path::mkpath([@ARGV],0,0777);
209
}
330
}
210
 
331
 
211
#-------------------------------------------------------------------------------
332
#-------------------------------------------------------------------------------
212
# Function        : _unlink
333
# Function        : _unlink
213
#
334
#
214
# Description     : Helper function
335
# Description     : Helper function
215
#                   Unlink a list of files
336
#                   Unlink a list of files
216
#
337
#
217
# Inputs          : A list of files to delete
338
# Inputs          : A file to delete
218
#
339
#
219
# Returns         : The number of files that have been deleted
340
# Returns         : False: File still exists
220
#
341
#
221
sub _unlink {
342
sub _unlink {
222
    my $files_unlinked = 0;
343
    my ($file) = @_;
223
 
-
 
224
    foreach my $file (@_)
344
    if ( ! unlink $file  )
225
    {
345
    {
226
        my $delete_count = 0;
346
        chmod(0777, $file);
227
        $delete_count++ while unlink $file;
347
        return unlink $file;
228
        $files_unlinked++ if $delete_count;
-
 
229
    }
348
    }
230
    return $files_unlinked;
349
    return 1;
231
}
350
}
232
 
351
 
233
#-------------------------------------------------------------------------------
352
#-------------------------------------------------------------------------------
234
# Function        : printenv
353
# Function        : printenv
235
#
354
#
Line 241... Line 360...
241
#
360
#
242
sub printenv
361
sub printenv
243
{
362
{
244
    foreach my $entry ( sort keys %ENV )
363
    foreach my $entry ( sort keys %ENV )
245
    {
364
    {
246
        print "------------------- $entry=$ENV{$entry}\n";
365
        print "    $entry=$ENV{$entry}\n";
247
    }
366
    }
248
}
367
}
249
 
368
 
250
#-------------------------------------------------------------------------------
369
#-------------------------------------------------------------------------------
251
# Function        : printargs
370
# Function        : printargs
Line 254... Line 373...
254
#
373
#
255
# Inputs          : User arguments
374
# Inputs          : User arguments
256
#
375
#
257
# Returns         : Nothing
376
# Returns         : Nothing
258
#
377
#
259
my $PSPLIT=':';
-
 
260
sub printargs
378
sub printargs
261
{
379
{
-
 
380
    Message "Arguments", @ARGV;
-
 
381
}
-
 
382
 
-
 
383
#-------------------------------------------------------------------------------
-
 
384
# Function        : echo
-
 
385
#
-
 
386
# Description     : echo my argumements
-
 
387
#
-
 
388
# Inputs          : User arguments
-
 
389
#
-
 
390
# Returns         : Nothing
-
 
391
#
-
 
392
sub echo
-
 
393
{
-
 
394
    process_options();
-
 
395
    Message @ARGV;
-
 
396
}
-
 
397
 
-
 
398
#-------------------------------------------------------------------------------
-
 
399
# Function        : printArgsEnv
-
 
400
#
-
 
401
# Description     : Print my argumements nd environmen
-
 
402
#
-
 
403
# Inputs          : User arguments
-
 
404
#
-
 
405
# Returns         : Nothing
-
 
406
#
-
 
407
my $PSPLIT=':';
-
 
408
sub printArgsEnv
-
 
409
{
262
    Message "printargs....";
410
    Message "printargs....";
263
    Message "Program arguments", @ARGV;
411
    Message "Program arguments", @ARGV;
264
 
412
 
265
    $PSPLIT = ';' if ( $ENV{GBE_MACHTYPE} eq 'win32' );
413
    $PSPLIT = ';' if ( $ENV{GBE_MACHTYPE} eq 'win32' );
266
 
414