news.utdallas.edu!wupost!darwin.sura.net!aplcen.apl.jhu.edu!netnews!uunet!ascent!ascent!paul Wed Mar  3 13:17:34 CST 1993
Article: 1342 of comp.lang.perl
Xref: feenix.metronet.com comp.lang.perl:1342
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!wupost!darwin.sura.net!aplcen.apl.jhu.edu!netnews!uunet!ascent!ascent!paul
From: paul@ascent.com (Paul Foley)
#Subject: strftime
Message-ID: <PAUL.93Mar2153031@MountRushmore.ascent.com>
Date: 2 Mar 93 15:30:31
Organization: Ascent Technology, Inc., Cambridge Massachusetts
Lines: 127


Here is a replacement of 'ctime.pl' which adds &asctime() and
&strftime().

strftime() turned out to be very easy to implement although for
symmetry I would have liked:
	local($%) = '%';
to work---it doesn't.  But for that it'd be (practically) a one-liner ...

;#
;# ptime.pl
;# 
;# Perl functions matching those of time.h
;# Package cannot be called 'time' because of builtin with that name
;#
;# Usage:
;#
;#      require 'ptime.pl';
;#	$date = &ctime(time);
;#	$date = &asctime(time);
;#	$date = &strftime(template, <t>);	# <t> is a structure as returned by gmtime or localtime
;#
;# paul@BaldyPeak	Tuesday February 23, 1993
;# Parts stolen from ctime.pl

#require 'time.ph';		# not essential unless we need CLOCKS_PER_SEC

package ptime;

CONFIG: {
  @DoW = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
  @DayOfWeek = ('Sunday','Monday','Tuesday','Wednesday',
		'Thursday','Friday','Saturday');
  @MoY = ('Jan','Feb','Mar','Apr','May','Jun',
	  'Jul','Aug','Sep','Oct','Nov','Dec');
  @MonthOfYear = ('January','February','March','April','May','June',
		  'July','August','September','October','November','December');
  
  # Determine what time zone is in effect.
  # Use GMT if TZ is defined as null, local time if TZ undefined.
  # There's no portable way to find the system default timezone.
  $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : '';
  
  # Hack to deal with 'PST8PDT' format of TZ
  # Note that this can't deal with all the esoteric forms, but it
  # does recognize the most common: [:]STDoff[DST[off][,rule]]
  
  if($TZ=~/^([^:\d+\-,]{3,})([+-]?\d{1,2}(:\d{1,2}){0,2})([^\d+\-,]{3,})?/){
    $TZ = $isdst ? $4 : $1;
  }
}

sub asctime {
  local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, $TZname) = @_;
  $year += ($year < 70) ? 2000 : 1900;
  $TZname .= ' ' if $TZname;
  sprintf("%s %s %2d %2d:%02d:%02d %s%4d\n",
	  $DoW[$wday], $MoY[$mon], $mday, $hour, $min, $sec, $TZname, $year);
}

sub wkyr {
  local($wstart, $wday, $yday) = @_;
  $wday = ($wday + 7 - $wstart) % 7;
  return int(($yday - $wday + 12) / 7 - 1);
}

# =====
# ctime($time)

sub main'ctime {
  local($time) = @_;
  &asctime(($TZ eq 'GMT') ? gmtime($time) : localtime($time), $TZ);
}

# =====
# asctime($time)

sub main'asctime {
  local($time) = @_;
  &asctime(gmtime($time), 'GMT');
}

# =====
# strftime($template, @time_struct)
#
# Does not support locales

sub main'strftime {			
  local($template, $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = @_;
  
  local($a) = $DoW[$wday];					# the abbreviated weekday name
  local($A) = $DayOfWeek[$wday]; 				# the full weekday name
  local($b) = $MoY[$mon];					# the abbreviated month name
  local($B) = $MonthOfYear[$mon]; 				# the full month name
  # date
  local($c) = &ptime'asctime($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst, '');
  local($d) = $mday;						# day of month
  local($H) = sprintf("%2d", $hour);  $H =~ y/ /0/; 		# hour of 24hr clock
  local($I) = sprintf("%2d", $hour % 12);  $I =~ y/ /0/;	# hour of 12hr clock
  	      $I = 12 if $I == 0;
  local($j) = sprintf("%3d", $yday);  $j =~ y/ /0/; 		# day of year
  local($m) = $mon + 1;						# month number
  local($M) = sprintf("%2d", $min);  $M =~ y/ /0/; 		# minutes after hour
  local($p) = $hour > 11 ? "PM" : "AM";				# AM/PM indicator
  local($S) = sprintf("%2d", $sec);  $S =~ y/ /0/; 		# seconds after minute
  local($U) = &ptime'wkyr(0, $wday, $yday);			# Sunday of year
  local($w) = $wday;						# day of week (Sun == 0)
  local($W) = &ptime'wkyr(1, $wday, $yday);			# Monday of year
  local($y) = $year % 100;					# year since century
  local($Y) = $y + (($y < 70) ? 2000 : 1900); 			# year
  local($Z) = $TZ;						# machine's timezone
  local($x) = "$b $d $Y";					# date
  local($X) = "$H:$M:$S";					# time
  
  $template =~ s/%%/\200/g;	# hide '%%'
  # replace each control sequence with value of corresponding variable name
  $template =~ s/%([aAbBcdHIjmMpSUwWxXyYZ])/"\$$1"/eeg;
  $template =~ s/\200/%/g;	# restore '%%' as single '%'
  return $template;
}

1;

--
Paul Foley	                        Ascent Technology Inc.
Development Engineer	                64 Sidney St. Cambridge, MA 02139
paul@ascent.com	                        (617) 225-0850 x315