Loading ...
Sorry, an error occurred while loading the content.

Re: [PBML] RE: X days old

Expand Messages
  • Shlomi Fish
    ... You should use File::Find ( http://search.cpan.org/perldoc?File::Find ), File::Find::Object:
    Message 1 of 6 , May 29 6:14 AM
    • 0 Attachment
      On Friday 29 May 2009 14:31:29 Wittich,Douglas G wrote:
      > ________________________________
      > From: perl-beginner@yahoogroups.com [mailto:perl-beginner@yahoogroups.com]
      > On Behalf Of Dukelow, Don Sent: Monday, May 18, 2009 1:10 PM
      > To: perl-beginner@yahoogroups.com
      > Subject: [PBML] X days old
      >
      >
      >
      >
      > Is there a Perl module that has a command that will remove all files that
      > are over X days old in a directory? Or will I have to write something?
      >
      > I've try using the UNIX "find" command from Perl but that is nasty.
      >
      > qx("/bin/find $data_dir -mtime $days -exec rm {} \;");
      >

      You should use File::Find ( http://search.cpan.org/perldoc?File::Find ),
      File::Find::Object:
      http://www.shlomifish.org/open-source/projects/File-Find-Object/

      , File::Find::Rule (on the CPAN) or something. They are the Perl eqvuivalent
      to the UNIX find command. Let me know if you need more help.

      Are you interested in deleting from a directory (without the sub-directories)
      or throughout an entire directory tree?

      Regards,

      Shlomi Fish

      --
      -----------------------------------------------------------------
      Shlomi Fish http://www.shlomifish.org/
      Freecell Solver - http://fc-solve.berlios.de/

      God gave us two eyes and ten fingers so we will type five times as much as we
      read.
    • Robert Lee Binkley
      #!/usr/bin/perl # delold.pl - delete old files use strict; use warnings; use Win32::Autoglob; use Getopt::Long; $| = 1; sub print_usage; sub abort_usage; #
      Message 2 of 6 , May 29 3:08 PM
      • 0 Attachment
        #!/usr/bin/perl

        # delold.pl - delete old files

        use strict;
        use warnings;
        use Win32::Autoglob;
        use Getopt::Long;

        $| = 1;

        sub print_usage;
        sub abort_usage;

        # option defaults
        my $days_back = 10;
        my $test_flag = 0;
        my $verbose_flag = 0;
        my $quiet_flag = 0;

        # get options
        GetOptions (
        'days=i' => \$days_back,
        'test' => \$test_flag,
        'verbose' => \$verbose_flag,
        'quiet' => \$quiet_flag,
        'usage' => sub {print_usage; exit 1},
        ) or abort_usage "Invalid option";

        my $time = time();

        my $files_to_delete = 0;
        my $files_total = 0;
        my $files_failed = 0;

        FILE:
        for my $file (@ARGV) {

        # must exist, must be a plain old file
        next FILE if !-e $file;
        next FILE if !-f $file;

        $files_total++;

        # modified age in days
        my ($mtime) = (stat($file))[9];
        my $modified_age = ($time - $mtime) / (3600 * 24);

        # skip if too young
        next FILE if $modified_age < $days_back;

        $files_to_delete++;

        if ($test_flag || $verbose_flag) {
        printf "Age: %-6.1f File: %s\n",
        $modified_age,
        $file;
        }

        # skip if we are testing
        next FILE if $test_flag;

        # delete the file
        if (!unlink $file) {
        warn "Failed to delete file $file\n";
        $files_failed++;
        }

        }

        if ($test_flag) {
        print "\nTest Flag is set, no deletes done!\n";
        }

        my $files_remaining = $files_total - $files_to_delete + $files_failed;

        if (!$quiet_flag || $test_flag) {
        print "\n";
        print "Total files: $files_total\n";
        print "Files to delete: $files_to_delete\n";
        print "Failed to delete: $files_failed\n";
        print "Files remaining: $files_remaining\n";
        }

        exit 1;

        sub abort_usage {
        print STDERR join("\n", @_), "\n" if @_;
        print_usage;
        exit 0;
        }

        sub print_usage {
        print STDERR <<END;
        Usage: delold.pl [Options] files...
        Options:
        --days n - Set age of files to keep.
        Files over "days" old will be deleted.
        Default is 10 days.
        --test - Print file names to be deleted with age,
        but do not actually delete.
        Default is false.
        --verbose - Print file name and age while deleting.
        Default is false.
        --quiet - Suppress printing of totals after deleting.
        Default is false.
        --usage - print this message and exit
        END
        }


        -----Original Message-----
        From: perl-beginner@yahoogroups.com [mailto:perl-beginner@yahoogroups.com]
        On Behalf Of Shlomi Fish
        Sent: Friday, May 29, 2009 8:15 AM
        To: perl-beginner@yahoogroups.com
        Subject: Re: [PBML] RE: X days old

        On Friday 29 May 2009 14:31:29 Wittich,Douglas G wrote:
        > ________________________________
        > From: perl-beginner@yahoogroups.com [mailto:perl-beginner@yahoogroups.com]
        > On Behalf Of Dukelow, Don Sent: Monday, May 18, 2009 1:10 PM
        > To: perl-beginner@yahoogroups.com
        > Subject: [PBML] X days old
        >
        >
        >
        >
        > Is there a Perl module that has a command that will remove all files that
        > are over X days old in a directory? Or will I have to write something?
        >
        > I've try using the UNIX "find" command from Perl but that is nasty.
        >
        > qx("/bin/find $data_dir -mtime $days -exec rm {} \;");
        >

        You should use File::Find ( http://search.cpan.org/perldoc?File::Find ),
        File::Find::Object:
        http://www.shlomifish.org/open-source/projects/File-Find-Object/

        , File::Find::Rule (on the CPAN) or something. They are the Perl eqvuivalent

        to the UNIX find command. Let me know if you need more help.

        Are you interested in deleting from a directory (without the
        sub-directories)
        or throughout an entire directory tree?

        Regards,

        Shlomi Fish

        --
        -----------------------------------------------------------------
        Shlomi Fish http://www.shlomifish.org/
        Freecell Solver - http://fc-solve.berlios.de/

        God gave us two eyes and ten fingers so we will type five times as much as
        we
        read.



        ------------------------------------

        Unsubscribing info is here:
        http://help.yahoo.com/help/us/groups/groups-32.htmlYahoo! Groups Links
      • merlyn@stonehenge.com
        ... Robert next FILE if !-e $file; Robert next FILE if !-f $file; If it s not -f, it s not -e. No point in checking both. -- Randal L. Schwartz -
        Message 3 of 6 , May 29 8:35 PM
        • 0 Attachment
          >>>>> "Robert" == Robert Lee Binkley <leebinkley@...> writes:

          Robert> next FILE if !-e $file;
          Robert> next FILE if !-f $file;

          If it's not -f, it's not -e. No point in checking both.

          --
          Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
          <merlyn@...> <URL:http://www.stonehenge.com/merlyn/>
          Smalltalk/Perl/Unix consulting, Technical writing, Comedy, etc. etc.
          See http://methodsandmessages.vox.com/ for Smalltalk and Seaside discussion
        Your message has been successfully submitted and would be delivered to recipients shortly.