Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
Copy	[ DIR ]	drwxr-xr-x
HomeDir	[ DIR ]	drwxr-xr-x
Type	[ DIR ]	drwxr-xr-x
DirList.pm	6.26 KB	-rw-r--r--
HomeDir.pm	21.2 KB	-rw-r--r--
Listing.pm	13.57 KB	-rw-r--r--
MMagic.pm	54.1 KB	-rw-r--r--
NFSLock.pm	21.94 KB	-rw-r--r--
Next.pm	16.26 KB	-rw-r--r--
RandomAccess.pm	14.3 KB	-rw-r--r--
RandomAccess.pod	4.15 KB	-rw-r--r--
ReadBackwards.pm	9.93 KB	-rw-r--r--
Remove.pm	14.15 KB	-rw-r--r--
Share.pm	1 KB	-rw-r--r--
Share.pod	2.12 KB	-rw-r--r--
ShareDir.pm	17.79 KB	-rw-r--r--
Slurp.pm	30.61 KB	-rw-r--r--
Touch.pm	7.24 KB	-rw-r--r--
Type.pm	39.14 KB	-rw-r--r--
Which.pm	11.68 KB	-rw-r--r--

Code Editor : Touch.pm

package File::Touch;
$File::Touch::VERSION = '0.12';
use 5.006;
use warnings;
use strict;

require Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(touch);

use Carp;
use IO::File;
use File::stat;
use Fcntl;

BEGIN {
    eval {
        require Time::HiRes;
        Time::HiRes->import(qw/ time utime /);
    };
    if (not $@) {
        Time::HiRes->VERSION(1.9764);
    }
}

my $SYSOPEN_MODE = O_WRONLY|O_CREAT;
eval {
    $SYSOPEN_MODE |= O_NONBLOCK;
};
if($@) {
    # OK, we don't have O_NONBLOCK:
    # probably running on Windows.
}
eval {
    $SYSOPEN_MODE |= O_NOCTTY;
};
if($@) {
    # OK, we don't have O_NOCTTY:
    # probably running on Windows.
}

sub new
{
    my ($caller, %arg) = @_;
    my $caller_is_obj = ref($caller);
    my $class = $caller_is_obj || $caller;
    my $self = bless{}, $class;

my $atime_only  = $arg{atime_only} || 0; # If nonzero, change only the access time.
    my $mtime_only  = $arg{mtime_only} || 0; # If nonzero, change only the modification time.
    my $no_create   = $arg{no_create}  || 0; # If nonzero, don't create if not already there.
    my $reference   = $arg{reference};       # If defined, use this file's times instead of current time.
    my $time        = $arg{time};            # If defined, use this time instead of current time.
    my $atime       = $arg{atime};           # If defined, use this time for access time instead of current time.
    my $mtime       = $arg{mtime};           # If defined, use this time for modification time instead of current time.

if ($atime_only && $mtime_only){
        croak("Incorrect usage: 'atime_only' and 'mtime_only' are both set - they are mutually exclusive.");
    }

if (defined $time) {
        if ((defined $atime) || (defined $mtime)) {
            croak("Incorrect usage: 'time' should not be used with either ",
                  "'atime' or 'mtime' - ambiguous.");
        }
        $atime = $time unless $mtime_only;
        $mtime = $time unless $atime_only;
    }

if (defined $reference) {
        if ((defined $time) || (defined $atime) || (defined $mtime)) {
            croak("Incorrect usage: 'reference' should not be used with 'time', 'atime' or 'mtime' - ambiguous.");
        }
        if (-e $reference) {
            my $sb = stat($reference) or croak("Could not stat ($reference): $!");
            $atime = $sb->atime unless $mtime_only;
            $mtime = $sb->mtime unless $atime_only;
        }
        else {
            croak("Reference file ($reference) does not exist");
        }
    }

$self->{_atime}      = $atime;
    $self->{_mtime}      = $mtime;
    $self->{_no_create}  = $no_create;
    $self->{_atime_only} = $atime_only;
    $self->{_mtime_only} = $mtime_only;

return $self;
}

sub touch
{
    my ($caller, @files) = @_;
    my $caller_is_obj = ref($caller);
    my $self;

if ($caller_is_obj){
        $self = $caller;
    }
    else {
        unshift @files, $caller;
        $self->{_atime}      = undef;
        $self->{_mtime}      = undef;
        $self->{_no_create}  = 0;
        $self->{_atime_only} = 0;
        $self->{_mtime_only} = 0;
    }

my $count = 0;

foreach my $file (@files) {
        my $time = time();
        my ($atime,$mtime);
        
        if (-e $file) {
            my $sb = stat($file) or croak("Could not stat ($file): $!");
            $atime = $sb->atime;
            $mtime = $sb->mtime;
        }
        else {
            unless ($self->{_no_create}) {
                sysopen my $fh,$file,$SYSOPEN_MODE or croak("Can't create $file : $!");
                close $fh or croak("Can't close $file : $!");
                $atime = $time;
                $mtime = $time;
            }
        }
        unless ($self->{_mtime_only}) {
            $atime = $time;
            $atime = $self->{_atime} if (defined $self->{_atime});
        }
        unless ($self->{_atime_only}) {
            $mtime = $time;
            $mtime = $self->{_mtime} if (defined $self->{_mtime});
        }
        if (utime($atime,$mtime,$file)) {
            $count++;
        }
    }
    return $count;
}

__END__

=head1 NAME

File::Touch - update file access and modification times, optionally creating files if needed

=head1 SYNOPSIS

use File::Touch 0.12;
 @file_list = ('one.txt','../two.doc');
 $count = touch(@file_list);

use File::Touch;
 $reference_file = '/etc/passwd';
 $touch_obj = File::Touch->new(
                  reference => $reference_file,
                  no_create => 1
              );
 @file_list = ('one.txt','../two.doc');
 $count     = $touch_obj->touch(@file_list);

=head1 DESCRIPTION

This module provides both a functional and OO interface
for changing the file access and modification times on files.
It can optionally create the file for you, if it doesn't exist.

B<Note>: you should specify a minimum version of 0.12,
as per the SYNOPSIS, as that fixed an issue that affected
systems that have sub-second granularity on those file times.

Here's a list of arguments that can be used with the
object-oriented contruction:

=over 4

=item atime_only => [0|1]

If nonzero, change only the access time of files. Default is zero.

=item mtime_only => [0|1]

If nonzero, change only the modification time of files. Default is zero.

=item no_create => [0|1]

If nonzero, do not create new files. Default is zero.

=item reference => $reference_file

If defined, use timestamps from this file instead of current time.
The timestamps are read from the reference file when the object is created,
not when C<<->touch>> is invoked.
Default is undefined.

=item time => $time

If defined,
then this value will be used for both access time and modification time,
whichever of those are set.
This time is overridden by the C<atime> and C<mtime> arguments,
if you use them.

=item atime => $time

If defined,
use this time (in epoch seconds) instead of current time for access time.

=item mtime => $time

If defined,
use this time (in epoch seconds) instead of current time for modification time.

=back

=head1 Examples

=head2 Update access and modification times, creating nonexistent files

use File::Touch;
 my @files = ('one','two','three');
 my $count = touch(@files);
 print "$count files updated\n";

=head2 Set access time forward, leave modification time unchanged

use File::Touch;
 my @files = ('one','two','three');
 my $day = 24*60*60;
 my $time = time() + 30 * $day;
 my $ref = File::Touch->new( atime_only => 1, time => $time );
 my $count = $ref->touch(@files);
 print "$count files updated\n";

=head2 Set modification time back, update access time, do not create nonexistent files

use File::Touch;
 my @files = ('one','two','three');
 my $day = 24*60*60;
 my $time = time() - 30 * $day;
 my $ref = File::Touch->new( mtime => $time, no_create => 1 );
 my $count = $ref->touch(@files);
 print "$count files updated\n";

=head2 Make a change to a file, keeping its timestamps unchanged

use File::Touch;
 my $date_restorer = File::Touch->new(reference => $file);
 # Update the contents of $file here.
 $date_restorer->touch($file);

=head1 REPOSITORY

L<https://github.com/neilb/File-Touch>

=head1 AUTHOR

Nigel Wetters Gourlay (nwetters@cpan.org)

=head1 COPYRIGHT

${this.title}

Code Editor : Touch.pm