Subversion Repositories DevTools

Rev

Rev 3423 | Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
3410 dpurdie 1 
#! /usr/bin/perl
2 
########################################################################
3 
# Copyright (C) 2010 Vix-ERG Limited, All rights reserved
4 
#
5 
# Module name   : recover_deploy4.pl
6 
# Module type   : Makefile system
7 
# Compiler(s)   : Perl
8 
# Environment(s): jats
9 
#
10 
# Description   : Scan the Releases area looking for bad symlinks
11 
#
12 
#
13 
#......................................................................#
14 
 
15 
require 5.008_002;
16 
use strict;
17 
use warnings;
18 
 
19 
my $root = $ARGV[0] || die ("Need to specify root directory");
20 
 
21 
#
22 
#   Process ech directory
23 
#
24 
scan_dir( glob "$root/*" );
25 
 
26 
#-------------------------------------------------------------------------------
27 
# Function        : scan_dir
28 
#
29 
# Description     : Scan a list of directoires for bad links
30 
#
31 
# Inputs          : List of directories to scan
32 
#
33 
sub scan_dir
34 
{
35 
    foreach my $dir ( @_ )
36 
    {
37 
        my @dirs;
38 
#        print "Scanning: $dir\n";
39 
        #
40 
        #   Read in the directory entries
41 
        #
42 
        next if ( ! -d $dir );
43 
        next if ( $dir =~ m~/lost\+found$~ );
44 
        opendir(my $dh, $dir) || print("Cannot readdir $dir: $!\n");
45 
        my @entries = readdir($dh);
46 
        closedir $dh;
47 
 
48 
        #
49 
        #   Process each entry
50 
        #
51 
        foreach my $entry ( @entries )
52 
        {
53 
            next if ( $entry eq '.'  || $entry eq '..');
54 
            $entry = "$dir/$entry";
55 
#            next if ( -f $entry );
56 
    #        print "Examine $entry\n";
57 
            if ( -d $entry )
58 
            {
59 
                push @dirs, $entry;
60 
                next;
61 
            }
62 
 
63 
            if ( -l $entry )
64 
            {
65 
                my $linkfile = readlink( $entry );
66 
 
67 
                #
68 
                #   Broken ?
69 
                #
70 
                if ( ! -e $entry )
71 
                {
72 
                    print "Broken link: $entry ---> $linkfile\n";
73 
                    next;
74 
                }
75 
 
76 
                #
77 
                #   Allowed to be relative
78 
                #       ie: ../ or someDir
79 
                #
80 
                next unless ( $linkfile =~ m~^/~ );
81 
 
82 
                #
83 
                #   Allowed to be within
84 
                #       /export/deploy/releases/
85 
                #       /devl/releases/3rdParty-Products/
86 
                #
87 
#                next if ( $linkfile =~ m~/export/deploy/releases/~ );
88 
#                next if ( $linkfile =~ m~/devl/releases/3rdParty-Products/~ );
89 
 
90 
                print "$entry ---> $linkfile\n";
91 
            }
92 
        }
93 
        scan_dir( @dirs );
94 
    }
95 
}
96