Subversion Repositories DevTools

Rev

Rev 4127 | Details | Compare with Previous | 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 
#
3423 dpurdie 5 
# Module name   : scan_release.pl
3410 dpurdie 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 
#
3423 dpurdie 24 
unless ( -d $root )
25 
{
26 
    print "scan_release: Not a directory: $root\n";
27 
    exit 1;
28 
}
3410 dpurdie 29 
 
3423 dpurdie 30 
scan_dir( $root );
31 
exit 0;
32 
 
3410 dpurdie 33 
#-------------------------------------------------------------------------------
34 
# Function        : scan_dir
35 
#
36 
# Description     : Scan a list of directoires for bad links
37 
#
38 
# Inputs          : List of directories to scan
39 
#
40 
sub scan_dir
41 
{
42 
    foreach my $dir ( @_ )
43 
    {
44 
        my @dirs;
4542 dpurdie 45 
        my $dh;
3410 dpurdie 46 
#        print "Scanning: $dir\n";
47 
        #
48 
        #   Read in the directory entries
49 
        #
50 
        next if ( ! -d $dir );
4542 dpurdie 51 
        unless ( opendir($dh, $dir) )
4127 dpurdie 52 
        {
53 
            my  $mode = (stat($dir))[2];
54 
            printf("Cannot readdir $dir: $!, Mode:%04o\n", $mode & 07777);
55 
            next;
56 
        }
3410 dpurdie 57 
        my @entries = readdir($dh);
58 
        closedir $dh;
59 
 
60 
        #
61 
        #   Process each entry
62 
        #
63 
        foreach my $entry ( @entries )
64 
        {
3423 dpurdie 65 
            next if ( $entry eq '.' );
66 
            next if ( $entry eq '..' );
67 
            next if ( $entry eq 'core_devl' );
68 
            next if ( $entry eq 'lost+found' );
69 
 
3410 dpurdie 70 
            $entry = "$dir/$entry";
71 
            if ( -d $entry )
72 
            {
73 
                push @dirs, $entry;
74 
                next;
75 
            }
76 
 
77 
            if ( -l $entry )
78 
            {
79 
                my $linkfile = readlink( $entry );
80 
 
81 
                #
82 
                #   Broken ?
83 
                #
84 
                if ( ! -e $entry )
85 
                {
86 
                    print "Broken link: $entry ---> $linkfile\n";
87 
                    next;
88 
                }
89 
 
90 
                #
91 
                #   Allowed to be relative
92 
                #       ie: ../ or someDir
93 
                #
94 
                next unless ( $linkfile =~ m~^/~ );
95 
 
96 
                #
3423 dpurdie 97 
                #   Allowed to be a link to a file in the same directory
3410 dpurdie 98 
                #
3423 dpurdie 99 
                next unless ( $linkfile =~ m~/~ );
3410 dpurdie 100 
 
3423 dpurdie 101 
                #
102 
                #   Absolute links are not good
103 
                #
104 
                print "Absolute Link: $entry ---> $linkfile\n";
3410 dpurdie 105 
            }
106 
        }
107 
        scan_dir( @dirs );
108 
    }
109 
}
110