You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
477 lines
13 KiB
477 lines
13 KiB
4 months ago
|
#!/usr/bin/perl
|
||
|
|
#
|
||
|
|
# $Id: bugsitecfg.pl,v 1.3 2004/01/29 07:57:04 jeffo Exp $
|
||
|
|
#
|
||
|
|
# Source File: bugsitecfg.pl
|
||
|
|
|
||
|
|
$pathsep="/";
|
||
|
|
$docroot = "/usr/local/httpd/defects";
|
||
|
|
$pubroot = $docroot;
|
||
|
|
$resptmplt = $docroot;
|
||
|
|
$dataroot = "/usr/local/httpd/defects/data";
|
||
|
|
$graphroot = join($pathsep, "\.\.", "graphic");
|
||
|
|
$cgiurl = "/cgi-bin";
|
||
|
|
|
||
|
|
$acceptpost = 1;
|
||
|
|
$acceptget = 1;
|
||
|
|
|
||
|
|
sub app_initialize {
|
||
|
|
# set variables from query parameters based on the request method
|
||
|
|
$reqmeth = $ENV{'REQUEST_METHOD'};
|
||
|
|
@cookies = split(/\;/,$ENV{'HTTP_COOKIE'});
|
||
|
|
foreach $cookie (@cookies) {
|
||
|
|
($nm, $vlu) = split(/=/, $cookie);
|
||
|
|
$nm =~ s/ //g;
|
||
|
|
$vlu =~ tr/+/ /;
|
||
|
|
$vlu =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
|
$COOKIES{$nm} = $vlu;
|
||
|
|
}
|
||
|
|
if ($reqmeth =~ /POST/i) {
|
||
|
|
if ($acceptpost) { read (STDIN, $qstr, $ENV{'CONTENT_LENGTH'});}
|
||
|
|
} else {
|
||
|
|
if ($reqmeth =~ /GET/i) {
|
||
|
|
if ($acceptget) { $qstr=$ENV{'QUERY_STRING'};}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($qstr) {
|
||
|
|
$contenttype=$ENV{'CONTENT_TYPE'};
|
||
|
|
if ($contenttype =~ 'multipart/form-data') {
|
||
|
|
$srch="boundary\=";
|
||
|
|
($trash,$boundary) = split(/$srch/, $contenttype);
|
||
|
|
($boundary, $trash) = split(/ /, $boundary);
|
||
|
|
$endboundary = join('', $boundary, "\-\-");
|
||
|
|
$boundary = join('', $boundary, "\r\n");
|
||
|
|
($qstr, $trash) = split(/$endboundary/, $qstr);
|
||
|
|
@parts = split(/$boundary/, $qstr);
|
||
|
|
$trash = shift @parts;
|
||
|
|
$consep = "\r\n\r\n";
|
||
|
|
foreach $part (@parts) {
|
||
|
|
($contype, $content) = split(/$consep/, $part);
|
||
|
|
if ($contype ne '') {
|
||
|
|
chop($content);
|
||
|
|
chop($content);
|
||
|
|
$contype =~ s/\: /=/g;
|
||
|
|
$contype =~ s/\r\n/; /g;
|
||
|
|
@lines = split(/\; /, $contype);
|
||
|
|
$nme = "";
|
||
|
|
$fname = "";
|
||
|
|
$ftype = "";
|
||
|
|
foreach $line (@lines) {
|
||
|
|
$line =~ s/\"//g;
|
||
|
|
($nm,$vlu) = split(/=/, $line);
|
||
|
|
$vlu =~ tr/+/ /;
|
||
|
|
$vlu =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
|
if ($nm eq 'filename') {
|
||
|
|
@segs = split(/\./, $vlu);
|
||
|
|
$ftype = $segs[$#segs];
|
||
|
|
} else {
|
||
|
|
if ($nm eq 'name') {
|
||
|
|
$nme = $vlu;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
if ($ftype eq '') {
|
||
|
|
$content =~ s/\r\n//g;
|
||
|
|
$content =~ tr/+/ /;
|
||
|
|
$content =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
|
$FORM{$nme} = $content;
|
||
|
|
} else {
|
||
|
|
$content =~ s/(.*)\r\n/$1/;
|
||
|
|
$outfile=join($pathsep, $dataroot, "$nme.$ftype");
|
||
|
|
open (OUTFILE, ">$outfile") or $msg="failed";
|
||
|
|
if ($msg ne "failed") {
|
||
|
|
binmode(OUTFILE);
|
||
|
|
print OUTFILE $content;
|
||
|
|
close OUTFILE;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
# parse request parameters into variables
|
||
|
|
@parameters = split(/&/, $qstr);
|
||
|
|
foreach $pair (@parameters) {
|
||
|
|
($nm, $vlu) = split(/=/, $pair);
|
||
|
|
$vlu =~ tr/+/ /;
|
||
|
|
$vlu =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
|
$FORM{$nm} = $vlu;
|
||
|
|
}
|
||
|
|
unless ($language) {$FORM{'lng'}="us";}
|
||
|
|
}
|
||
|
|
return 1;
|
||
|
|
} else {
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub verifyaccess {
|
||
|
|
$FORM{'uac'} = "";
|
||
|
|
$tmpfile = "admin.dat";
|
||
|
|
@pairs = &get_data($tmpfile);
|
||
|
|
foreach $pair (@pairs) {
|
||
|
|
chop ($pair);
|
||
|
|
($id, $pw, $pv, $clid, $lstid, $eml) = split(/&/, $pair);
|
||
|
|
if ($id eq $FORM{'uid'}) {
|
||
|
|
if ($pw eq $FORM{'pwd'}) {
|
||
|
|
return 1;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return 0;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub retrieve_email_address {
|
||
|
|
$tmpfile = "admin.dat";
|
||
|
|
@pairs = &get_data($tmpfile);
|
||
|
|
foreach $pair (@pairs) {
|
||
|
|
chop ($pair);
|
||
|
|
($id, $pw, $pv, $clid, $lstid, $eml) = split(/&/, $pair);
|
||
|
|
if ($id eq $FORM{'uid'}) {
|
||
|
|
# $eml =~ s/\@/\\\@/;
|
||
|
|
return $eml;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
return "";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub xlatline {
|
||
|
|
$xltline = $_[0];
|
||
|
|
if ($xltline =~ /<%=(.*)%>/ ) {
|
||
|
|
if ($xltline =~ /<%=FORM\.(.*)%>/i ) {
|
||
|
|
for (keys %FORM) {
|
||
|
|
$repl = $FORM{$_};
|
||
|
|
$srch1 = join('', "<%=FORM.", $_, "%>");
|
||
|
|
$xltline =~ s/$srch1/$repl/g;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
$xltline =~ s/<%=(.*)%>//g;
|
||
|
|
print "$xltline";
|
||
|
|
} else {
|
||
|
|
print "$xltline";
|
||
|
|
}
|
||
|
|
return $xltline;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_data {
|
||
|
|
$tmpfile = join($pathsep, $dataroot, "$_[0]");
|
||
|
|
open (TMPFILE, "<$tmpfile");
|
||
|
|
@locallines = <TMPFILE>;
|
||
|
|
close TMPFILE;
|
||
|
|
return @locallines;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_template {
|
||
|
|
$tmpfile = join($pathsep, $docroot, "$_[0].htt");
|
||
|
|
open (TMPFILE, "<$tmpfile");
|
||
|
|
@locallines = <TMPFILE>;
|
||
|
|
close TMPFILE;
|
||
|
|
return @locallines;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub show_template {
|
||
|
|
@lines = &get_template($_[0]);
|
||
|
|
foreach $line (@lines) {
|
||
|
|
$line = &xlatline($line);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub get_report {
|
||
|
|
$trash = join($pathsep, $dataroot, $_[0]);
|
||
|
|
@lines = &get_data($_[0]);
|
||
|
|
foreach $line (@lines) {
|
||
|
|
chop ($line);
|
||
|
|
($nm,$vlu) = split(/=/, $line);
|
||
|
|
$vlu =~ tr/+/ /;
|
||
|
|
$vlu =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
|
$vlu =~ s/<BR>/\r\n/g;
|
||
|
|
$REPORT{$nm} = $vlu;
|
||
|
|
}
|
||
|
|
@lines = ();
|
||
|
|
}
|
||
|
|
|
||
|
|
sub put_report {
|
||
|
|
$updtrep = 0;
|
||
|
|
if ($_[0] eq '') {
|
||
|
|
opendir (DIR, $dataroot);
|
||
|
|
@dots = readdir(DIR);
|
||
|
|
closedir DIR;
|
||
|
|
$rptfile = "rptdefect.000";
|
||
|
|
foreach $dot (@dots) {
|
||
|
|
if ($dot =~ /rptdefect./ ) {
|
||
|
|
($trash, $dno) = split(/\./, $dot);
|
||
|
|
($trash, $rno) = split(/\./, $rptfile);
|
||
|
|
if ($dno > $rno) {
|
||
|
|
$rptfile = $dot;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
@dots =();
|
||
|
|
($fnm,$cnt) = split(/\./, $rptfile);
|
||
|
|
$cnt++;
|
||
|
|
$rptfile = sprintf("%s.%03d", $fnm, $cnt);
|
||
|
|
$REPORT{'reportno'}=$rptfile;
|
||
|
|
$updtrep = 0;
|
||
|
|
} else {
|
||
|
|
$REPORT{'reportno'}=$_[0];
|
||
|
|
$updtrep = 1;
|
||
|
|
}
|
||
|
|
$tmpfile = join($pathsep, $dataroot, $REPORT{'reportno'});
|
||
|
|
open (TMPFILE, ">$tmpfile");
|
||
|
|
for (keys %REPORT) {
|
||
|
|
$vlu = $REPORT{$_};
|
||
|
|
$vlu =~ tr/ /+/;
|
||
|
|
$vlu =~ s/\r\n/<BR>/g;
|
||
|
|
$vlu =~ s/([&!#^~=])/unpack("C",hex($1))/eg;
|
||
|
|
print TMPFILE "$_=$vlu\n";
|
||
|
|
}
|
||
|
|
close TMPFILE;
|
||
|
|
$chmodok = chmod 0666, $tmpfile;
|
||
|
|
$emailaddress = &retrieve_email_address();
|
||
|
|
if ($emailaddress ne '') {
|
||
|
|
if ($updtrep) {
|
||
|
|
&send_change_notice($emailaddress);
|
||
|
|
} else {
|
||
|
|
&send_post_notice($emailaddress);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
sub show_detail {
|
||
|
|
$time = time;
|
||
|
|
print "<HTML>\n";
|
||
|
|
print "<HEAD>\n";
|
||
|
|
print "<SCRIPT LANGUAGE=\"JavaScript\">\n";
|
||
|
|
print "<!--\n";
|
||
|
|
print "function wdw_onLoad() {\n";
|
||
|
|
print " parent.rindex.document.location.reload();\n";
|
||
|
|
print "}\n";
|
||
|
|
print "window.onload=wdw_onLoad;\n";
|
||
|
|
print "//-->\n";
|
||
|
|
print "</SCRIPT>\n";
|
||
|
|
print "</HEAD>\n";
|
||
|
|
print "<BODY>\n";
|
||
|
|
print "<FORM NAME=form1 METHOD=POST ACTION=\"$cgiurl/bugpostrpt.pl\">\n";
|
||
|
|
print "<INPUT TYPE=HIDDEN NAME=\"reportno\" VALUE=\"$REPORT{'reportno'}\">\n";
|
||
|
|
print "<INPUT TYPE=HIDDEN NAME=\"uid\" VALUE=\"$FORM{'uid'}\">\n";
|
||
|
|
print "<TABLE border=0 width=\"100%\">\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Number:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " $REPORT{'reportno'}\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Submitted by:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " <SELECT NAME=\"submittedby\">\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'wc') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"wc\" $selected>Bill Carico\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'gd') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"gd\" $selected>Gavin Douglas\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'jw') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"jw\" $selected>John Walkingstick\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'kg') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"kg\" $selected>Kathie Gaynor\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'mg') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"mg\" $selected>Mike Gordon\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'pc') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"pc\" $selected>Patti Carico\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'rj') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"rj\" $selected>Richard Garman\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'sc') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"sc\" $selected>Scott Caldwell\n";
|
||
|
|
$selected = ($REPORT{'submittedby'} eq 'ot') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"ot\" $selected>Other\n";
|
||
|
|
print " </SELECT>\n";
|
||
|
|
print " Status: <SELECT NAME=\"status\">\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'r') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"r\" $selected>Regression Test Deviation\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'd') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"d\" $selected>Design Issue\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'e') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"e\" $selected>Enhancement\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'f') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"f\" $selected>Fixed\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'o' || $REPORT{'submittedby'} eq '') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"o\" $selected>Open\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'u') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"u\" $selected>Under Review\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'w') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"w\" $selected>Work Around\n";
|
||
|
|
$selected = ($REPORT{'status'} eq 'c') ? "SELECTED" : "";
|
||
|
|
print " <OPTION VALUE=\"c\" $selected>Closed\n";
|
||
|
|
print " </SELECT>\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Title:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " <INPUT TYPE=TEXT NAME=\"title\" VALUE=\"$REPORT{'title'}\" SIZE=40 MAXLENGTH=40>\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Description:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " <TEXTAREA NAME=\"desc\" ROWS=6 COLS=40>$REPORT{'desc'}</TEXTAREA>\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Additional Details:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " <TEXTAREA NAME=\"adddtl\" ROWS=6 COLS=40>$REPORT{'adddtl'}</TEXTAREA>\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right valign=top>Fix/Work Around:</TD>\n";
|
||
|
|
print " <TD align=left valign=top>\n";
|
||
|
|
print " <TEXTAREA NAME=\"fix\" ROWS=6 COLS=40>$REPORT{'fix'}</TEXTAREA>\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print " <TR>\n";
|
||
|
|
print " <TD align=right> </TD>\n";
|
||
|
|
print " <TD align=left>\n";
|
||
|
|
print " <INPUT TYPE=SUBMIT VALUE=\"Save Report\">\n";
|
||
|
|
print " </TD>\n";
|
||
|
|
print " </TR>\n";
|
||
|
|
print "</TABLE>\n";
|
||
|
|
print "</FORM>\n";
|
||
|
|
print "</BODY>\n";
|
||
|
|
print "</HTML>\n";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub send_mail {
|
||
|
|
open(SENDMAIL, "|/usr/lib/sendmail -oi -t")
|
||
|
|
or $msg2 = "Can't fork for sendmail: $!\n";
|
||
|
|
print SENDMAIL <<"EOF";
|
||
|
|
From: $_[0]
|
||
|
|
To: $_[1]
|
||
|
|
Subject: $_[2]
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
$_[3]
|
||
|
|
EOF
|
||
|
|
close(SENDMAIL) or $msg2 = "sendmail didn't close nicely";
|
||
|
|
}
|
||
|
|
|
||
|
|
sub send_post_notice {
|
||
|
|
$mmautontfyfrom=$_[0];
|
||
|
|
$mmautontfyto="support\@test-central.com";
|
||
|
|
$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
|
||
|
|
$mmtime = &format_date_time("hh:nn:ss", "1", "0");
|
||
|
|
$mmsubj = "Test Central Bug List Entry";
|
||
|
|
$mmbody = "Date: $mmdate
|
||
|
|
Report Number: $REPORT{'reportno'}
|
||
|
|
Submitted by: $REPORT{'submittedby'}
|
||
|
|
Title: $REPORT{'title'}
|
||
|
|
|
||
|
|
Description:
|
||
|
|
$REPORT{'desc'}
|
||
|
|
";
|
||
|
|
&send_mail($mmautontfyfrom, $mmautontfyto, $mmsubj, $mmbody);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub send_change_notice {
|
||
|
|
$mmautontfyfrom="support\@test-central.com";
|
||
|
|
$mmautontfyto=$_[0];
|
||
|
|
$mmdate = &format_date_time("dd-mmm-yyyy", "1", "0");
|
||
|
|
$mmtime = &format_date_time("hh:nn:ss", "1", "0");
|
||
|
|
$mmsubj = "Test Central Bug Entry Reclassification";
|
||
|
|
$mmbody = "Date: $mmdate
|
||
|
|
|
||
|
|
The Test-Central Bug report $REPORT{'reportno'}
|
||
|
|
you filed has been reclassified as follows:
|
||
|
|
|
||
|
|
Title: $REPORT{'title'}
|
||
|
|
Status Changed: $REPORT{'status'}
|
||
|
|
|
||
|
|
Corrective Action:
|
||
|
|
$REPORT{'fix'}
|
||
|
|
";
|
||
|
|
&send_mail($mmautontfyfrom, $mmautontfyto, $mmsubj, $mmbody);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_date_time {
|
||
|
|
$sformatted = $_[0];
|
||
|
|
if ($_[1] == '1') {
|
||
|
|
if ($_[2]=='-1') {
|
||
|
|
@tmvalues = gmtime(time-1000);
|
||
|
|
} else {
|
||
|
|
if ($_[2]=='-10000') {
|
||
|
|
@tmvalues = gmtime($_[3]);
|
||
|
|
} else {
|
||
|
|
@tmvalues = gmtime(time+$_[2]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if ($_[2]=='-1') {
|
||
|
|
@tmvalues = localtime(time-1000);
|
||
|
|
} else {
|
||
|
|
if ($_[2]=='-10000') {
|
||
|
|
@tmvalues = localtime($_[3]);
|
||
|
|
} else {
|
||
|
|
@tmvalues = localtime(time+$_[2]);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
$ss = sprintf( "%02d", $tmvalues[0]);
|
||
|
|
$nn = sprintf( "%02d", $tmvalues[1]);
|
||
|
|
$h = sprintf( "%d", $tmvalues[2]);
|
||
|
|
$hh = sprintf( "%02d", $tmvalues[2]);
|
||
|
|
$dd = sprintf( "%02d", $tmvalues[3]);
|
||
|
|
$mm = sprintf( "%02d", $tmvalues[4]+1);
|
||
|
|
$mmm = format_month($tmvalues[4], "0");
|
||
|
|
$mmmm = format_month($tmvalues[4], "1");
|
||
|
|
$yy = format_year($tmvalues[5], "0");
|
||
|
|
$yyyy = format_year($tmvalues[5], "1");
|
||
|
|
$ddd = format_day_of_week($tmvalues[6], "0");
|
||
|
|
$dddd = format_day_of_week($tmvalues[6], "1");
|
||
|
|
|
||
|
|
$sformatted =~ s/ss/$ss/ig;
|
||
|
|
$sformatted =~ s/nn/$nn/ig;
|
||
|
|
$sformatted =~ s/hh/$hh/ig;
|
||
|
|
$sformatted =~ s/h/$h/ig;
|
||
|
|
$sformatted =~ s/dddd/$dddd/ig;
|
||
|
|
$sformatted =~ s/ddd/$ddd/ig;
|
||
|
|
$sformatted =~ s/dd/$dd/ig;
|
||
|
|
$sformatted =~ s/mmmm/$mmmm/ig;
|
||
|
|
$sformatted =~ s/mmm/$mmm/ig;
|
||
|
|
$sformatted =~ s/mm/$mm/ig;
|
||
|
|
$sformatted =~ s/yyyy/$yyyy/ig;
|
||
|
|
$sformatted =~ s/yy/$yy/ig;
|
||
|
|
return $sformatted;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_day_of_week {
|
||
|
|
@dayarray = ( ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"],
|
||
|
|
["Sunday", "Monday", "Tuesday", "Wednesday", "Thursday", "Friday", "Saturday"] );
|
||
|
|
return $dayarray[$_[1]][$_[0]];
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_month {
|
||
|
|
@montharray = ( ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"],
|
||
|
|
["January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"] );
|
||
|
|
return $montharray[$_[1]][$_[0]];
|
||
|
|
}
|
||
|
|
|
||
|
|
sub format_year {
|
||
|
|
if ($_[0] > '99') {
|
||
|
|
if ($_[1] == '0') {
|
||
|
|
return sprintf("%02d", $_[0]-100);
|
||
|
|
} else {
|
||
|
|
return sprintf("%04d", $_[0]+1900);
|
||
|
|
}
|
||
|
|
} else {
|
||
|
|
if ($_[1] == '0') {
|
||
|
|
return sprintf("%02d", $_[0]);
|
||
|
|
} else {
|
||
|
|
return sprintf("%04d", $_[0]+1900);
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
}
|
||
|
|
|
||
|
|
# end with True because this is a require file
|
||
|
|
1
|