r81 - in packages: . libfile-touch-perl libfile-touch-perl/branches libfile-touch-perl/branches/upstream libfile-touch-perl/branches/upstream/current
Allard Hoeve
hoeve-guest@haydn.debian.org
Thu, 10 Jun 2004 07:43:37 -0600
Author: hoeve-guest
Date: 2004-06-10 07:43:34 -0600 (Thu, 10 Jun 2004)
New Revision: 81
Added:
packages/libfile-touch-perl/
packages/libfile-touch-perl/branches/
packages/libfile-touch-perl/branches/upstream/
packages/libfile-touch-perl/branches/upstream/current/
packages/libfile-touch-perl/branches/upstream/current/Changes
packages/libfile-touch-perl/branches/upstream/current/MANIFEST
packages/libfile-touch-perl/branches/upstream/current/Makefile.PL
packages/libfile-touch-perl/branches/upstream/current/Touch.pm
packages/libfile-touch-perl/branches/upstream/current/test.pl
packages/libfile-touch-perl/tags/
Log:
[svn-inject] Installing original source of libfile-touch-perl
Added: packages/libfile-touch-perl/branches/upstream/current/Changes
===================================================================
--- packages/libfile-touch-perl/branches/upstream/current/Changes 2004-06-10 13:42:44 UTC (rev 80)
+++ packages/libfile-touch-perl/branches/upstream/current/Changes 2004-06-10 13:43:34 UTC (rev 81)
@@ -0,0 +1,5 @@
+Revision history for Perl extension File::Touch.
+
+0.01 Thu Jul 5 09:35:24 2001
+ - original version; created by Nigel Wetters
+
Added: packages/libfile-touch-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libfile-touch-perl/branches/upstream/current/MANIFEST 2004-06-10 13:42:44 UTC (rev 80)
+++ packages/libfile-touch-perl/branches/upstream/current/MANIFEST 2004-06-10 13:43:34 UTC (rev 81)
@@ -0,0 +1,5 @@
+Changes
+Makefile.PL
+MANIFEST
+test.pl
+Touch.pm
Added: packages/libfile-touch-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libfile-touch-perl/branches/upstream/current/Makefile.PL 2004-06-10 13:42:44 UTC (rev 80)
+++ packages/libfile-touch-perl/branches/upstream/current/Makefile.PL 2004-06-10 13:43:34 UTC (rev 81)
@@ -0,0 +1,7 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ 'NAME' => 'File::Touch',
+ 'VERSION_FROM' => 'Touch.pm', # finds $VERSION
+);
Added: packages/libfile-touch-perl/branches/upstream/current/Touch.pm
===================================================================
--- packages/libfile-touch-perl/branches/upstream/current/Touch.pm 2004-06-10 13:42:44 UTC (rev 80)
+++ packages/libfile-touch-perl/branches/upstream/current/Touch.pm 2004-06-10 13:43:34 UTC (rev 81)
@@ -0,0 +1,205 @@
+package File::Touch;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(touch);
+$VERSION = "0.01";
+
+use strict;
+
+use Carp;
+use IO::File;
+use File::stat;
+
+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(FH,$file,O_WRONLY|O_CREAT|O_NONBLOCK|O_NOCTTY) 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;
+}
+1;
+
+__END__
+
+=head1 NAME
+
+File::Touch - update access and modification timestamps, creating nonexistent files where necessary.
+
+=head1 SYNOPSIS
+
+ use File::Touch;
+ @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
+
+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. Default is undefined.
+
+=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";
+
+=head1 AUTHOR
+
+Nigel Wetters (nigel@wetters.net)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2001, Nigel Wetters. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as Perl itself.
+
Added: packages/libfile-touch-perl/branches/upstream/current/test.pl
===================================================================
--- packages/libfile-touch-perl/branches/upstream/current/test.pl 2004-06-10 13:42:44 UTC (rev 80)
+++ packages/libfile-touch-perl/branches/upstream/current/test.pl 2004-06-10 13:43:34 UTC (rev 81)
@@ -0,0 +1,20 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use File::Touch;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+