From: mmuegel@next3.corp.mot.com (Michael S. Muegel)
Subject: Re: SUMMARY: File age - how?
Organization: Corporate Information Office, Schaumburg, Illinois, Motorola, Inc.
Date: Tue, 15 Dec 1992 23:29:29 GMT

Previously, rick@ssg.com wrote:
> Sorry for the wasted bandwidth.  Instead of trying to get -M or -C to do the
> job, I should have looked at stat().  [9] of stat()'s results fed to
> ctime.pl works like a champ.  I hacked a version of ctime.pl to return only
> the date and not the time but that's a minor item just for this application.  

Or use Terry McGonigal's neat dat.pl package. Hope I have the latest:

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is a shell archive (produced by shar 3.49)
# To extract the files from this archive, save it to a file, remove
# everything above the "!/bin/sh" line above, and type "sh file_name".
#
# made 12/15/1992 23:30 UTC by mmuegel@mot.com (Michael S. Muegel)
# Source directory /home/ustart/NeXT/contrib/lib/perl
#
# existing files will NOT be overwritten unless -c is specified
#
# This shar contains:
# length  mode       name
# ------ ---------- ------------------------------------------
#   8535 -r--r--r-- date.pl
#
# ============= date.pl ==============
if test -f 'date.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping date.pl (File already exists)'
else
echo 'x - extracting date.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'date.pl' &&
;#
;# Name
;#	date.pl - Perl emulation of (the output side of) date(1)
;#
;# Synopsis
;#	requirelude "date.pl";
;#	$Date = &date(time);
;#	$Date = &date(time, $format);
;#
;# Description
;#	This package implements the output formatting functions of date(1) in
;#	Perl.  The format options are based on those supported by Ultrix 4.0
;#	plus a couple of additions:
;#
;#		%a		abbreviated weekday name - Sun to Sat
;#		%A		full weekday name - Sunday to Saturday
;#		%b		abbreviated month name - Jan to Dec
;#		%B		full month name - January to December
;#		%c		date and time in local format [+]
;#		%d		day of month - 01 to 31
;#		%D		date as mm/dd/yy
;#		%e		day of month (space padded) - ` 1' to `31'
;#		%h		abbreviated month name - Jan to Dec
;#		%H		hour - 00 to 23
;#		%I		hour - 01 to 12
;#		%j		day of the year (Julian date) - 001 to 366
;#		%m		month of year - 01 to 12
;#		%M		minute - 00 to 59
;#		%n		insert a newline character
;#		%p		AM or PM
;#		%r		time in AM/PM notation
;#		%R		time as HH:MM
;#		%S		second - 00 to 59
;#		%t		insert a tab character
;#		%T		time as HH:MM:SS
;#		%U		week number, Sunday as first day of week - 00 to 53
;#		%w		day of week - 0 (Sunday) to 6
;#		%W		week number, Monday as first day of week - 00 to 53
;#		%x		date in local format [+]
;#		%X		time in local format [+]
;#		%y		last 2 digits of year - 00 to 99
;#		%Y		all 4 digits of year ~ 1700 to 2000 odd ?
;#		%z		time zone from TZ environment variable w/ a trailing space [*]
;#		%Z		time zone from TZ environment variable
;#		%%		insert a `%' character
;#		%+		insert a `+' character [*]
;#
;#	[*]:  Not supported by date(1) but I wanted 'em.
;#	[+]:  These may need adjustment to fit local conventions, see below.
;#
;#	For the sake of compatibility, a leading `+' in the format
;#	specificaiton is removed if present.
;#
;# Remarks
;#	An extension of `ctime.pl' by Waldemar Kebsch (kebsch.pad@nixpbe.UUCP),
;#	as modified by Marion Hakanson (hakanson@ogicse.ogi.edu).
;#
;#  Unlike date(1), unknown format tags are silently replaced by "".
;#
;#  defaultTZ is a blatant hack, but I wanted to be able to get date(1)
;#	like behaviour by default and there does'nt seem to be an easy (read
;#	portable) way to get the local TZ name back...
;#
;#	For a cheap date, try...
;#
;#		#!/usr/local/bin/perl
;#		require "date.pl";
;#		exit print (&date(time, shift @ARGV) . "\n") ? 0 : 1;
;#
;#	This package is redistributable under the same terms as apply to
;#	the Perl 3.0 release.  See the COPYING file in your Perl kit for
;#	more information.
;#
;#	Please send any bug reports or comments to tmcgonigal@gvc.com
;#
;# Modification History
;#	Nmemonic	Version	Date		Who
;#
;#	NONE		none	02feb91		Terry McGonigal (tmcgonigal@gvc.com)
;#		Created from ctime.pl
;#
;#	NONE		none	07feb91		tmcgonigal
;#		Added some of Marion Hakanson (hakanson@ogicse.ogi.edu)'s ctime.pl
;#		TZ handling changes.
;#
;#	NONE		none	09feb91		tmcgonigal
;#		Corrected week number calculations.
;#
;# SccsId = "%W% %E%"
;#
package date;
X
# Months of the year
@MoY = ('January',	'Febuary',	'March',	'April',	'May',		'June',
X		'July',		'August',	'September','October',	'November', 'December');
X
# days of the week
@DoW = ('Sunday',	'Monday',	'Tuesday',	'Wednesday',
X		'Thursday',	'Friday',	'Saturday');
X
# defaults
$defaultTZ = 'EST';					# time zone (hack!)
$defaultFMT = '%a %h %e %T %z%Y';	# format (ala date(1))
X
# `local' formats
$locTF = '%T';						# time (as HH:MM:SS)
$locDF = '%D';						# date (as mm/dd/yy)
$locDTF = '%a %b %d %T %Y';			# date/time (as dow mon dd HH:MM:SS yyy)
X
# Time zone info
$TZ;								# wkno needs this info too
X
# define the known format tags as associative keys with their associated
# replacement strings as values.  Each replacement string should be
# an eval-able expresion assigning a value to $rep.  These expressions are
# eval-ed, then the value of $rep is substituted into the supplied
# format (if any).
%Tags = ( '%a', '($rep = $DoW[$wday])=~ s/^(...).*/\1/',# abbr. weekday name - Sun to Sat
X		  '%A', '$rep = $DoW[$wday]',					# full weekday name - Sunday to Saturday
X		  '%b', '($rep = $MoY[$mon]) =~ s/^(...).*/\1/',# abbr. month name - Jan to Dec
X		  '%B', '$rep = $MoY[$mon]',					# full month name - January to December
X		  '%c', '$rep = $locDTF; 1',					# date/time in local format
X		  '%d',	'$rep = &date\'pad($mday, 2, "0")',		# day of month - 01 to 31
X		  '%D',	'$rep = \'%m/%d/%y\'',					# date as mm/dd/yy
X		  '%e', '$rep = &date\'pad($mday, 2, " ")',		# day of month (space padded) ` 1' to `31'
X		  '%h', '$rep = \'%b\'',						# abbr. month name (same as %b)
X		  '%H',	'$rep = &date\'pad($hour, 2, "0")',		# hour - 00 to 23
X		  '%I', '$rep = &date\'ampmH($hour)',			# hour - 01 to 12
X		  '%j', '$rep = &date\'pad($yday+1, 3, "0")',	# Julian date 001 - 366
X		  '%m',	'$rep = &date\'pad($mon+1, 2, "0")',	# month of year - 01 to 12
X		  '%M', '$rep = &date\'pad($min, 2, "0")',		# minute - 00 to 59
X		  '%n',	'$rep = "\n"',							# insert a newline
X		  '%p', '$rep = &date\'ampmD($hour)',			# insert `AM' or `PM'
X		  '%r', '$rep = \'%I:%M:%S %p\'',				# time in AM/PM notation
X		  '%R', '$rep = \'%H:%M\'',						# time as HH:MM
X		  '%S', '$rep = &date\'pad($sec, 2, "0")',		# second - 00 to 59
X		  '%t',	'$rep = "\t"',							# insert a tab
X		  '%T',	'$rep = \'%H:%M:%S\'',					# time as HH:MM:SS
X		  '%U',	'$rep = &date\'wkno($yday, 0)',			# week number (weeks start on Sun) - 00 to 53
X		  '%w', '$rep = $wday; 1',						# day of week - Sunday = 0
X		  '%W', '$rep = &date\'wkno($yday, 1)',			# week number (weeks start on Mon) - 00 to 53
X		  '%x', '$rep = $locDF; 1',						# date in local format
X		  '%X', '$rep = $locTF; 1',						# time in local format
X		  '%y', '($rep = "$year") =~ s/..(..)/\1/',		# last 2 digits of year - 00 to 99
X		  '%Y', '$rep = "$year"',						# full year ~ 1700 to 2000 odd
X		  '%z', '$rep = $TZ eq "" ? "" : "$TZ "',		# time zone from TZ env var (w/trail. space)
X		  '%Z', '$rep = $TZ; 1',						# time zone from TZ env. var.
X		  '%%', '$rep = \'%\'; $adv=1',					# insert a `%'
X		  '%+', '$rep = \'+\''							# insert a `+'
);
X	
sub main'date {
X	local($time, $format) = @_;
X	local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst);
X	local($pos, $tag, $rep, $adv) = (0, "", "", 0);
X
X
X	# default to date/ctime format or strip leading `+'...
X	if ($format eq "") {
X		$format = $defaultFMT;
X	} elsif ($format =~ /^\+/) {
X		$format = $';
X	}
X
X	# Use local time if can't find a TZ in the environment
X	$TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ;
X	($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = 
X		&gettime ($TZ, $time);
X
X	# Hack to deal with 'PST8PDT' format of TZ
X	# Note that this can't deal with all the esoteric forms, but it
X	# does recognize the most common: [:]STDoff[DST[off][,rule]]
X	if ($TZ =~ /^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/) {
X		$TZ = $isdst ? $4 : $1;
X	}
X
X	# watch out in 2070...
X	$year += ($year < 70) ? 2000 : 1900;
X
X	# now loop throught the supplied format looking for tags...
X	while (($pos = index ($format, '%')) != -1) {
X
X		# grab the format tag
X		$tag = substr($format, $pos, 2);
X		$adv = 0;							# for `%%' processing
X
X		# do we have a replacement string?
X		if (defined $Tags{$tag}) {
X
X			# trap dead evals...
X			if (! eval $Tags{$tag}) {
X				print STDERR "date.pl: internal error: eval for $tag failed.\n";
X				return "";
X			}
X		} else {
X			$rep = "";
X		}
X			
X		# do the substitution
X		substr ($format, $pos, 2) =~ s/$tag/$rep/;
X		$pos++ if ($adv);
X	}
X
X	$format;
}
X
# weekno - figure out week number
sub wkno {
X	local ($yday, $firstweekday) = @_;   
X	local ($jan1, @jan1, $wks);
X	local ($now) = time;
X
X	# figure out the `time' value for January 1
X	$jan1 = $now - ((&gettime ($TZ, $now))[7] * 86400);		# 86400 sec/day
X
X	# figure out what day of the week January 1 was
X	@jan1= &gettime ($TZ, $jan1);
X	
X	# and calculate the week number
X	$wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7;
X	$wks += (($wks - int($wks) > 0.0) ? 1 : 0);
X
X	# supply zero padding
X	&pad (int($wks), 2, "0");
}
X
# ampmH - figure out am/pm (1 - 12) mode hour value.
sub ampmH { local ($h) = @_;  &pad($h>12 ? $h-12 : $h, 2, "0"); }
X
# ampmD - figure out am/pm designator
sub ampmD { shift @_ > 12 ? "PM" : "AM"; }
X
# gettime - get the time via {local,gmt}time
sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); }
X
# pad - pad $in with leading $pad until lenght $len
sub pad {
X	local ($in, $len, $pad) = @_;
X	local ($out) = "$in";
X
X	$out = $pad . $out until (length ($out) == $len);
X	return $out;
}
X
1;
SHAR_EOF
chmod 0444 date.pl ||
echo 'restore of date.pl failed'
Wc_c="`wc -c < 'date.pl'`"
test 8535 -eq "$Wc_c" ||
	echo 'date.pl: original size 8535, current size' "$Wc_c"
fi
exit 0

-- 
+----------------------------------------------------------------------------+
| Michael S. Muegel                  | Internet:    mmuegel@mot.com          |
| UNIX Applications Startup Group    | Moto X.400:  X10090                   |
| Corporate Information Office       | Voice:       (708) 576-0507           |
| Motorola, Inc.                     | ... these are my opinions, honest ... |
+----------------------------------------------------------------------------+
Newsgroups: comp.lang.perl