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