Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery

by tfrayner (Curate)
on Oct 02, 2001 at 14:55 UTC ( #116099=sourcecode: print w/replies, xml ) Need Help??
Category: Text Processing
Author/Contact Info Tim Rayner
Description: Here's a little script I wrote as an exercise. My aim was to implement a user-friendly way of substituting text across a heirarchy of files and directories. There is of course a simple way to do this without resorting to this script. However, the development of the script allowed me to add some nice features. Try 'perldoc' for details.

I'd welcome any comments, particularly with regard to efficiency/performance and portability.

#! /usr/bin/perl -w

use strict;
use warnings;
use Getopt::Long;
use File::Spec;
use POSIX;


=head1 NAME - a script to replace text in a heirarchy 
of files and directories


B<> S<[ B<-achmRF> ]> S<[ B<-d>[I<destdir>] ]> 
S<[ B<-e>[I<exclude>] ]> S<B<-f>[I<findstr>]> 
S<B<-r>[I<replacestr>]> I<files>


This script is designed to take a list of files and/or 
directories and perform simple text substitutions in a 
global fashion. The processed files are then placed in 
a new directory, maintaining filesystem heirarchy. The 
script can be made to traverse directories recursively, 
optionally omitting named files from its processing. 
File and directory permissions can be maintained if so 
desired. The script will accept a wildcard file 
designation, or a list of files from I<stdin>. Raw octal 
ASCII codes can be included in substitutions using the 
B<-a> switch.

The script will not overwrite write-protected files; 
nor will it override the current B<umask> default. 

=head1 OPTIONS

=over 4

=item B<-h>

Prints a short help text.

=item B<-f> I<findstr> 

=item B<-r> I<replacestr>

=item B<-d> I<destdir>

The B<-f> switch designates the string to be found and 
replaced with the string specified using the B<-r> 
switch. The destination directory for altered files can 
be set using the B<-d> option. The default directory 
name is 'I<./changed>'.

=item B<-R> 

Recurse down into subdirectories.

=item B<-F>

Force overwriting of existing files. Write-protected 
files will not be overwritten. If this switch is 
omitted the user will be asked whether to overwrite 
already existing files.

=item B<-e> 

Exclude specific file and directory names. This option 
allows the user to pass a comma-delimited list of file 
and/or directory names to be excluded.

=item B<-m> 

Maintain file and directory permissions. The current 
B<umask> value is the default. Note that mkdir() (and 
hence this script) apparently doesn't set suid bits 
and is unable to override B<umask>. Not that this is 
necessarily a bad thing.

=item B<-c> 

Accept input from I<stdin>.

=item B<-a> 

Allow the use of backslashed ASCII codes 
(e.g. \012, \015) in the I<findstr> and I<replacestr> 
substitution parameters. Note that codes passed from 
the command line must have their backslashes escaped, 
i.e. \\012, \\015. The codes must be in 3-digit octal 


=head1 AUTHOR

Tim Rayner (, 2001.

=head1 BUGS

The B<-c> I<stdin> input switch will accept a clean 
list of files (i.e. containing nothing but files or 
directories, correctly designated relative to the 
current working directory). Anything else will 
generate warnings but will attempt to soldier on 



$Getopt::Long::ignorecase=0;      # case sensitive option matching


# we can't just look at $ARGV[0] because of command lines 
# specifying foo/*/* and stuff like that.

sub getbase{             # takes a reference to an array of paths, ret
+urns common path
    my $parray=shift;
    my $pathholder=$$parray[0];
    my @pathholderdirs=File::Spec->splitdir($pathholder);
    foreach my $path (@$parray){
    my @pathdirs=File::Spec->splitdir($path);
    my $i=$#pathholderdirs;
    while (@pathholderdirs[0 .. $i] ne @pathdirs[0 .. $i]){$i--;}
    $pathholder=File::Spec->catfile(@pathholderdirs[0 .. $i]);
    return ($pathholder);


sub dirmode{
    my $sourcedir=shift;
    my $permsflag=shift;
    my $mode;
    if ($permsflag){
    return ($mode);


sub asciicode{    
    my $string=shift;
    while ($string=~ /\\(\d\d\d)/){
       my $ascii=chr(oct($1));
       $string=~ s/\\$1/$ascii/g;
    return $string;


sub parseargs{

    # Creates the main top-level hash used to store all the passed var
    # Note that recursing down into subdirectories needs a new hash fo
+r each level
    # (see sub recursedir below).

    my %phash;
    $phash{clobber}=0;            #defaults to no clobber
    $phash{changedir}="changed";  #default change directory
    &GetOptions("h|help"        => \$phash{helptext},
        "c|stdin"       => \$phash{readstdin},
        "m|maintain"    => \$phash{keepperms},
        "e|exclude=s"   => \$phash{exclude},
        "a|ascii"       => \$phash{ascii},
        "F|force"       => \$phash{clobber},
        "R|recurse"     => \$phash{recurse},
        "d|directory=s" => \$phash{changedir},
        "f|find=s"      => \$phash{find},
        "r|replace=s"   => \$phash{replace});

    $phash{changedir}= File::Spec->rel2abs($phash{changedir});
    if ($phash{helptext}){
    die ("Usage: [-h] [-c] [-m] [-R] [-F] [-d <destinat
+ion directory>]".
         "\n\t[-e <exclude list>] [-a] -f <findstr> -r <replacestr> <f
    unless ($phash{find} && $phash{replace}){
    die("Insufficient arguments. Use -h for help summary.\a\n");

    # allow passing of ascii codes

    if ($phash{ascii}){

    # set up file array

    if (@ARGV){
    foreach my $path(@ARGV){
    } elsif ($phash{readstdin}){
    my $i=0;
    foreach my $path(<STDIN>){
    # reset STDIN to read from the terminal
    close(STDIN) or die ("STDIN error: $!.\a\n");
    my $tty=POSIX::ctermid();
    open(STDIN,"$tty") or die ("Can't read from terminal: $!.\a\n");
    } else {die ("No input files specified.\a\n");}

    # set up excluded array

    if ($phash{exclude}){
    my @temparray=split /,/, $phash{exclude}; # comma delimited. chang
+e as required.


    my $pref=\%phash;
    return ($pref);


sub makenewdir{
    my $changedir=shift;
    my $mode=shift;
    my $clobber=shift;
    my $safetooverwrite=0;
    until ($safetooverwrite){
    if (-e $changedir && !$clobber){
        print STDERR ("Directory \'$changedir\' aleady exists. Overwri
              "[Y(es)/N(o)/R(eselect destination)/C(lobber all duplica
        my $answer = <STDIN>;
        chomp ($answer);
      SWITCH: {
          $answer eq 'y' && do {$safetooverwrite=1; last SWITCH;};
          $answer eq 'r' && do {print STDERR ("Please input new destin
+ation ".
                          "directory name:\n");
                    $changedir = <STDIN>;
                    chomp ($changedir);
                    last SWITCH;};
          $answer eq 'c' && do {$clobber=1; 
                    last SWITCH;};
          die ("Script aborted by user.\n");
    } else {$safetooverwrite=1;}
    unless (-e $changedir){
    mkdir ($changedir,$mode) or die ("Error: mkdir: $!.\n");
    return ($changedir,$clobber);


sub recursedir {
    my $newindir = shift;
    my $pref = shift;
    my $callersubref = shift;

    opendir NEWDIR, $newindir;

    # avoid . and .. entries

    my @newfilearray = File::Spec->no_upwards(readdir NEWDIR);
    closedir NEWDIR;
    foreach my $entry (@newfilearray){

    # create the new hash for the next recursion
    my %newphash = %$pref;

    $newindir = File::Spec->abs2rel($newindir,$$pref{basedir});

    my $newpref=\%newphash;
    # here we go again...
    &{$callersubref} ($newpref);


sub findreplace {
    my $pref=shift;
    my @filearray= @{$pref->{filearrayref}};
    INFILELOOP: foreach my $infile (@filearray) {

        # handle excluded files here

    if ($$pref{exclude}){
        my $filename=(File::Spec->splitpath($infile))[2];
        my @excludearray=@{$pref->{excludearrayref}};
        foreach my $exfile(@excludearray){
        next INFILELOOP if ($filename eq $exfile)

        # directory handling, including recursion

    if (-d $infile){
        if ($$pref{recurse}){
        my $callersub = \&findreplace;
        &recursedir ($infile, $pref, $callersub);
        next INFILELOOP;

    # check output file doesn't already exist

    my $strippedname = (File::Spec->splitpath($infile))[2];
    my $outfile = File::Spec->catfile($$pref{changedir},$strippedname)
    if (-e $outfile && !$$pref{clobber}){
        print STDERR ("File \'$outfile\' aleady exists. ".
              "Overwrite? [Y(es)\/N(o)\/A(ll)]\n");
        my $answer = <STDIN>;
        chomp ($answer);
      SWITCH: {
          $answer eq 'y' && do {last SWITCH;};
          $answer eq 'a' && do {$$pref{clobber}=1;
                    last SWITCH;};
          next INFILELOOP;

        # actually find and replace stuff

    unless (open (INFILE, "<$infile")){
        warn ("Error: $infile: $!. Skipping.\n"); 
        next INFILELOOP;
    unless (open (OUTFILE,">$outfile")){
        warn ("Can't open output file \'$outfile\': $!. Skipping.\n");
        next INFILELOOP;
    foreach my $line (<INFILE>) {
        $line =~ s/$$pref{find}/$$pref{replace}/go;
        print OUTFILE ($line);
    if ($$pref{keepperms}){
        my $mode=(stat($infile))[2];
        chmod $mode, $outfile;
    close (OUTFILE) or die ("Error: $!.\a\n");
    close (INFILE) or die ("Error: $!.\a\n");


# $pref is reference to main parameter hash
my $pref=&parseargs;

# create initial destination directory

# Set base destination directory. Important to have as a constant for 

# do the deed
&findreplace ($pref);

print ("Done.\n");
Replies are listed 'Best First'.
by Anonymous Monk on Jan 20, 2004 at 09:40 UTC
    Just a small suggestion, but if you leave the check for a replace argument out of the following code:
      unless ($phash{find} && $phash{replace}){
      unless ($phash{find}){
    Then you can also do a find Delete.

    Also as a side note, in windows, the find argument appears to be always preprocessed for octal binary codes, regardless of the state of the -a switch. I can't however find a reason, although the code looks secure.
    if ($phash{ascii}){ $phash{find}=&asciicode($phash{find}); $phash{replace}=&asciicode($phash{replace}); }
    Regards, Dermot
A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://116099]
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (4)
As of 2021-10-19 08:40 GMT
Find Nodes?
    Voting Booth?
    My first memorable Perl project was:

    Results (76 votes). Check out past polls.