comment on

Hi Team, I have written below code to remove, archive and remove files based on pattern and last modified time of file. There are more than 2 lac files in a directory daily matching pattern (ABC_XYZ_?????????.xml) If most of the files are older than say 7 days then maximum files are handled by below section (i.e moved, archived or deleted, and cpu take rest while mv, zip or unlink running). In that case CPU is 4-11 %, that still looks good. But if out of say 2 lac files, only 10,000 files are older than 7 days then for remaining 1,90,000 files while loop just run with print statement as there is no archive, move or delete action required. In this case CPU is reaching 25-83% which is too high. Is there a better way to control it, or better way to achieve it? Also, with perl glob files are just matched and not sorted based on modified time? Is it possible to sort files based on modification time with glob? Is there a way to just read files which are only older than 7 days and not others avoiding extra 1,90,000 rotations by while loop?


while(glob("$MatchPattern")) {
      my $ObjectName  = $_;
      my $age         = sprintf("%.6f", -M $ObjectName) if ($ObjectNam
+e);
      my $size        = -s $ObjectName if ($ObjectName);
      my $Display     = ($DtFmt) ? $DtFmt : "%Y-%m-%d";
      my $ObjModTime  =  strftime("$Display", localtime((stat($ObjectN
+ame)->mtime)));

      if ($age > 0 && $age > $AgeLimit && $size <= $SizeLimit) {
                if (($AutoAction eq 'AutoArchive') && ((-f $ObjectName
+) || (-d $ObjectName))) {
                      print "[$ObjModTime] Age & Size = $age > $AgeLim
+it 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' );
                      $ObjCounter++; 

                } elsif (($AutoAction eq 'AutoDelete') && (-f $ObjectN
+ame)) {
                         print "Age & Size = $age > $AgeLimit And $siz
+e < $SizeLimit :: Marked to Remove \n";
                         unlink ($ObjectName);
                         $ObjCounter++; 
               } elsif (($AutoAction eq 'AutoMove') && $MoveToPath && 
+($MoveToPath ne 'Nil') && ((-f $ObjectName) || (-d $ObjectName))) {
                         
                         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');
                             $ObjCounter++; 

                        } 

              } else {

                      print "[$ObjModTime] Age & Size = $age > $AgeLim
+it And $size < $SizeLimit ::  Marked No Action\n";

                      next;

              }

       } else {
              next;
       }


} #End of while
[download]

In reply to Perl Script Causing high CPU usage by smart_amorist

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


There's more than one way to do things
	PerlMonks