CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
Search Posts SEARCH
Who's Online WHO'S
Log in LOG

Home: Perl Programming Help: Intermediate: Re: [FishMonger] Perl Script Causing High CPU Usage: Edit Log


Sep 29, 2013, 5:23 AM

Views: 5697
Re: [FishMonger] Perl Script Causing High CPU Usage

Hi FishMonger,

Thanks for the reply and apologies for delay response.

I was trying to find out what is causing high CPU. In a directory there are 2-3 lac files. So below while loop is resulting in high CPU usage.

Now, suppose there are 2 lac files in a directory matching pattern but out of those 2 lac only 10,000 files are 7 days old and I only want to action those files., Remaining files are modified within 7 days and thus below loop go to next section. As while run for long, it is causing high cpu usage.

Please have a look and advise if there is a better way to achieve it.


while(glob("$MatchPattern")) {
my $ObjectName = $_;
my $age = sprintf("%.6f", -M $ObjectName) if ($ObjectName);
my $size = -s $ObjectName if ($ObjectName);
my $Display = ($DtFmt) ? $DtFmt : "%Y-%m-%d";
my $ObjModTime = strftime("$Display", localtime((stat($ObjectName)->mtime))); ===> just reading date in date format specified in config file

if ($age > 0 && $age > $AgeLimit && $size <= $SizeLimit) {
if (($AutoAction eq 'AutoArchive') && ((-f $ObjectName) || (-d $ObjectName))) {
print "[$ObjModTime] Age & Size = $age > $AgeLimit And $size < $SizeLimit :: Marked to Zip\n";
qx(gzip $ObjectName) if (-f $ObjectName && $Type eq 'Sys_File');
qx(zip -rmT $ObjectName $ObjectName) if (-d $ObjectName && $Type eq 'Sys_Dir' );

} elsif (($AutoAction eq 'AutoDelete') && (-f $ObjectName)) {
print "Age & Size = $age > $AgeLimit And $size < $SizeLimit :: Marked to Remove \n";
unlink ($ObjectName);
} elsif (($AutoAction eq 'AutoMove') && $MoveToPath && ($MoveToPath ne 'Nil') && ((-f $ObjectName) || (-d $ObjectName))) {
my $HoldMoveToPath = $MoveToPath;

if (-e $MoveToPath) {
print "[$ObjModTime] Age & Size = $age > $AgeLimit And $size < $SizeLimit :: Marked to Move\n";
qx(mv $ObjectName $MoveToPath/.) if (-f $ObjectName && $SignOff eq 'Yes');


} else {

print "[$ObjModTime] Age & Size = $age > $AgeLimit And $size < $SizeLimit :: Marked No Action => $ActionPath/$ObjectName\n";



} else {

} #End of while


(This post was edited by smart_amorist on Sep 30, 2013, 5:36 PM)

Edit Log:
Post edited by smart_amorist (Novice) on Sep 30, 2013, 5:36 PM

Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives