/meeting/index.asp http://quicklinkurl1/index.asp na na xxxxxxx /meeting/series/index.asp http://quicklinkurl1/index.asp na na new url /meeting/lunchtime-meeting/index.asp http://quicklinkurl2/index.asp na na changed url /meeting/lunchtime-meeting/index.asp http://quicklinkurl2/index.asp na na another changed url #### 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 search 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 them line by line sub wanted { #print "$File::Find::name \n"; return unless -f $_; open( FILE, $_ ) || die "Cannot open $_ \n"; my @data = ; 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 replace sub xmlfeed { my $linedata = shift @_; #print $linedata; # processes the xml file one sheet at a time # # # # # # # 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\nString in $in Original value $originalURL\nNew value $newURL\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: $!"; }