Search and update script take too long !

[kirk124]

Hi,

I have a script that search my pc for folder or file that contain a certain substring and update them. The script also open files and search for the same substring and update them. The problem is my script take more than an hour to finish running and I suspect that it has something to do with the alogarithm.

Here is the script:

#!/usr/perl/bin
#=============================================================#
#
#This script traverse directory updating files and directories names
#
#==============================================================#
use strict;

use File::Find;
use Win32::AdminMisc;
use Sys::Hostname;

my $old_hostname = hostname(); #current hostname
my ($new,$orig,$changed,$concat,$new_hostname, $result,$f,$file, $str,$ln,$line, @files,$linr );
my @lines = " ";
my @files;
my @fixedDrives = Win32::AdminMisc::GetDrives(DRIVE_FIXED);



## Create new hostname based on physical address ###
print "Current host name of machine is :$old_hostname \n";
$new_hostname = "csscs_ref";
print "The new host name is going to be: $new_hostname\n";


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

print "Looking for files to rename \n";
finddepth (\&rename_file_dir , @fixedDrives );
finddepth (\&modified_file , @fixedDrives );

#----------------------------------------------------------------------------------------------------------------------------
sub rename_file_dir
{
if( /(.*)$old_hostname(.*)/i )# any files or directories
{
$orig = $File::Find::name ;
print "rename_file_dir : $orig\n";

$concat = $File::Find::dir . "\/$1$new_hostname$2";
rename($orig, $concat) || print "error can't rename $orig to $concat: $!"
}

} # end of sub update_file
#-------------------------------------------------------------------------------------------------------------------------
sub modified_file
{

if (-f "$File::Find::name" and (! -B "$File::Find::name&quot){

print "modified_file sub : $File::Find::name\n";


open (IN,"$File::Find::name"
@lines = <IN>;
close IN;

@lines = map { s/\b$old_hostname\b/$new_hostname/sgi; $_ } @lines;
open (OUT,&quot;>$File::Find::name&quot || &quot;can't open $File::Find::name for writing :$! &quot;;
print OUT @lines;
}

}


If can someone point out my error or show me a better way I would be grateful.

--thanks

 

[justice41]

The most immediate speedup that I see is in the modified_file sub. In this sub you pass through each file THREE times. Once to load the file into an array, once to substitute the text, and a third time to print it out. You could cut this down to one pass with a while loop that loads line-by-line, substitutes, and then prints the line to the new file. Something along the lines of (untested!)

my $orig = $File::Find::name;
my $tmp = $org."_tmp";
unless ( open IN, $orig ) {
    warn "Can't open '$orig' for read: $!\n";
    return;
}
unless ( open OUT, ">", $tmp ) {
    warn "can't open '$tmp' for write: $!\n";
    close (IN);
    return;
}
while (<IN>) {
    s/\b$old_hostname\b/$new_hostname/gi;
    print OUT $_;
}
close (IN);
close (OUT);
rename $tmp, $orig;

You could probably speed up some of the regexes in the other sub, but I don't think I would make as much of a difference.

jaa