mmuegel

早期freebsd实现

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
# dsuf - add `st', `nd', `rd', `th' to a date (ie 1st, 22nd, 29th)
sub dsuf {
X	local ($mday) = @_;
X
X	return $mday . 'st' if ($mday =~ m/.*1$/);
X	return $mday . 'nd' if ($mday =~ m/.*2$/);
X	return $mday . 'rd' if ($mday =~ m/.*3$/);
X	return $mday . 'th';
}
X	
# weekno - figure out week number
sub wkno {
X	local ($year, $yday, $firstweekday) = @_;   
X	local ($jan1, @jan1, $wks);
X
X	# figure out the `time' value for January 1 of the given year
X	$jan1 = &maketime ($TZ, 0, 0, 0, 1, 0, $year-1900);
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, padded with $p (0 or ' ')
sub ampmH { local ($h, $p) = @_;  &pad($h>12 ? $h-12 : ($h ? $h : 12), 2, $p); }
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
# maketime - make a time via time{local,gmt}
sub maketime { ((shift @_) eq 'GMT') ? &main'timegm(@_) : &main'timelocal(@_); }
X
# ls - generate the time/year portion of an ls(1) style date
sub ls {
X	return ((&gettime ($TZ, time))[5] == @_[0]) ? "%R" : " %Y";
}
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 libs/date.pl ||
echo 'restore of libs/date.pl failed'
Wc_c="`wc -c < 'libs/date.pl'`"
test 12339 -eq "$Wc_c" ||
	echo 'libs/date.pl: original size 12339, current size' "$Wc_c"
fi
# ============= libs/elapsed.pl ==============
if test -f 'libs/elapsed.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping libs/elapsed.pl (File already exists)'
else
echo 'x - extracting libs/elapsed.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'libs/elapsed.pl' &&
;# NAME
;#    elapsed.pl - convert seconds to elapsed time format
;#
;# AUTHOR
;#    Michael S. Muegel <[e-mail]>
;#
;# RCS INFORMATION
;#    mmuegel
;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/elapsed.pl,v
;#    1.1 of 1993/07/28 08:07:19
X
package elapsed;
X
# Time field types
$DAYS		= 1;
$HOURS		= 2;
$MINUTES	= 3;
$SECONDS	= 4;
X
# The array contains four records each with four fields. The fields are,
# in order:
#
#    Type		Specifies what kind of time field this is. Once of
#			$DAYS, $HOURS, $MINUTES, or $SECONDS.
#
#    Multiplier		Specifies what time field this is via the minimum
#			number of seconds this time field may specify. For
#			example, the minutes field would be non-zero
#			when there are 60 or more seconds.
#			
#    Separator		How to separate this time field from the next
#			*greater* field.
#
#    Format		sprintf() format specifier on how to print this
#			time field.
@MULT_AND_SEPS = ($DAYS, 60 * 60 * 24, "+", "%d",
X                  $HOURS, 60 * 60, ":", "%d",
X                  $MINUTES, 60, ":", "%02d",
X                  $SECONDS, 1, "", "%02d"
X                 );
X
;###############################################################################
;# Seconds_To_Elapsed
;#
;# Coverts a seconds count to form [d+]h:mm:ss. If $Collapse
;# is true then the result is compacted somewhat. The string returned
;# will be of the form [d+][[h:]mm]:ss.
;#
;# Arguments:
;#    $Seconds, $Collapse
;#
;# Examples:
;#    &Seconds_To_Elapsed (0, 0) 	-> 0:00:00
;#    &Seconds_To_Elapsed (0, 1) 	-> :00
;#
;#    &Seconds_To_Elapsed (119, 0) 	-> 0:01:59
;#    &Seconds_To_Elapsed (119, 1) 	-> 01:59
;#
;#    &Seconds_To_Elapsed (3601, 0) 	-> 1:00:01
;#    &Seconds_To_Elapsed (3601, 1) 	-> 1:00:01
;#
;#    &Seconds_To_Elapsed (86401, 0) 	-> 1+0:00:01
;#    &Seconds_To_Elapsed (86401, 1) 	-> 1+:01
;#
;# Returns:
;#    $Elapsed
;###############################################################################
sub main'Seconds_To_Elapsed
{
X   local ($Seconds, $Collapse) = @_;
X   local ($Type, $Multiplier, @Multipliers, $Separator, $DHMS_Used, 
X          $Elapsed, @Mult_And_Seps, $Print_Field);
X
X   $Multiplier = 1;
X   @Mult_And_Seps = @MULT_AND_SEPS;
X
X   # Keep subtracting the number of seconds corresponding to a time field
X   # from the number of seconds passed to the function.
X   while (1)
X   {
X      ($Type, $Multiplier, $Separator, $Format) = splice (@Mult_And_Seps, 0, 4);
X      last if (! $Multiplier);
X      $Seconds -= $DHMS_Used * $Multiplier 
X         if ($DHMS_Used = int ($Seconds / $Multiplier));
X
X      # Figure out if we should print this field
X      if ($Type == $DAYS)
X      {
X	 $Print_Field = $DHMS_Used;
X      }
X
X      elsif ($Collapse)
X      {
X	 if ($Type == $HOURS)
X	 {
X	    $Print_Field = $DHMS_Used;
X	 }
X	 elsif ($Type == $MINUTES)
X	 {
X	    $Print_Field = $DHMS_Used || $Printed_Field {$HOURS};
X	 }
X	 else
X	 {
X	    $Format = ":%02d" 
X	       if (! $Printed_Field {$MINUTES});
X	    $Print_Field = 1;
X	 };
X      }
X
X      else
X      {
X	 $Print_Field = 1;
X      };
X
X      $Printed_Field {$Type} = $Print_Field;
X      $Elapsed .= sprintf ("$Format%s", $DHMS_Used, $Separator) 
X	 if ($Print_Field);
X   };
X
X   return ($Elapsed);
};
X
1;
SHAR_EOF
chmod 0444 libs/elapsed.pl ||
echo 'restore of libs/elapsed.pl failed'
Wc_c="`wc -c < 'libs/elapsed.pl'`"
test 3198 -eq "$Wc_c" ||
	echo 'libs/elapsed.pl: original size 3198, current size' "$Wc_c"
fi
# ============= libs/mail.pl ==============
if test -f 'libs/mail.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping libs/mail.pl (File already exists)'
else
echo 'x - extracting libs/mail.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'libs/mail.pl' &&
;# NAME
;#    mail.pl - perl function(s) to handle mail processing
;#
;# AUTHOR
;#    Michael S. Muegel ([e-mail])
;#
;# RCS INFORMATION
;#    mmuegel
;#    /usr/local/ustart/src/mail-tools/dist/foo/libs/mail.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp
X
package mail;
X
# Mailer statement to eval. $Users, $Subject, and $Verbose are substituted 
# via eval
$BIN_MAILER 		= "/usr/ucb/mail \$Verbose -s '\$Subject' \$Users";
X
# Sendmail command to use when $Use_Sendmail is true.
$SENDMAIL		= '/usr/lib/sendmail $Verbose $Users';
X
;###############################################################################
;# Send_Mail
;#
;# Sends $Message to $Users with a subject of $Subject. If $Message_Is_File
;# is true then $Message is assumed to be a filename pointing to the mail
;# message. This is a new option and thus the backwards-compatible hack.
;# $Users should be a space separated list of mail-ids.
;#
;# If everything went OK $Status will be 1 and $Error_Msg can be ignored; 
;# otherwise, $Status will be 0 and $Error_Msg will contain an error message.
;# 
;# If $Use_Sendmail is 1 then sendmail is used to send the message. Normally
;# a mailer such as Mail is used. By specifiying this you can include 
;# headers in addition to text in either $Message or $Message_Is_File.
;# If either $Message or $Message_Is_File contain a Subject: header then
;# $Subject is ignored; otherwise, a Subject: header is automatically created.
;# Similar to the Subject: header, if a To: header does not exist one
;# is automatically created from the $Users argument. The mail is still
;# sent, however, to the recipients listed in $Users. This is keeping with
;# normal sendmail usage (header vs. envelope).
;# 
;# In both bin mailer and sendmail modes $Verbose will turn on verbose mode
;# (normally just sendmail verbose mode output).
;#
;# Arguments:
;#    $Users, $Subject, $Message, $Message_Is_File, $Verbose, $Use_Sendmail
;#
;# Returns:
;#    $Status, $Error_Msg
;###############################################################################
sub main'Send_Mail
{
X   local ($Users, $Subject, $Message, $Message_Is_File, $Verbose, 
X	  $Use_Sendmail) = @_;
X   local ($BIN_MAILER_HANDLE, $Mailer_Command, $Header_Found, %Header_Map,
X	  $Header_Extra, $Mailer);
X
X   # If the message is contained in a file read it in so we can have one
X   # consistent interface
X   if ($Message_Is_File)
X   {
X      undef $/;
X      $Message_Is_File = 0;
X      open (Message) || return (0, "error reading $Message: $!");
X      $Message = <Message>;
X      close (Message);
X   };
X
X   # If sendmail mode see if we need to add some headers
X   if ($Use_Sendmail)
X   {
X      # Determine if a header block is included in the message and what headers
X      # are there
X      foreach (split (/\n/, $Message))
X      {
X	 last if ($_ eq "");
X	 $Header_Found = $Header_Map {$1} = 1 if (/^([A-Z]\S*): /);
X      };
X
X      # Add some headers?
X      if (! $Header_Map {"To"})
X      {
X	 $Header_Extra .= "To: " . join (", ", $Users) . "\n";
X      };
X      if (($Subject ne "") && (! $Header_Map {"Subject"}))
X      {
X	 $Header_Extra .= "Subject: $Subject\n";
X      };
X
X      # Add the required blank line between header/body if there where no
X      # headers to begin with
X      if ($Header_Found)
X      {
X         $Message = "$Header_Extra$Message";
X      }
X      else
X      {
X	 $Message = "$Header_Extra\n$Message";
X      };
X   };
X
X   # Get a string that is the mail command
X   $Verbose = ($Verbose) ? "-v" : "";
X   $Mailer = ($Use_Sendmail) ? $SENDMAIL : $BIN_MAILER;
X   eval "\$Mailer = \"$Mailer\"";
X   return (0, "error setting \$Mailer: $@") if ($@);
X
X   # need to catch SIGPIPE in case the $Mailer call fails
X   $SIG {'PIPE'} = "mail'Cleanup";
X
X   # Open mailer
X   return (0, "can not open mail program: $Mailer") if (! open (MAILER, "| $Mailer"));
X   
X   # Send off the mail!
X   print MAILER $Message;
X   close (MAILER);
X   return (0, "error running mail program: $Mailer") if ($?);
X   
X   # Everything must have went AOK
X   return (1);
};
X
;###############################################################################
;# Cleanup
;#
;# Simply here so we can catch SIGPIPE and not exit.
;#
;# Globals:
;#    None
;#
;# Arguments:
;#    None
;#
;# Returns:
;#    Nothing exciting
;###############################################################################
sub Cleanup
{
};
X
1;
SHAR_EOF
chmod 0444 libs/mail.pl ||
echo 'restore of libs/mail.pl failed'
Wc_c="`wc -c < 'libs/mail.pl'`"
test 4356 -eq "$Wc_c" ||
	echo 'libs/mail.pl: original size 4356, current size' "$Wc_c"
fi
# ============= libs/mqueue.pl ==============
if test -f 'libs/mqueue.pl' -a X"$1" != X"-c"; then
	echo 'x - skipping libs/mqueue.pl (File already exists)'
else
echo 'x - extracting libs/mqueue.pl (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'libs/mqueue.pl' &&
;# NAME