Subversion Repositories DevTools

Rev

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

Rev 3410 Rev 3423
Line 1... Line 1...
1 
#! /usr/bin/perl
 1 
#! /usr/bin/perl
2 
########################################################################
 2 
########################################################################
3 
# Copyright (C) 2010 Vix-ERG Limited, All rights reserved
 3 
# Copyright (C) 2010 Vix-ERG Limited, All rights reserved
4 
#
 4 
#
5 
# Module name   : recover_deploy4.pl
 5 
# Module name   : scan_release.pl
6 
# Module type   : Makefile system
 6 
# Module type   : Makefile system
7 
# Compiler(s)   : Perl
 7 
# Compiler(s)   : Perl
8 
# Environment(s): jats
 8 
# Environment(s): jats
9 
#
 9 
#
10 
# Description   : Scan the Releases area looking for bad symlinks
 10 
# Description   : Scan the Releases area looking for bad symlinks
Line 19... Line 19...
19 
my $root = $ARGV[0] || die ("Need to specify root directory");
 19 
my $root = $ARGV[0] || die ("Need to specify root directory");
20 
 
 20 
 
21 
#
 21 
#
22 
#   Process ech directory
 22 
#   Process ech directory
23 
#
 23 
#
- 
 
 24 
unless ( -d $root )
- 
 
 25 
{
- 
 
 26 
    print "scan_release: Not a directory: $root\n";
- 
 
 27 
    exit 1;
- 
 
 28 
}
- 
 
 29 
 
24 
scan_dir( glob "$root/*" );
 30 
scan_dir( $root );
- 
 
 31 
exit 0;
25 
 
 32 
 
26 
#-------------------------------------------------------------------------------
 33 
#-------------------------------------------------------------------------------
27 
# Function        : scan_dir
 34 
# Function        : scan_dir
28 
#
 35 
#
29 
# Description     : Scan a list of directoires for bad links
 36 
# Description     : Scan a list of directoires for bad links
Line 38... Line 45...
38 
#        print "Scanning: $dir\n";
 45 
#        print "Scanning: $dir\n";
39 
        #
 46 
        #
40 
        #   Read in the directory entries
 47 
        #   Read in the directory entries
41 
        #
 48 
        #
42 
        next if ( ! -d $dir );
 49 
        next if ( ! -d $dir );
43 
        next if ( $dir =~ m~/lost\+found$~ );
 - 
 
44 
        opendir(my $dh, $dir) || print("Cannot readdir $dir: $!\n");
 50 
        opendir(my $dh, $dir) || print("Cannot readdir $dir: $!\n");
45 
        my @entries = readdir($dh);
 51 
        my @entries = readdir($dh);
46 
        closedir $dh;
 52 
        closedir $dh;
47 
 
 53 
 
48 
        #
 54 
        #
49 
        #   Process each entry
 55 
        #   Process each entry
50 
        #
 56 
        #
51 
        foreach my $entry ( @entries )
 57 
        foreach my $entry ( @entries )
52 
        {
 58 
        {
- 
 
 59 
            next if ( $entry eq '.' );
- 
 
 60 
            next if ( $entry eq '..' );
53 
            next if ( $entry eq '.'  || $entry eq '..');
 61 
            next if ( $entry eq 'core_devl' );
- 
 
 62 
            next if ( $entry eq 'lost+found' );
- 
 
 63 
 
54 
            $entry = "$dir/$entry";
 64 
            $entry = "$dir/$entry";
55 
#            next if ( -f $entry );
 - 
 
56 
    #        print "Examine $entry\n";
 - 
 
57 
            if ( -d $entry )
 65 
            if ( -d $entry )
58 
            {
 66 
            {
59 
                push @dirs, $entry;
 67 
                push @dirs, $entry;
60 
                next;
 68 
                next;
61 
            }
 69 
            }
Line 78... Line 86...
78 
                #       ie: ../ or someDir
 86 
                #       ie: ../ or someDir
79 
                #
 87 
                #
80 
                next unless ( $linkfile =~ m~^/~ );
 88 
                next unless ( $linkfile =~ m~^/~ );
81 
 
 89 
 
82 
                #
 90 
                #
83 
                #   Allowed to be within
 91 
                #   Allowed to be a link to a file in the same directory
84 
                #       /export/deploy/releases/
 - 
 
85 
                #       /devl/releases/3rdParty-Products/
 - 
 
86 
                #
 92 
                #
87 
#                next if ( $linkfile =~ m~/export/deploy/releases/~ );
 93 
                next unless ( $linkfile =~ m~/~ );
88 
#                next if ( $linkfile =~ m~/devl/releases/3rdParty-Products/~ );
 - 
 
89 
 
 94 
 
- 
 
 95 
                #
- 
 
 96 
                #   Absolute links are not good
- 
 
 97 
                #
90 
                print "$entry ---> $linkfile\n";
 98 
                print "Absolute Link: $entry ---> $linkfile\n";
91 
            }
 99 
            }
92 
        }
 100 
        }
93 
        scan_dir( @dirs );
 101 
        scan_dir( @dirs );
94 
    }
 102 
    }
95 
}
 103 
}