diff options
Diffstat (limited to 'mmuegel/libs')
| -rw-r--r-- | mmuegel/libs/date.pl | 324 | ||||
| -rw-r--r-- | mmuegel/libs/elapsed.pl | 123 | ||||
| -rw-r--r-- | mmuegel/libs/mail.pl | 140 | ||||
| -rw-r--r-- | mmuegel/libs/mqueue.pl | 215 | ||||
| -rw-r--r-- | mmuegel/libs/newgetopts.pl | 213 | ||||
| -rw-r--r-- | mmuegel/libs/strings1.pl | 147 | ||||
| -rw-r--r-- | mmuegel/libs/timespec.pl | 60 |
7 files changed, 1222 insertions, 0 deletions
diff --git a/mmuegel/libs/date.pl b/mmuegel/libs/date.pl new file mode 100644 index 0000000..6732438 --- /dev/null +++ b/mmuegel/libs/date.pl @@ -0,0 +1,324 @@ +;# +;# Name +;# date.pl - Perl emulation of (the output side of) date(1) +;# +;# Synopsis +;# require "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 from SunOS 4.1.1 and elsewhere: +;# +;# %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 [+] +;# %C date and time in long local format [+] +;# %d day of month - 01 to 31 +;# %D date as mm/dd/yy +;# %e day of month (space padded) - ` 1' to `31' +;# %E day of month (with suffix: 1st, 2nd, 3rd...) +;# %f month of year (space padded) - ` 1' to `12' +;# %h abbreviated month name - Jan to Dec +;# %H hour - 00 to 23 +;# %i hour (space padded) - ` 1' to `12' +;# %I hour - 01 to 12 +;# %j day of the year (Julian date) - 001 to 366 +;# %k hour (space padded) - ` 0' to `23' +;# %l date in ls(1) format +;# %m month of year - 01 to 12 +;# %M minute - 00 to 59 +;# %n insert a newline character +;# %p ante-meridiem or post-meridiem indicator (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 date/time in date(1) required format +;# %U week number, Sunday as first day of week - 00 to 53 +;# %V date-time in SysV touch format (mmddHHMMyy) +;# %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 +;# +;# [+]: 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 +;# This is version 3.4 of date.pl +;# +;# 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 4.0 release. See the COPYING file in your Perl kit for +;# more information. +;# +;# Please send any bug reports or comments to tmcgonigal@gallium.com +;# +;# Modification History +;# Nmemonic Version Date Who +;# +;# NONE 1.0 02feb91 Terry McGonigal (tmcgonigal@gallium.com) +;# Created from ctime.pl +;# +;# NONE 2.0 07feb91 tmcgonigal +;# Added some of Marion Hakanson (hakanson@ogicse.ogi.edu)'s ctime.pl +;# TZ handling changes. +;# +;# NONE 2.1 09feb91 tmcgonigal +;# Corrected week number calculations. +;# +;# NONE 2.2 21oct91 tmcgonigal +;# Added ls(1) date format, `%l'. +;# +;# NONE 2.3 06nov91 tmcgonigal +;# Added SysV touch(1) date-time format, `%V' (pretty thin as +;# mnemonics go, I know, but `t' and `T' were both gone already!) +;# +;# NONE 2.4 05jan92 tmcgonigal +;# Corrected slight (cosmetic) problem with %V replacment string +;# +;# NONE 3.0 09jul92 tmcgonigal +;# Fixed a couple of problems with &ls as pointed out by +;# Thomas Richter (richter@ki1.chemie.fu-berlin.de), thanks Thomas! +;# Also added a couple of SunOS 4.1.1 strftime-ish formats, %i and %k +;# for space padded hours (` 1' to `12' and ` 0' to `23' respectivly), +;# and %C for locale long date/time format. Changed &mH to take a +;# pad char parameter to make to evaled code for %i and %k simpler. +;# Added %E for suffixed day-of-month (ie 1st, 3rd, 4th etc). +;# +;# NONE 3.1 16jul92 tmcgonigal +;# Added `%u' format to generate date/time in date(1) required +;# format (ie '%y%m%d%H%M.%S'). +;# +;# NONE 3.2 23jan93 tmcgonigal +;# Added `%f' format to generate space padded month numbers, added +;# `%E' to the header comments, it seems to have been left out (and +;# I'm sure I wanted to use it at some point in the past...). +;# +;# NONE 3.3 03feb93 tmcgonigal +;# Corrected some problems with AM/PM handling pointed out by +;# Michael S. Muegel (mmuegel@mot.com). Thanks Michael, I hope +;# this is the behaviour you were looking for, it seems more +;# correct to me... +;# +;# NONE 3.4 26jul93 tmcgonigal +;# Incorporated some fixes provided by DaviD W. Sanderson +;# (dws@ssec.wisc.edu): February was spelled incorrectly and +;# &wkno() was always using the current year while calculating +;# week numbers, regardless of year implied by the time value +;# passed to &date(). DaviD also contributed an improved &date() +;# test script, thanks DaviD, I appreciate the effort. Finally, +;# changed my mailling address from @gvc.com to @gallium.com +;# to reflect, well, my new address! +;# +;# SccsId = "%W% %E%" +;# +require 'timelocal.pl'; +package date; + +# Months of the year +@MoY = ('January', 'February', 'March', 'April', 'May', 'June', + 'July', 'August', 'September','October', 'November', 'December'); + +# days of the week +@DoW = ('Sunday', 'Monday', 'Tuesday', 'Wednesday', + 'Thursday', 'Friday', 'Saturday'); + +# CUSTOMIZE - defaults +$defaultTZ = 'CST'; # time zone (hack!) +$defaultFMT = '%a %h %e %T %z%Y'; # format (ala date(1)) + +# CUSTOMIZE - `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 yyyy) +$locLDTF = '%i:%M:%S %p %A %B %E %Y'; # long date/time (as HH:MM:SS a/p day month dom yyyy) + +# Time zone info +$TZ; # wkno needs this info too + +# 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', q|($rep = $DoW[$wday])=~ s/^(...).*/\1/|, # abbr. weekday name - Sun to Sat + '%A', q|$rep = $DoW[$wday]|, # full weekday name - Sunday to Saturday + '%b', q|($rep = $MoY[$mon]) =~ s/^(...).*/\1/|, # abbr. month name - Jan to Dec + '%B', q|$rep = $MoY[$mon]|, # full month name - January to December + '%c', q|$rep = $locDTF; 1|, # date/time in local format + '%C', q|$rep = $locLDTF; 1|, # date/time in local long format + '%d', q|$rep = &date'pad($mday, 2, "0")|, # day of month - 01 to 31 + '%D', q|$rep = '%m/%d/%y'|, # date as mm/dd/yy + '%e', q|$rep = &date'pad($mday, 2, " ")|, # day of month (space padded) ` 1' to `31' + '%E', q|$rep = &date'dsuf($mday)|, # day of month (w/suffix) `1st' to `31st' + '%f', q|$rep = &date'pad($mon+1, 2, " ")|, # month of year (space padded) ` 1' to `12' + '%h', q|$rep = '%b'|, # abbr. month name (same as %b) + '%H', q|$rep = &date'pad($hour, 2, "0")|, # hour - 00 to 23 + '%i', q|$rep = &date'ampmH($hour, " ")|, # hour (space padded ` 1' to `12' + '%I', q|$rep = &date'ampmH($hour, "0")|, # hour - 01 to 12 + '%j', q|$rep = &date'pad($yday+1, 3, "0")|, # Julian date 001 - 366 + '%k', q|$rep = &date'pad($hour, 2, " ")|, # hour (space padded) ` 0' to `23' + '%l', q|$rep = '%b %d ' . &date'ls($year)|, # ls(1) style date + '%m', q|$rep = &date'pad($mon+1, 2, "0")|, # month of year - 01 to 12 + '%M', q|$rep = &date'pad($min, 2, "0")|, # minute - 00 to 59 + '%n', q|$rep = "\n"|, # insert a newline + '%p', q|$rep = &date'ampmD($hour)|, # insert `AM' or `PM' + '%r', q|$rep = '%I:%M:%S %p'|, # time in AM/PM notation + '%R', q|$rep = '%H:%M'|, # time as HH:MM + '%S', q|$rep = &date'pad($sec, 2, "0")|, # second - 00 to 59 + '%t', q|$rep = "\t"|, # insert a tab + '%T', q|$rep = '%H:%M:%S'|, # time as HH:MM:SS + '%u', q|$rep = '%y%m%d%H%M.%S'|, # daaate/time in date(1) required format + '%U', q|$rep = &date'wkno($year, $yday, 0)|, # week number (weeks start on Sun) - 00 to 53 + '%V', q|$rep = '%m%d%H%M%y'|, # SysV touch(1) date-time format (mmddHHMMyy) + '%w', q|$rep = $wday; 1|, # day of week - Sunday = 0 + '%W', q|$rep = &date'wkno($year, $yday, 1)|, # week number (weeks start on Mon) - 00 to 53 + '%x', q|$rep = $locDF; 1|, # date in local format + '%X', q|$rep = $locTF; 1|, # time in local format + '%y', q|($rep = $year) =~ s/..(..)/\1/|, # last 2 digits of year - 00 to 99 + '%Y', q|$rep = "$year"; 1|, # full year ~ 1700 to 2000 odd + '%z', q|$rep = $TZ eq "" ? "" : "$TZ "|, # time zone from TZ env var (w/trail. space) + '%Z', q|$rep = $TZ; 1|, # time zone from TZ env. var. + '%%', q|$rep = '%'; $adv=1|, # insert a `%' + '%+', q|$rep = '+'| # insert a `+' +); + +sub main'date { + local($time, $format) = @_; + local($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst); + local($pos, $tag, $rep, $adv) = (0, "", "", 0); + + # default to date/ctime format or strip leading `+'... + if ($format eq "") { + $format = $defaultFMT; + } elsif ($format =~ /^\+/) { + $format = $'; + } + + # Use local time if can't find a TZ in the environment + $TZ = defined($ENV{'TZ'}) ? $ENV{'TZ'} : $defaultTZ; + ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = + &gettime ($TZ, $time); + + # 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; + } + + # watch out in 2070... + $year += ($year < 70) ? 2000 : 1900; + + # now loop throught the supplied format looking for tags... + while (($pos = index ($format, '%')) != -1) { + + # grab the format tag + $tag = substr($format, $pos, 2); + $adv = 0; # for `%%' processing + + # do we have a replacement string? + if (defined $Tags{$tag}) { + + # trap dead evals... + if (! eval $Tags{$tag}) { + print STDERR "date.pl: internal error: eval for $tag failed: $@\n"; + return ""; + } + } else { + $rep = ""; + } + + # do the substitution + substr ($format, $pos, 2) =~ s/$tag/$rep/; + $pos++ if ($adv); + } + + $format; +} + +# dsuf - add `st', `nd', `rd', `th' to a date (ie 1st, 22nd, 29th) +sub dsuf { + local ($mday) = @_; + + return $mday . 'st' if ($mday =~ m/.*1$/); + return $mday . 'nd' if ($mday =~ m/.*2$/); + return $mday . 'rd' if ($mday =~ m/.*3$/); + return $mday . 'th'; +} + +# weekno - figure out week number +sub wkno { + local ($year, $yday, $firstweekday) = @_; + local ($jan1, @jan1, $wks); + + # figure out the `time' value for January 1 of the given year + $jan1 = &maketime ($TZ, 0, 0, 0, 1, 0, $year-1900); + + # figure out what day of the week January 1 was + @jan1= &gettime ($TZ, $jan1); + + # and calculate the week number + $wks = (($yday + ($jan1[6] - $firstweekday)) + 1)/ 7; + $wks += (($wks - int($wks) > 0.0) ? 1 : 0); + + # supply zero padding + &pad (int($wks), 2, "0"); +} + +# 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); } + +# ampmD - figure out am/pm designator +sub ampmD { shift @_ >= 12 ? "PM" : "AM"; } + +# gettime - get the time via {local,gmt}time +sub gettime { ((shift @_) eq 'GMT') ? gmtime(shift @_) : localtime(shift @_); } + +# maketime - make a time via time{local,gmt} +sub maketime { ((shift @_) eq 'GMT') ? &main'timegm(@_) : &main'timelocal(@_); } + +# ls - generate the time/year portion of an ls(1) style date +sub ls { + return ((&gettime ($TZ, time))[5] == @_[0]) ? "%R" : " %Y"; +} + +# pad - pad $in with leading $pad until lenght $len +sub pad { + local ($in, $len, $pad) = @_; + local ($out) = "$in"; + + $out = $pad . $out until (length ($out) == $len); + return $out; +} + +1; diff --git a/mmuegel/libs/elapsed.pl b/mmuegel/libs/elapsed.pl new file mode 100644 index 0000000..e8fc52a --- /dev/null +++ b/mmuegel/libs/elapsed.pl @@ -0,0 +1,123 @@ +;# NAME +;# elapsed.pl - convert seconds to elapsed time format +;# +;# AUTHOR +;# Michael S. Muegel <mmuegel@mot.com> +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/elapsed.pl,v +;# 1.1 of 1993/07/28 08:07:19 + +package elapsed; + +# Time field types +$DAYS = 1; +$HOURS = 2; +$MINUTES = 3; +$SECONDS = 4; + +# 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", + $HOURS, 60 * 60, ":", "%d", + $MINUTES, 60, ":", "%02d", + $SECONDS, 1, "", "%02d" + ); + +;############################################################################### +;# 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 +{ + local ($Seconds, $Collapse) = @_; + local ($Type, $Multiplier, @Multipliers, $Separator, $DHMS_Used, + $Elapsed, @Mult_And_Seps, $Print_Field); + + $Multiplier = 1; + @Mult_And_Seps = @MULT_AND_SEPS; + + # Keep subtracting the number of seconds corresponding to a time field + # from the number of seconds passed to the function. + while (1) + { + ($Type, $Multiplier, $Separator, $Format) = splice (@Mult_And_Seps, 0, 4); + last if (! $Multiplier); + $Seconds -= $DHMS_Used * $Multiplier + if ($DHMS_Used = int ($Seconds / $Multiplier)); + + # Figure out if we should print this field + if ($Type == $DAYS) + { + $Print_Field = $DHMS_Used; + } + + elsif ($Collapse) + { + if ($Type == $HOURS) + { + $Print_Field = $DHMS_Used; + } + elsif ($Type == $MINUTES) + { + $Print_Field = $DHMS_Used || $Printed_Field {$HOURS}; + } + else + { + $Format = ":%02d" + if (! $Printed_Field {$MINUTES}); + $Print_Field = 1; + }; + } + + else + { + $Print_Field = 1; + }; + + $Printed_Field {$Type} = $Print_Field; + $Elapsed .= sprintf ("$Format%s", $DHMS_Used, $Separator) + if ($Print_Field); + }; + + return ($Elapsed); +}; + +1; diff --git a/mmuegel/libs/mail.pl b/mmuegel/libs/mail.pl new file mode 100644 index 0000000..eeedb11 --- /dev/null +++ b/mmuegel/libs/mail.pl @@ -0,0 +1,140 @@ +;# NAME +;# mail.pl - perl function(s) to handle mail processing +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# 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 + +package mail; + +# Mailer statement to eval. $Users, $Subject, and $Verbose are substituted +# via eval +$BIN_MAILER = "/usr/ucb/mail \$Verbose -s '\$Subject' \$Users"; + +# Sendmail command to use when $Use_Sendmail is true. +$SENDMAIL = '/usr/lib/sendmail $Verbose $Users'; + +;############################################################################### +;# 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 +{ + local ($Users, $Subject, $Message, $Message_Is_File, $Verbose, + $Use_Sendmail) = @_; + local ($BIN_MAILER_HANDLE, $Mailer_Command, $Header_Found, %Header_Map, + $Header_Extra, $Mailer); + + # If the message is contained in a file read it in so we can have one + # consistent interface + if ($Message_Is_File) + { + undef $/; + $Message_Is_File = 0; + open (Message) || return (0, "error reading $Message: $!"); + $Message = <Message>; + close (Message); + }; + + # If sendmail mode see if we need to add some headers + if ($Use_Sendmail) + { + # Determine if a header block is included in the message and what headers + # are there + foreach (split (/\n/, $Message)) + { + last if ($_ eq ""); + $Header_Found = $Header_Map {$1} = 1 if (/^([A-Z]\S*): /); + }; + + # Add some headers? + if (! $Header_Map {"To"}) + { + $Header_Extra .= "To: " . join (", ", $Users) . "\n"; + }; + if (($Subject ne "") && (! $Header_Map {"Subject"})) + { + $Header_Extra .= "Subject: $Subject\n"; + }; + + # Add the required blank line between header/body if there where no + # headers to begin with + if ($Header_Found) + { + $Message = "$Header_Extra$Message"; + } + else + { + $Message = "$Header_Extra\n$Message"; + }; + }; + + # Get a string that is the mail command + $Verbose = ($Verbose) ? "-v" : ""; + $Mailer = ($Use_Sendmail) ? $SENDMAIL : $BIN_MAILER; + eval "\$Mailer = \"$Mailer\""; + return (0, "error setting \$Mailer: $@") if ($@); + + # need to catch SIGPIPE in case the $Mailer call fails + $SIG {'PIPE'} = "mail'Cleanup"; + + # Open mailer + return (0, "can not open mail program: $Mailer") if (! open (MAILER, "| $Mailer")); + + # Send off the mail! + print MAILER $Message; + close (MAILER); + return (0, "error running mail program: $Mailer") if ($?); + + # Everything must have went AOK + return (1); +}; + +;############################################################################### +;# Cleanup +;# +;# Simply here so we can catch SIGPIPE and not exit. +;# +;# Globals: +;# None +;# +;# Arguments: +;# None +;# +;# Returns: +;# Nothing exciting +;############################################################################### +sub Cleanup +{ +}; + +1; diff --git a/mmuegel/libs/mqueue.pl b/mmuegel/libs/mqueue.pl new file mode 100644 index 0000000..f425ede --- /dev/null +++ b/mmuegel/libs/mqueue.pl @@ -0,0 +1,215 @@ +;# NAME +;# mqueue.pl - functions to work with the sendmail queue +;# +;# DESCRIPTION +;# Both Get_Queue_IDs and Parse_Control_File are available to get +;# information about the sendmail queue. The cqueue program is a good +;# example of how these functions work. +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/mqueue.pl,v +;# 1.1 of 1993/07/28 08:07:19 + +package mqueue; + +;############################################################################### +;# Get_Queue_IDs +;# +;# Will figure out the queue IDs in $Queue that have both control and data +;# files. They are returned in @Valid_IDs. Those IDs that have a +;# control file and no data file are saved to the array globbed by +;# *Missing_Control_IDs. Likewise, those IDs that have a data file and no +;# control file are saved to the array globbed by *Missing_Data_IDs. +;# +;# If $Skip_Locked is true they a message that has a lock file is skipped +;# and will not show up in any of the arrays. +;# +;# If everything went AOK then $Status is 1; otherwise, $Status is 0 and +;# $Msg tells what went wrong. +;# +;# Globals: +;# None +;# +;# Arguments: +;# $Queue, $Skip_Locked, *Missing_Control_IDs, *Missing_Data_IDs +;# +;# Returns: +;# $Status, $Msg, @Valid_IDs +;############################################################################### +sub main'Get_Queue_IDs +{ + local ($Queue, $Skip_Locked, *Missing_Control_IDs, + *Missing_Data_IDs) = @_; + local (*QUEUE, @Files, %Lock_IDs, %Data_IDs, %Control_IDs, $_); + + # Make sure that the * argument @arrays ar empty + @Missing_Control_IDs = @Missing_Data_IDs = (); + + # Save each data, lock, and queue file in @Files + opendir (QUEUE, $Queue) || return (0, "error getting directory listing of $Queue"); + @Files = grep (/^(df|lf|qf)/, readdir (QUEUE)); + closedir (QUEUE); + + # Create indexed list of data and control files. IF $Skip_Locked is true + # then skip either if there is a lock file present. + if ($Skip_Locked) + { + grep ((s/^lf//) && ($Lock_IDs {$_} = 1), @Files); + grep ((s/^df//) && (! $Lock_IDs {$_}) && ($Data_IDs {$_} = 1), @Files); + grep ((s/^qf//) && (! $Lock_IDs {$_}) && ($Control_IDs {$_} = 1), @Files); + } + else + { + grep ((s/^df//) && ($Data_IDs {$_} = 1), @Files); + grep ((s/^qf//) && ($Control_IDs {$_} = 1), @Files); + }; + + # Find missing control and data files and remove them from the lists of each + @Missing_Control_IDs = sort (grep ((! $Control_IDs {$_}) && (delete $Data_IDs {$_}), keys (%Data_IDs))); + @Missing_Data_IDs = sort (grep ((! $Data_IDs {$_} && (delete $Control_IDs {$_})), keys (%Control_IDs))); + + + # Return the IDs in an appartently random order + return (1, "", keys (%Control_IDs)); +}; + + +;############################################################################### +;# Parse_Control_File +;# +;# Will pase a sendmail queue control file for useful information. See the +;# Sendmail Installtion and Operation Guide (SMM:07) for a complete +;# explanation of each field. +;# +;# The following globbed variables are set (or cleared) by this function: +;# +;# $Sender The sender's address. +;# +;# @Recipients One or more addresses for the recipient of the mail. +;# +;# @Errors_To One or more addresses for addresses to which mail +;# delivery errors should be sent. +;# +;# $Creation_Time The job creation time in time(3) format. That is, +;# seconds since 00:00:00 GMT 1/1/70. +;# +;# $Priority An integer representing the current message priority. +;# This is used to order the queue. Higher numbers mean +;# lower priorities. +;# +;# $Status_Message The status of the mail message. It can contain any +;# text. +;# +;# @Headers Message headers unparsed but in their original order. +;# Headers that span multiple lines are not mucked with, +;# embedded \ns will be evident. +;# +;# In all e-mail addresses bounding <> pairs are stripped. +;# +;# If everything went AOK then $Status is 1. If the message with queue ID +;# $Queue_ID just does not exist anymore -1 is returned. This is very +;# possible and should be allowed for. Otherwise, $Status is 0 and $Msg +;# tells what went wrong. +;# +;# Globals: +;# None +;# +;# Arguments: +;# $Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time, +;# *Priority, *Status_Message, *Headers +;# +;# Returns: +;# $Status, $Msg +;############################################################################### +sub main'Parse_Control_File +{ + local ($Queue, $Queue_ID, *Sender, *Recipients, *Errors_To, *Creation_Time, + *Priority, *Status_Message, *Headers) = @_; + local (*Control, $_, $Not_Empty); + + # Required variables and the associated control. If empty at the end of + # parsing we return a bad status. + @REQUIRED_INFO = ('$Creation_Time', 'T', '$Sender', 'S', '@Recipients', 'R', + '$Priority', 'P'); + + # Open up the control file for read + $Control = "$Queue/qf$Queue_ID"; + if (! open (Control)) + { + return (-1) if ((-x $Queue) && (! -f "$Queue/qf$Queue_ID") && + (! -f "$Queue/df$Queue_ID")); + return (0, "error opening $Control for read: $!"); + }; + + # Reset the globbed variables just in case + $Sender = $Creation_Time = $Priority = $Status_Message = ""; + @Recipients = @Errors_To = @Headers = (); + + # Look for a few things in the control file + READ: while (<Control>) + { + $Not_Empty = 1; + chop; + + PARSE: + { + if (/^T(\d+)$/) + { + $Creation_Time = $1; + } + elsif (/^S(<)?([^>]+)/) + { + $Sender = $2; + } + elsif (/^R(<)?([^>]+)/) + { + push (@Recipients, $2); + } + elsif (/^E(<)?([^>]+)/) + { + push (@Errors_To, $2); + } + elsif (/^M(.*)/) + { + $Status_Message = $1; + } + elsif (/^P(\d+)$/) + { + $Priority = $1; + } + elsif (/^H(.*)/) + { + $Header = $1; + while (<Control>) + { + chop; + last if (/^[A-Z]/); + $Header .= "\n$_"; + }; + push (@Headers, $Header); + redo PARSE if ($_); + last if (eof); + }; + }; + }; + + # If the file was empty scream bloody murder + return (0, "empty control file") if (! $Not_Empty); + + # Yell if we could not find a required field + while (($Var, $Control) = splice (@REQUIRED_INFO, 0, 2)) + { + eval "return (0, 'required control field $Control not found') + if (! $Var)"; + return (0, "error checking \$Var: $@") if ($@); + }; + + # Everything went AOK + return (1); +}; + +1; diff --git a/mmuegel/libs/newgetopts.pl b/mmuegel/libs/newgetopts.pl new file mode 100644 index 0000000..bc73348 --- /dev/null +++ b/mmuegel/libs/newgetopts.pl @@ -0,0 +1,213 @@ +;# NAME +;# newgetopts.pl - a better newgetopt (which is a better getopts which is +;# a better getopt ;-) +;# +;# AUTHOR +;# Mike Muegel (mmuegel@mot.com) +;# +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/newgetopts.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp + +;############################################################################### +;# New_Getopts +;# +;# Does not care about order of switches, options, and arguments like +;# getopts.pl. Thus all non-switches/options will be kept in ARGV even if they +;# are not at the end. If $Pass_Invalid is set all unkown options will be +;# passed back to the caller by keeping them in @ARGV. This is useful when +;# parsing a command line for your script while ignoring options that you +;# may pass to another script. If this is set New_Getopts tries to maintain +;# the switch clustering on the unkown switches. +;# +;# Accepts the special argument -usage to print the Usage string. Also accepts +;# the special option -version which prints the contents of the string +;# $VERSION. $VERSION may or may not have an embeded \n in it. If -usage +;# or -version are specified a status of -1 is returned. Note that the usage +;# option is only accepted if the usage string is not null. +;# +;# $Switches is just like the formal arguemnt of getopts.pl. $Usage is a usage +;# string with or without a trailing \n. *Switch_To_Order is an optional +;# pointer to the name of an associative array which will contain a mapping of +;# switch names to the order in which (if at all) the argument was entered. +;# +;# For example, if @ARGV contains -v, -x, test: +;# +;# $Switch_To_Order {"v"} = 1; +;# $Switch_To_Order {"x"} = 2; +;# +;# Note that in the case of multiple occurances of an option $Switch_To_Order +;# will store each occurance of the argument via a string that emulates +;# an array. This is done by using join ($;, ...). You can retrieve the +;# array by using split (/$;/, ...). +;# +;# *Split_ARGV is an optional pointer to an array which will conatin the +;# original switches along with their values. For the example used above +;# Split_ARGV would contain: +;# +;# @Split_ARGV = ("v", "", "x", "test"); +;# +;# Another exciting ;-) feature that newgetopts has. Along with creating the +;# normal $opt_ scalars for the last value of an argument the list @opt_ is +;# created. It is an array which contains all the values of arguments to the +;# basename of the variable. They are stored in the order which they occured +;# on the command line starting with $[. Note that blank arguments are stored +;# as "". Along with providing support for multiple options on the command +;# line this also provides a method of counting the number of times an option +;# was specified via $#opt_. +;# +;# Automatically resets all $opt_, @opt_, %Switch_To_Order, and @Split_ARGV +;# variables so that New_Getopts may be called more than once from within +;# the same program. Thus, if $opt_v is set upon entry to New_Getopts and +;# -v is not in @ARGV $opt_v will not be set upon exit. +;# +;# Arguments: +;# $Switches, $Usage, $Pass_Invalid, *Switch_To_Order, *Split_ARGV +;# +;# Returns: +;# -1, 0, or 1 depending on status (printed Usage/Version, OK, not OK) +;############################################################################### +sub New_Getopts +{ + local($taint_argumentative, $Usage, $Pass_Invalid, *Switch_To_Order, + *Split_ARGV) = @_; + local(@args,$_,$first,$rest,$errs, @leftovers, @current_leftovers, + %Switch_Found); + local($[, $*, $Script_Name, $argumentative); + + # Untaint the argument cluster so that we can use this with taintperl + $taint_argumentative =~ /^(.*)$/; + $argumentative = $1; + + # Clear anything that might still be set from a previous New_Getopts + # call. + @Split_ARGV = (); + + # Get the basename of the calling script + ($Script_Name = $0) =~ s/.*\///; + + # Make Usage have a trailing \n + $Usage .= "\n" if ($Usage !~ /\n$/); + + @args = split( / */, $argumentative ); + + # Clear anything that might still be set from a previous New_Getopts call. + foreach $first (@args) + { + next if ($first eq ":"); + delete $Switch_Found {$first}; + delete $Switch_To_Order {$first}; + eval "undef \@opt_$first; undef \$opt_$first;"; + }; + + while (@ARGV) + { + # Let usage through + if (($ARGV[0] eq "-usage") && ($Usage ne "\n")) + { + print $Usage; + exit (-1); + } + + elsif ($ARGV[0] eq "-version") + { + if ($VERSION) + { + print $VERSION; + print "\n" if ($VERSION !~ /\n$/); + } + else + { + warn "${Script_Name}: no version information available, sorry\n"; + } + exit (-1); + } + + elsif (($_ = $ARGV[0]) =~ /^-(.)(.*)/) + { + ($first,$rest) = ($1,$2); + $pos = index($argumentative,$first); + + $Switch_To_Order {$first} = join ($;, split (/$;/, $Switch_To_Order {$first}), ++$Order); + + if($pos >= $[) + { + if($args[$pos+1] eq ':') + { + shift(@ARGV); + if($rest eq '') + { + $rest = shift(@ARGV); + } + + eval "\$opt_$first = \$rest;"; + eval "push (\@opt_$first, \$rest);"; + push (@Split_ARGV, $first, $rest); + } + else + { + eval "\$opt_$first = 1"; + eval "push (\@opt_$first, '');"; + push (@Split_ARGV, $first, ""); + + if($rest eq '') + { + shift(@ARGV); + } + else + { + $ARGV[0] = "-$rest"; + } + } + } + + else + { + # Save any other switches if $Pass_Valid + if ($Pass_Invalid) + { + push (@current_leftovers, $first); + } + else + { + warn "${Script_Name}: unknown option: $first\n"; + ++$errs; + }; + if($rest ne '') + { + $ARGV[0] = "-$rest"; + } + else + { + shift(@ARGV); + } + } + } + + else + { + push (@leftovers, shift (@ARGV)); + }; + + # Save any other switches if $Pass_Valid + if ((@current_leftovers) && ($rest eq '')) + { + push (@leftovers, "-" . join ("", @current_leftovers)); + @current_leftovers = (); + }; + }; + + # Automatically print Usage if a warning was given + @ARGV = @leftovers; + if ($errs != 0) + { + warn $Usage; + return (0); + } + else + { + return (1); + } + +} + +1; diff --git a/mmuegel/libs/strings1.pl b/mmuegel/libs/strings1.pl new file mode 100644 index 0000000..a49335a --- /dev/null +++ b/mmuegel/libs/strings1.pl @@ -0,0 +1,147 @@ +;# NAME +;# strings1.pl - FUN with strings #1 +;# +;# NOTES +;# I wrote Format_Text_Block when I just started programming Perl so +;# it is probably not very Perlish code. Center is more like it :-). +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/strings1.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp + +package strings1; + +;###############################################################################;# Center +;# +;# Center $Text assuming the output should be $Columns wide. $Text can span +;# multiple lines, of course :-). Lines within $Text that contain only +;# whitespace are not centered and are instead collapsed. This may save time +;# when printing them later. +;# +;# Arguments: +;# $Text, $Columns +;# +;# Returns: +;# $Centered_Text +;############################################################################### +sub main'Center +{ + local ($_, $Columns) = @_; + local ($*) = 1; + + s@^(.*)$@" " x (($Columns - length ($1)) / 2) . $1@eg; + s/^[\t ]*$//g; + return ($_); +}; + +;############################################################################### +;# Format_Text_Block +;# +;# Formats a text string to be printed to the display or other similar device. +;# Text in $String will be fomratted such that the following hold: +;# +;# + $String contains the (possibly) multi-line text to print. It is +;# automatically word-wrapped to fit in $Columns. +;# +;# + \n'd are maintained and are not folded. +;# +;# + $Offset is pre-pended before each separate line of text. +;# +;# + If $Offset_Once is $TRUE $Offset will only appear on the first line. +;# All other lines will be indented to match the amount of whitespace of +;# $Offset. +;# +;# + If $Bullet_Indent is $TRUE $Offset will only be applied to the begining +;# of lines as they occured in the original $String. Lines that are created +;# by this routine will always be indented by blank spaces. +;# +;# + If $Columns is 0 no word-wrap is done. This might be useful to still +;# to offset each line in a buffer. +;# +;# + If $Split_Expr is supplied the string is split on it. If not supplied +;# the string is split on " \t\/\-\,\." by default. +;# +;# + If $Offset_Blank is $TRUE then empty lines will have $Offset pre-pended +;# to them. Otherwise, they will still empty. +;# +;# This is a realy workhorse routine that I use in many places because of its +;# veratility. +;# +;# Arguments: +;# $String, $Offset, $Offset_Once, $Bullet_Indent, $Columns, $Split_Expr, +;# $Offset_Blank +;# +;# Returns: +;# $Buffer +;############################################################################### +sub main'Format_Text_Block +{ + local ($String, $Real_Offset, $Offset_Once, $Bullet_Indent, $Columns, + $Split_Expr, $Offset_Blank) = @_; + + local ($New_Line, $Line, $Chars_Per_Line, $Space_Offset, $Buffer, + $Next_New_Line, $Num_Lines, $Num_Offsets, $Offset); + local ($*) = 0; + local ($BLANK_TAG) = "__FORMAT_BLANK__"; + local ($Blank_Offset) = $Real_Offset if ($Offset_Blank); + + # What should we split on? + $Split_Expr = " \\t\\/\\-\\,\\." if (! $Split_Expr); + + # Pre-process the string - convert blank lines to __FORMAT_BLANK__ sequence + $String =~ s/\n\n/\n$BLANK_TAG\n/g; + $String =~ s/^\n/$BLANK_TAG\n/g; + $String =~ s/\n$/\n$BLANK_TAG/g; + + # If bad $Columns/$Offset combo or no $Columns make a VERRRYYY wide $Column + $Offset = $Real_Offset; + $Chars_Per_Line = 16000 if (($Chars_Per_Line = $Columns - length ($Offset)) <= 0); + $Space_Offset = " " x length ($Offset); + + # Get a buffer + foreach $Line (split ("\n", $String)) + { + $Offset = $Real_Offset if ($Bullet_Indent); + + # Find where to split the line + if ($Line ne $BLANK_TAG) + { + $New_Line = ""; + while ($Line =~ /^([$Split_Expr]*)([^$Split_Expr]+)/) + { + if (length ("$New_Line$&") >= $Chars_Per_Line) + { + $Next_New_Line = $+; + $New_Line = "$Offset$New_Line$1"; + $Buffer .= "\n" if ($Num_Lines++); + $Buffer .= $New_Line; + $Offset = $Space_Offset if (($Offset) && ($Offset_Once)); + $New_Line = $Next_New_Line; + ++$Num_Lines; + } + else + { + $New_Line .= $&; + }; + $Line = $'; + }; + + $Buffer .= "\n" if ($Num_Lines++); + $Buffer .= "$Offset$New_Line$Line"; + $Offset = $Space_Offset if (($Offset) && ($Offset_Once)); + } + + else + { + $Buffer .= "\n$Blank_Offset"; + }; + }; + + return ($Buffer); + +}; + +1; diff --git a/mmuegel/libs/timespec.pl b/mmuegel/libs/timespec.pl new file mode 100644 index 0000000..06b048d --- /dev/null +++ b/mmuegel/libs/timespec.pl @@ -0,0 +1,60 @@ +;# NAME +;# timespec.pl - convert a pre-defined time specifyer to seconds +;# +;# AUTHOR +;# Michael S. Muegel (mmuegel@mot.com) +;# +;# RCS INFORMATION +;# mmuegel +;# /usr/local/ustart/src/mail-tools/dist/foo/libs/timespec.pl,v 1.1 1993/07/28 08:07:19 mmuegel Exp + +package timespec; + +%TIME_SPEC_TO_SECONDS = ("s", 1, + "m", 60, + "h", 60 * 60, + "d", 60 * 60 * 24 + ); + +$VALID_TIME_SPEC_EXPR = "[" . join ("", keys (%TIME_SPEC_TO_SECONDS)) . "]"; + +;############################################################################### +;# Time_Spec_To_Seconds +;# +;# Converts a string of the form: +;# +;# (<number>(s|m|h|d))+ +;# +;# to seconds. The second part of the time spec specifies seconds, minutes, +;# hours, or days, respectfully. The first part is the number of those untis. +;# There can be any number of such specifiers. As an example, 1h30m means 1 +;# hour and 30 minutes. +;# +;# If the parsing went OK then $Status is 1, $Msg is undefined, and $Seconds +;# is $Time_Spec converted to seconds. If something went wrong then $Status +;# is 0 and $Msg explains what went wrong. +;# +;# Arguments: +;# $Time_Spec +;# +;# Returns: +;# $Status, $Msg, $Seconds +;############################################################################### +sub main'Time_Spec_To_Seconds +{ + $Time_Spec = $_[0]; + + $Seconds = 0; + while ($Time_Spec =~ /^(\d+)($VALID_TIME_SPEC_EXPR)/) + { + $Seconds += $1 * $TIME_SPEC_TO_SECONDS {$2}; + $Time_Spec = $'; + }; + + return (0, "error parsing time spec: $Time_Spec") if ($Time_Spec ne ""); + return (1, "", $Seconds); + +}; + + +1; |