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):
+