Subversion Repositories DevTools

    my $search =  LocateFiles->new(recurse => 1);

    my $search =  LocateFiles->new(recurse => 1);

    my $search =  LocateFiles->new(recurse => 0);

# Description     : This sub-routine is used to remove all carrage return\line

#                   feeds from a line and replace them with the platform

#                   specific equivalent chars.

#

#

#                   i.e. LF    for unix

#                   CR\LF for win32

#

# Inputs          : m_targetDirTag          - Symbolic name of target directory

#                   m_nfiles                - List of files in that directory

#                   or

#                   SearchOptions           - Search options to find files

#                                           --Recurse

#                                           --NoRecurse

#                                           --FilterIn=xxx

#                                           --FilterInRE=xxx

#                                           --FilterOut=xxx

#                                           --FilterOutRE=xxx

sub convertFile

    my @uargs;

    my $search =  LocateFiles->new( recurse => 0 );

    #

    #

        } elsif ( m~^--NoRecurse~) {

            $search->recurse(0);

        } elsif ( /^--FilterIn=(.*)/ ) {

            $search->filter_in($1);

    #

    #   Process non-option arguments

    #

    my ($m_targetDirTag, @m_nfiles) = @uargs;

    Error ("convertFiles: Target Dir must be specified" ) unless ( $m_targetDirTag );

    #

    # Convert symbolic dir tag to physical path

    #

    my ($m_targetDirValue) = getTargetDstDirValue($m_targetDirTag, "A");

    #   Need to determine if we are searching or simply using a file list

    #   There are two forms of the functions. If any of the search options have

    #

    if ( $search->has_filter() )

        Error ("convertFiles: Cannot mix search options with named files") if ( @m_nfiles );

    Error ("convertFiles: No files specified") unless ( @m_nfiles );

    #   Process all named files

    #

    foreach my $m_nfile ( @m_nfiles )

        # this is our file that we want to clean.

        my ($m_ifileLoc) = "$m_targetDirValue/$m_nfile";

        my ($m_tfileLoc) = "$m_targetDirValue/$m_nfile\.tmp";

        # we will check to see if the file exists.

        #

        local *IFILE;

        local *TFILE;

        if ( -f "$m_ifileLoc" )

        {

            open (IFILE, "< $m_ifileLoc" ) or

                Error("Failed to open file [$m_ifileLoc] : $!");

            open (TFILE, "> $m_tfileLoc" ) or

                Error("Failed to open file [$m_tfileLoc] : $!");

            while ( <IFILE> ) 

            {

                chomp;

                print TFILE "$_\n";

            }

        }

        else

        {

            Error("Deploy file [$m_ifileLoc] does not exist.");

        }

        close IFILE;

        close TFILE;

        # lets replace our original file with the new one

        #

        if(File::Copy::move("$m_tfileLoc", "$m_ifileLoc"))

        {

            Information("Renamed [$m_tfileLoc] to [$m_ifileLoc] ...");

        }

        else

        {

        }

#===============================================================================

#

#   Internal Package

#   An attempt to simplify the WildCardinf interface by capturing the parameters

#   in a package. The idea is that storing the arguments can be easier

#

package LocateFiles;

use JatsError;

#-------------------------------------------------------------------------------

# Function        : new

#

# Description     : Create a new instance of a searcher

#

# Inputs          : 

#

# Returns         : 

#

sub new {

    my $class = shift;

    my $self  = {};

    $self->{recurse}  = 0;

    $self->{exclude}  = [];

    $self->{include}  = [];

    $self->{base_dir} = undef;

    $self->{results}  = [];

    bless ($self, $class);

    #

    #   Process user arguments

    #   These are are a hash

    #

    my %href = @_;

    foreach my $entry ( keys %href )

    {

        Error( "LocateFiles:new. Unknown initialiser: $entry") unless ( exists $self->{$entry} );

        $self->{$entry} = $href{$entry};

    }

    return $self;

}

#-------------------------------------------------------------------------------

# Function        : recurse

#                   filter_in

#                   filter_in_re

#                   filter_out

#                   filter_out_re

#                   base_dir

#                   results

#

# Description     : Accessor functions

#

# Inputs          : class

#                   One argument (optional)

#

# Returns         : Current value of the daat item

#

sub recurse

{

    my $self = shift;

    if (@_) { $self->{recurse} = shift }

    return $self->{recurse};

}

sub filter_in

{

    my $self = shift;

    if (@_) { push @{$self->{include}}, glob2pat( shift ) }

    return $self->{include};

}

sub filter_in_re

{

    my $self = shift;

    if (@_) { push @{$self->{include}}, shift }

    return $self->{include};

}

sub filter_out

{

    my $self = shift;

    if (@_) { push @{$self->{exclude}}, glob2pat( shift ) }

    return $self->{exclude};

}

sub filter_out_re

{

    my $self = shift;

    if (@_) { push @{$self->{exclude}}, shift }

    return $self->{exclude};

}

sub base_dir

{

    my $self = shift;

    if (@_) { $self->{base_dir} = shift }

    return $self->{base_dir};

}

sub has_filter

{

    my $self = shift;

    return ( ( @{$self->{include}} || @{$self->{exclude}} ) );

}

#-------------------------------------------------------------------------------

# Function        : search

#

# Description     : This function performs the search for files as specified

#                   by the arguments already provided

#

# Inputs          : base_dir (Optional)

#

# Returns         : List of files that match the search criteria

#

my @search_list;             # Must be global to avoid closure problems

my $search_len;

sub search

{

    my $self = shift;

    $self->{base_dir} = $_[0] if (defined $_[0] );

    $self->{results} = ();

    #

    #   Ensure user has provided enough info

    #

    Error ("LocateFiles: No base directory provided") unless ( $self->{base_dir} );

    #

    #   Clean up the user dir. Remove any trailing / as we will be adding it back

    #

    $self->{base_dir} =~ s~/*$~~g;

    #

    #   Init recursion information

    #   Needed to avoid closure interactions

    #

    @search_list = ();

    $search_len = length( $self->{base_dir} );

    #

    #   Create a list of candidate files

    #   If we are recursing the subtree, then this is a little harder

    #   If we are not recursing then we can't simply glob the directory as

    #   not all files are processed.

    #

    #   Will end up with a list of files that

    #       1) Start with a '/'

    #       2) Are rooted as $dir, but don't include $dir

    #

    if ( $self->{recurse} )

    {

        sub find_file_wanted

        {

            return if ( -d $_ );

            my $file = $File::Find::name;

            push @search_list, substr($file, $search_len );

        }

        #

        #       Under Unix we need to follow symbolic links, but Perl's

        #       Find:find does not work with -follow under windows if the source

        #       path contains a drive letter.

        #

        #       Solution. Only use follow under non-windows systems.

        #                 Works as Windows does not have symlinks (yet).

        #

        my $follow_opt =  ! ( "$MachType" eq "win32" || "$MachType" eq "WinCE" );

        File::Find::find( {wanted => \&find_file_wanted, follow_fast => $follow_opt }, $self->{base_dir} );

    }

    else

    {

        local *DIR ;

        opendir DIR, $self->{base_dir} || die ("Cannot open $self->{base_dir}");

        foreach ( readdir( DIR ) )

        {

            next if /^\Q.\E$/;

            next if /^\Q..\E$/;

            next if ( -d "$self->{base_dir}/$_" );

            push @search_list, '/' . $_;

        }

        closedir DIR;

    }

    #

    #   If filtering is not present then return the entire file list

    #

    $self->{results} = \@search_list ;

    return @search_list

        unless ( @{$self->{include}} || @{$self->{exclude}} );

    #

    #   Filtering is present

    #   Apply the filterin rules and then the filter out rules

    #   If no filter-in rules, then assume that all files are allowed in and

    #   simply apply the filter-out rules.

    #

    my @patsin  = map { qr/$_/ } @{$self->{include}};

    my @patsout = map { qr/$_/ } @{$self->{exclude}};

    my @result;

#    map { print "Include:$_\n"; } @{$self->{include}};

#    map { print "Exclude:$_\n"; } @{$self->{exclude}};

    file:

    foreach my $file ( @search_list )

    {

        if ( @{$self->{include}} )

        {

            my $in = 0;

            for my $pat (@patsin)

            {

                if ( $file =~ /$pat/ )

                {

                    $in = 1;

                    last;

                }

            }

#print "------- Not included $file\n" unless $in;

            next unless ( $in );

        }

        for my $pat (@patsout)

        {

#print "------- REJECT $file :: $pat \n" if ( $file =~ /$pat/ );

            next file if ( $file =~ /$pat/ );

        }

        push @result, $file;

    }

    $self->{results} = \@result;

#DebugDumpData ("Search", $self);

    return @result;

}

#-------------------------------------------------------------------------------

# Function        : glob2pat

#

# Description     : Convert four shell wildcard characters into their equivalent

#                   regular expression; all other characters are quoted to

#                   render them literals.

#

# Inputs          : Shell style wildcard pattern

#

# Returns         : Perl RE

#

sub glob2pat

{

    my $globstr = shift;

    $globstr =~ s~^/~~;

    my %patmap = (

        '*' => '[^/]*',

        '?' => '[^/]',

        '[' => '[',

        ']' => ']',

    );

    $globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;

    return '/' . $globstr . '$';

}