LinuxQuestions.org
Review your favorite Linux distribution.
Home Forums Tutorials Articles Register
Go Back   LinuxQuestions.org > Forums > Non-*NIX Forums > Programming
User Name
Password
Programming This forum is for all programming questions.
The question does not have to be directly related to Linux and any language is fair game.

Notices


Reply
  Search this Thread
Old 04-15-2009, 02:39 PM   #1
MikeDawg
LQ Newbie
 
Registered: Mar 2004
Location: Colorado
Distribution: Slackware, CentOS, Fedora, Kali
Posts: 29

Rep: Reputation: 15
Perl "re-execute" sub process


I wrote a perl script to remove the oldest files from a directory, until the partition reaches a desired size. The only problem I'm getting now, is getting the sub process to run again, as to find the next oldest file.

How do I run this, so that, if the partition is not yet under 83%, that it finds the next oldest file?

Thanks

== BEGIN SCRIPT ==

#!/usr/bin/perl
#
# New script to remove the oldest file in order to
# get the partition size under 83%
#
use strict;
use warnings;
use File::Find;
#
my $userName = $ENV{'USER'};
if ($userName ne "root") {
exit 1;
}
#
my $DiskPart = 0;
my $maxSize = 83;
my $DiskDir = "/var/log/check";
#
$DiskPart = "/var/log/check";
#
# Determine current usage on log partition
#
my $partSize1 = `( /bin/df '$DiskPart' | /bin/egrep -v -i filesystem )`;
my @partSizeArray = split(' ', $partSize1);
my $partSize = `( /bin/echo '$partSizeArray[4]' | /usr/bin/tr -d % )`;
undef @partSizeArray;
#
@ARGV=qw(".") unless @ARGV;
my $oldestName = "";
my $oldestDate = 0;
#
# sub process that finds the oldest file
#
sub findOldFile {
return unless -f $_&& -M $_ > $oldestDate;
$oldestDate = -M $_;
$oldestName = $File::Find::name;
}
#
# Keep deleting files until partition is less than, or equal to $maxSize
#
until ($partSize <= $maxSize) {
find (\&fildOldFile, "$DiskDir");
unlink($oldestName);
$partSize1 = `( /bin/df '$DiskPart' | /bin/egrep -v -i filesystem )`;
@partSizeArray = split(' ', $partSize1);
$partSize = `( /bin/echo '$partSizeArray[4]' | /usr/bin/tr -d % )`;
}

== END SCRIPT ==
 
Old 04-15-2009, 06:31 PM   #2
Telemachos
Member
 
Registered: May 2007
Distribution: Debian
Posts: 754

Rep: Reputation: 60
Are you sure that the loop is running even once? A few things jump out at me. One is that you're overquoting - putting variables in double quotes when you don't need quotes, using double quotes where you only need single quotes (no interpolation) and using single quotes where I'm not sure that you want any quotes (inside the shell command). Second, I think that you can simplify how you get the partition size. Third, is /var/log/check mounted separately? Otherwise, I don't think that you can run df on part of a filesystem, can you? (I may be completely wrong about that part, but it seems true on my system. If I run df /var/log, I get the same df output I would get for all of /dev/sda2 where /var/log lives.)

Here's a simplified version of the start of the script that you can use for debugging - that is, just to make sure that you are getting sane values stored in the initial part of the script. (In the future, please put your code in code blocks. It makes it much easier to read.)
Code:
#!/usr/bin/env perl
use strict;
use warnings;

my $name = $ENV{USER};
if ($name) {
  print "You are $name\n";
}
else {
  print "Nothing captured in $name\n";
}

my $dir       = '/dev/sda1';
my $part_size =  qx{df $dir | egrep -v Filesystem};
$part_size    =  (split /\s+/, $part_size)[4];
$part_size    =~ y/%//d;

print "Size of $dir = $part_size percent\n";
Edit: I'm sorry, but I missed the elephant in the room. When you use File::Find's find, it immediately drills down and keeps going as far as it can. So you need to turn your logic inside out. Rather than putting the call to find inside the until loop, you need to put the bail-out inside of the callback code that you give to find. If you take something like the following and wrap it in an eval (to catch the die), that should work better. I hope this helps.
Code:
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;

my $name = $ENV{USER};
print "You are $name\n" if $name;

my $max = 25;
my $dir = '/home/telemachus/test';
my $part_size = check_size($dir);

print "Size of $dir = $part_size \n";

my $code_ref = sub {
  die if $part_size < $max;
  next if $_ eq '.' or $_ eq '..';
  print "Size at $part_size; deleting $_\n";
  unlink $_;
  $part_size = check_size($dir);
};

find $code_ref, $dir;

sub check_size {
  my $dir = shift;
  my $part_size = qx{du -s $dir};
  $part_size    =~ s/\D//g;
  return $part_size
}
I switched a few things up in order to test this on my machine, but you should be able to change it easily enough.

Last edited by Telemachos; 04-15-2009 at 07:35 PM.
 
Old 04-15-2009, 08:17 PM   #3
ghostdog74
Senior Member
 
Registered: Aug 2006
Posts: 2,697
Blog Entries: 5

Rep: Reputation: 244Reputation: 244Reputation: 244
It might be easier to use a Perl module such as FileSys:: Df. you might want to try using an infinity loop and break out when condition doesn't meet.
Code:
use strict;
use warnings;
use File::Find;
use Filesys::Df;

#
my $userName = $ENV{'USER'};
if ($userName ne "root") {
exit 1;
}
#
my $DiskPart = 0;
my $maxSize = 83;
my $DiskDir = "/var/log/check";
$DiskPart = "/var/log/check";

@ARGV=qw(".") unless @ARGV;
my $oldestName = "";
my $oldestDate = 0;
#
# sub process that finds the oldest file
#
sub findOldFile {
    return unless -f $_&& -M $_ > $oldestDate;
    $oldestDate = -M $_;
    $oldestName = $File::Find::name;
}

sub findinfo {
        my $diskpart = $_[0];
        my $ref = df($diskpart);  # Default output is 1K blocks
         if(defined($ref)) {
            print "Total 1k blocks: $ref->{blocks}\n";
            print "Total 1k blocks free: $ref->{bfree}\n";
            print "Total 1k blocks avail to me: $ref->{bavail}\n";
            print "Total 1k blocks used: $ref->{used}\n";
            print "Percent full: $ref->{per}\n";
            if(exists($ref->{files})) {
               print "Total inodes: $ref->{files}\n";
               print "Total inodes free: $ref->{ffree}\n";
               print "Inode percent full: $ref->{fper}\n";
            }
         }
          return $ref->{per};

}
while (1){
    my $percentfull = findinfo($DiskPart);  
    if ( $percentfull gt $maxSize){
     print "not ok... doing deletion of files\n";
      .....
     last;
    }
    sleep 200;
}
 
Old 04-16-2009, 07:02 AM   #4
Telemachos
Member
 
Registered: May 2007
Distribution: Debian
Posts: 754

Rep: Reputation: 60
@ Mike: I see now that your original solution didn't have the problem I thought it did.
Code:
sub findOldFile {
  return unless -f $_&& -M $_ > $oldestDate;
  $oldestDate = -M $_;
  $oldestName = $File::Find::name;
}
#
# Keep deleting files until partition is less than, or equal to $maxSize
#
until ($partSize <= $maxSize) {
  find (\&fildOldFile, "$DiskDir");
  unlink($oldestName);
  $partSize1 = `( /bin/df '$DiskPart' | /bin/egrep -v -i filesystem )`;
  @partSizeArray = split(' ', $partSize1);
  $partSize = `( /bin/echo '$partSizeArray[4]' | /usr/bin/tr -d % )`;
}
Since you're using File::Find only to find the oldest item, your version doesn't have the problem in logic that I was worried about. However, it does have one performance issue worth thinking about: as the script runs, you repeatedly call findOldFile to check for the oldest file. But unless your script runs for a very long time, that's redoing a lot of work for no reason. Instead of doing that, I would gather that information once and then cycle through it using a loop of some kind.

Here's an example of what I mean:
Code:
#!/usr/bin/env perl
use strict;
use warnings;
use File::Find;

my @files;
my $dir = '/Users/hektor/unix.varia';
sub by_age {
  return unless -f $_;
  push @files,  [ $File::Find::name => -M $_ ];
}

find \&by_age, $dir;
@files = sort { $b->[1] <=> $a->[1] } @files;

for my $item (@files) {
  my $file = $item->[0];
  my $age  = $item->[1];
  print "File: $file => age: $age\n";
}
The find subroutine builds an array of arrays in @files. Each subarray in @files has one file's complete path and its age. Then we sort the outer array by the age of the items in the subarrays (in descending order - oldest to newest). This way, we only have to do all the age checks once, and then you can go on with the rest of the program. (A loop, delete items, check size of partition, break out when the size overall is small enough.)

All of that said, Ghostdog's suggestion is good too. The Filesys::Df module looks pretty good. (No cap on the 's' of 'sys', by the way.)

Last edited by Telemachos; 04-16-2009 at 08:08 AM.
 
Old 04-16-2009, 08:04 AM   #5
MikeDawg
LQ Newbie
 
Registered: Mar 2004
Location: Colorado
Distribution: Slackware, CentOS, Fedora, Kali
Posts: 29

Original Poster
Rep: Reputation: 15
Thanks for the help guys, I'll be playing with this code today. . . Hopefully with all the help you guys have given me, I'll get it going.
 
  


Reply

Tags
clean, partition, perl, script



Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off



Similar Threads
Thread Thread Starter Forum Replies Last Post
Failed to execute child process "ooffice" (Permission denied) Mol_Bolom Linux - Software 2 03-11-2009 04:23 PM
"failed to execute child process" "Input/output error" fl.bratu Fedora 4 12-15-2008 04:03 AM
Failed to execute child process "xscreensaver" fakie_flip Solaris / OpenSolaris 7 10-21-2008 06:49 AM
Cannot launch entry oowriter Failed to execute child process "/usr/bin/oowriter" Mark_in_Hollywood Linux - General 2 04-13-2006 10:14 AM
cannot execute "/sbin/agetty" <-- appears during kernel boot process CestusGW Linux - General 2 01-10-2004 05:16 PM

LinuxQuestions.org > Forums > Non-*NIX Forums > Programming

All times are GMT -5. The time now is 06:03 PM.

Main Menu
Advertisement
My LQ
Write for LQ
LinuxQuestions.org is looking for people interested in writing Editorials, Articles, Reviews, and more. If you'd like to contribute content, let us know.
Main Menu
Syndicate
RSS1  Latest Threads
RSS1  LQ News
Twitter: @linuxquestions
Open Source Consulting | Domain Registration