Subversion Repositories DevTools

#! /usr/bin/perl
########################################################################
# Copyright (C) 2010 Vix-ERG Limited, All rights reserved
#
# Module name   : recover_deploy4.pl
# Module type   : Makefile system
# Compiler(s)   : Perl
# Environment(s): jats
#
# Description   : Scan the Releases area looking for bad symlinks
#
#
#......................................................................#

require 5.008_002;
use strict;
use warnings;

my $root = $ARGV[0] || die ("Need to specify root directory");

#
#   Process ech directory
#
scan_dir( glob "$root/*" );

#-------------------------------------------------------------------------------
# Function        : scan_dir
#
# Description     : Scan a list of directoires for bad links
#
# Inputs          : List of directories to scan
#
sub scan_dir
{
    foreach my $dir ( @_ )
    {
        my @dirs;
#        print "Scanning: $dir\n";
        #
        #   Read in the directory entries
        #
        next if ( ! -d $dir );
        next if ( $dir =~ m~/lost\+found$~ );
        opendir(my $dh, $dir) || print("Cannot readdir $dir: $!\n");
        my @entries = readdir($dh);
        closedir $dh;

        #
        #   Process each entry
        #
        foreach my $entry ( @entries )
        {
            next if ( $entry eq '.'  || $entry eq '..');
            $entry = "$dir/$entry";
#            next if ( -f $entry );
    #        print "Examine $entry\n";
            if ( -d $entry )
            {
                push @dirs, $entry;
                next;
            }

            if ( -l $entry )
            {
                my $linkfile = readlink( $entry );

                #
                #   Broken ?
                #
                if ( ! -e $entry )
                {
                    print "Broken link: $entry ---> $linkfile\n";
                    next;
                }

                #
                #   Allowed to be relative
                #       ie: ../ or someDir
                #
                next unless ( $linkfile =~ m~^/~ );

                #
                #   Allowed to be within
                #       /export/deploy/releases/
                #       /devl/releases/3rdParty-Products/
                #
#                next if ( $linkfile =~ m~/export/deploy/releases/~ );
#                next if ( $linkfile =~ m~/devl/releases/3rdParty-Products/~ );

                print "$entry ---> $linkfile\n";
            }
        }
        scan_dir( @dirs );
    }
}