Subversion Repositories DevTools

Rev

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

Rev 2401 Rev 2403
Line 56... Line 56...
56
my $vob_name;
56
my $vob_name;
57
my $vob_desc;
57
my $vob_desc;
58
my $view_path;
58
my $view_path;
59
my @paths;
59
my @paths;
60
my %usedDirs;
60
my %usedDirs;
-
 
61
my %notLabled;
61
my $label_error = 0;
62
my $label_error = 0;
62
 
63
 
63
my @error_list;
64
my @error_list;
64
my @last_results;
65
my @last_results;
65
my $last_result;
66
my $last_result;
Line 222... Line 223...
222
#
223
#
223
@paths = findLabledOjects($opt_label);
224
@paths = findLabledOjects($opt_label);
224
processOneItem($_) foreach ( @paths );
225
processOneItem($_) foreach ( @paths );
225
 
226
 
226
#
227
#
227
#   Walk the list of paths and label the required directories
-
 
228
#   Walk from bottom to top ( longest first )
228
#   Now have a list of paths
229
#
229
#
230
foreach my $path ( reverse sort { length($a) <=> length($b) } keys %usedDirs )
230
foreach my $path ( reverse sort { length($a) <=> length($b) } keys %usedDirs )
231
{
231
{
-
 
232
my $ppath = $path; $ppath =~ s~.*/vobs/~~;
232
    Verbose("Path: $path");
233
    Verbose("Examine: $ppath");
233
    unless ( $usedDirs{$path} )
234
    unless ( tailIsLabeled ($path) )
234
    {
235
    {
235
        my $ppath = $path;
236
        $notLabled{$path} = 1;
236
        $ppath =~ s~.*/vobs/~~;
237
        Verbose("NotLabled: $ppath");
-
 
238
#print "0: $path\n";
-
 
239
    }
-
 
240
}
237
 
241
 
-
 
242
#
238
        my $testdir = $path;
243
#   Walk the list of paths and label the required directories
239
        unless ( $testdir =~ m~\@\@~ ) {
244
#   Walk from bottom to top (longest first)
-
 
245
#
-
 
246
foreach my $path ( reverse sort { length($a) <=> length($b) } keys %notLabled )
-
 
247
{
240
            $testdir .= '/.@@';
248
    Verbose("Path: $path");
241
        } else {
249
    my $ppath = $path;
-
 
250
    $ppath =~ s~.*/vobs/~~;
-
 
251
 
242
            $testdir =~ s~/[^/]*$~~;
252
    my $testdir = $path;
243
        }
253
    #
244
        
254
    #   One final test
245
        #
255
    #
246
        #   One final test
256
    unless ( tailIsLabeled ($path) )
247
        #
257
    {
248
        if ( -e $testdir . '/' . $opt_label )
258
        print "$testdir - Must label\n";
-
 
259
        smartUnLock();
-
 
260
        ClearCmd ("mklabel", '-c', 'JATS cc2svn_labeldirs', $opt_label, $path ) unless $opt_test;
-
 
261
        if ( display_error_list() )
249
        {
262
        {
250
            print "$ppath - Already labled\n";
263
            $label_error++;
251
        }
264
        }
252
        else
265
        else
253
        {
266
        {
254
            print "$ppath - Must label\n";
-
 
255
            smartUnLock();
-
 
256
            ClearCmd ("mklabel", '-c', 'JATS cc2svn_labeldirs', $opt_label, $path ) unless $opt_test;
-
 
257
            if ( display_error_list() )
-
 
258
            {
-
 
259
                $label_error++;
-
 
260
            }
-
 
261
            else
-
 
262
            {
-
 
263
                $label_count++;
267
            $label_count++ unless ($opt_test);
264
            }
-
 
265
        }
268
        }
266
    }
269
    }
-
 
270
    else
-
 
271
    {
-
 
272
        print "$ppath - Already labled\n";
-
 
273
    }
267
}
274
}
268
 
275
 
269
#
276
#
270
#   All done
277
#   All done
271
#
278
#
272
smartLock();
279
smartLock();
-
 
280
Message ("Items Found: ". scalar @paths);
273
Message ("Labels applied: $label_count");
281
Message ("Labels applied: $label_count");
274
Message ("Label  errors : $label_error") if $label_error;
282
Message ("Label  errors : $label_error") if $label_error;
275
Error ("Not all required paths labled") if ( $label_error );
283
Error ("Not all required paths labled") if ( $label_error );
276
exit (0);
284
exit (0);
277
 
285
 
278
#-------------------------------------------------------------------------------
286
#-------------------------------------------------------------------------------
-
 
287
# Function        : tailIsLabeled
-
 
288
#
-
 
289
# Description     : Determine if the tail of the current path is labled
-
 
290
#
-
 
291
# Inputs          : $test   - Path to test
-
 
292
#
-
 
293
# Returns         : 1       - Is labled
-
 
294
#                   0       - Is not Labled
-
 
295
#
-
 
296
sub tailIsLabeled
-
 
297
{
-
 
298
    my ($test) = @_;
-
 
299
 
-
 
300
#    print "$path\n";
-
 
301
    my $found = 0;
-
 
302
    my $more = 100;
-
 
303
 
-
 
304
    #
-
 
305
    #   First remove the last element - it will be a label (number)
-
 
306
    #
-
 
307
    $test =~ s~/[^/]*?$~~;
-
 
308
    while ( $more-- )
-
 
309
    {
-
 
310
        if ( -e $test . '/' . $opt_label )
-
 
311
        {
-
 
312
            return 1;
-
 
313
        }
-
 
314
        $test =~ s~(.*)/(.*?)$~~;
-
 
315
        $more = 1 if ( $2 eq 'main' );
-
 
316
        $test = $1;
-
 
317
    }
-
 
318
    return 0;
-
 
319
}
-
 
320
 
-
 
321
#-------------------------------------------------------------------------------
279
# Function        : processOneItem
322
# Function        : processOneItem
280
#
323
#
281
# Description     : Examine a CC extended path. Break it into bits and
324
# Description     : Examine a CC extended path. Break it into bits and
282
#                   determine with parts of the path have not been labled
325
#                   determine with parts of the path have not been labled
283
#
326
#
Line 286... Line 329...
286
# Returns         : Fill in %usedDirs
329
# Returns         : Fill in %usedDirs
287
#
330
#
288
sub processOneItem
331
sub processOneItem
289
{
332
{
290
    my ($path) = @_;
333
    my ($path) = @_;
-
 
334
 
-
 
335
    #
291
    my $last_type = 0;
336
    #   Break of the last bit OBJECT/main/....../nn
292
    my $type = 0;
337
    #
293
    while ( $path =~ m~\@\@~ )
338
    while ( $path =~ m~(/.*)/([^/]+/main/)(.*?)$~ )
294
    {
339
    {
295
        my $tail;
-
 
296
        $last_type = $type;
-
 
297
        $type = 0;
-
 
298
        #
-
 
299
        #   Remove bits until I remove a /main
-
 
300
        #
-
 
301
    #print "--- $path\n";
-
 
302
        $path =~ m~(.*)/([^/]*$)~;
-
 
303
        $path = $1;
340
        $path = $1;
304
        $tail = $2;
-
 
305
        if ( $tail eq 'main' )
-
 
306
        {
-
 
307
            $type = 1;
-
 
308
        }
-
 
309
        if ( $last_type == 1 )
-
 
310
        {
-
 
311
            my $type = 0;
-
 
312
            my $testdir = $path;
341
        my $tagPath = $path;
313
            unless ( $testdir =~ m~\@\@~ ) {
-
 
314
                $testdir .= '/.@@';
-
 
315
            } else {
-
 
316
                $testdir =~ s~/[^/]*$~~;
342
        $tagPath =~ s~/\d+$~~;
317
            }
-
 
318
 
-
 
319
            if ( ! exists $usedDirs{$path} )
-
 
320
            {
-
 
321
                $usedDirs{$path} = ( -e $testdir . '/' . $opt_label ) || 0;
343
        $usedDirs{$path} = 1 if $tagPath =~ m~\@\@~;
322
            }
-
 
323
        }
-
 
324
    }
344
    }
325
}
345
}
326
 
346
 
327
#-------------------------------------------------------------------------------
347
#-------------------------------------------------------------------------------
328
# Function        : findLabledOjects
348
# Function        : findLabledOjects