use Cwd;
use XML::Simple;
use Data::Dumper;
use File::Find;
use File::NCopy;

my $dir     = "htmlsource/";
my $newdir  = "xx";
my $xmlfile ="xmlfile/urlchange.xml"; 
my $file;
my $t = 0;
my $xmldata;
my $fileout;

#### a program to search all files in the directory and performs a sea
+rch and replace using an xml file
####  as the sourse of the matched string and the replacement string.

$| = 1;    # force auto flush of output buffer

&doCopy( $dir, $newdir );

&createXMLlook();

&find( { wanted => \&wanted, no_chdir => 1 }, $newdir );

################### functions #######################

#### wanted  uses a filehandle to open up all the files and search the
+m line by line

sub wanted {

    #print "$File::Find::name \n";

    return unless -f $_;

    open( FILE, $_ ) || die "Cannot open $_ \n";
    my @data = <FILE>;

    foreach my $line (@data) {

        ##  pass the curent line of text to the next function ##
        xmlfeed($line);
    }
    close(FILE);
}

### create lookup table containing XML values

sub createXMLlook {

    # create object
    $xml = new XML::Simple();

    # read XML file
    $xmldata = $xml->XMLin($xmlfile);

    #print Dumper($xmldata);

}

####  xmlfeed  uses the xml file to get a list of the strings to repla
+ce
sub xmlfeed {

    my $linedata = shift @_;

    #print $linedata;

    # processes the  xml file one sheet at a time

    # <Sheet1>
    #    <OriginPage></OriginPage>
    #    <LinkToPage></LinkToPage>
    #    <LinkToPageStatus></LinkToPageStatus>
    #    <LinkToPageTitle></LinkToPageTitle>
    #    <New_location></New_location>
    #  </Sheet1>

    foreach $e ( @{ $xmldata->{Sheet1} } ) {
        &checkpage( $e, $linedata );

    }
}

### checks that the current page should  have the regex applied

sub checkpage {
    my $value;
    my $e          = shift @_;
    my $linedata   = shift @_;
    my $originpage = $e->{OriginPage};

    my $currentfile = "$File::Find::name";
    $currentfile =~ /(\/)([.a-zA-Z0-9_\-]+)(\/)([.a-zA-Z0-9_\/\-]+)/;
    $currentfile = $1 . $2 . $3 . $4;

    if ( $currentfile eq $originpage ) {
        #print "$originpage\n$currentfile \n\n";

        #perform replacement

        &replace( $linedata, $e->{LinkToPage}, $e->{New_location} );

    }
    else {
        return;

    }

}

#### performs a rex ex substitution on the stout.

sub replace {
    my $in          = shift @_;
    my $originalURL = shift @_;
    my $newURL      = shift @_;
    my $fileout     = "$File::Find::name";
    #print "FILEOUT $fileout\n ";
    if ( $in =~ m/$originalURL/ ) {
        $t++;
        print "Matched x " . "$t\nEdited file     $File::Find::name\nS
+tring in       $in Original value $originalURL\nNew value      $newUR
+L\n";
        $in =~ m/(.*)($originalURL)(.*)/;
        #print "$1 \n $2 \n $3\n\n";
        #print "$1 \n  $newURL\n $3\n";
        $in =~ s/(.*)($originalURL)(.*)/$1$newURL$3/;
        print "Edited line: $in\n\n";
    }
    $editedcontent .= $in;
    chmod( 0777, "$fileout" ) || print $!;
    open FILEOUT, ">$fileout" or die "can't open  $fileout for writing
+: $!";
    print FILEOUT $editedcontent;
}




#### recursivley copies existing folder into new location

sub doCopy {
    my $path    = shift @_;
    my $newpath = shift @_;

    mkdir($newpath) or die "Could not mkdir $newpath: $!";

    my $cp = File::NCopy->new( recursive => 1 );
    $cp->copy( "$path/*", $newpath )
      or die "Could not perform rcopy of $path to $newpath: $!";

}
[download]