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.
184 lines
5.2 KiB
184 lines
5.2 KiB
4 months ago
|
#!/usr/bin/perl -w
|
||
|
#
|
||
|
# $Id: genutil.pl,v 1.3 2005/02/09 21:23:40 ddoughty Exp $
|
||
|
#
|
||
|
# genutil.pl : Generic, application-independent utilities
|
||
|
#
|
||
|
# Don't put stuff in here if it has any dependencies on the application.
|
||
|
#
|
||
|
|
||
|
############################################################################
|
||
|
#
|
||
|
# Function: munge( $string )
|
||
|
# Description: Do the normal munging to replace certain chars with %XX.
|
||
|
# Returns: a modified string with %XX patterns inserted
|
||
|
# Author: efl, 11/2001
|
||
|
#
|
||
|
############################################################################
|
||
|
sub munge( $ ) {
|
||
|
my ($string) = @_;
|
||
|
$string =~ s/([\'\"\?\&\\!\$\#\@\*\;\:\r\n])/join('', '%', uc(unpack("H*",$1)))/eg;
|
||
|
return $string;
|
||
|
}
|
||
|
|
||
|
############################################################################
|
||
|
#
|
||
|
# Function: unmunge( $string )
|
||
|
# Description: Inverse operation of munge(), replace %XX with the real ascii.
|
||
|
# Returns: a modified string with %XX patterns replaced
|
||
|
# Author: efl, 11/2001
|
||
|
#
|
||
|
############################################################################
|
||
|
sub unmunge( $ ) {
|
||
|
my ($string) = @_;
|
||
|
$string =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
|
||
|
return $string;
|
||
|
}
|
||
|
|
||
|
############################################################################
|
||
|
# Function: escape_special_chars( $string )
|
||
|
# Description: Replace special chars with their escapes from spec
|
||
|
# ISO 8879:1986//ENTITIES Numeric and Special Graphic//EN
|
||
|
# Returns: a modified string with &xxx; patterns inserted
|
||
|
# Author: efl, 1/2002
|
||
|
#
|
||
|
############################################################################
|
||
|
my $escape_map = {
|
||
|
'"' => '"',
|
||
|
'&' => '&',
|
||
|
'<' => '<',
|
||
|
'>' => '>',
|
||
|
};
|
||
|
|
||
|
sub get_escape( $ ) {
|
||
|
my ($char) = shift;
|
||
|
if ( ! defined($escape_map->{$char}) ) {
|
||
|
logger::logerr("WARNING: undefined escape for '$char'");
|
||
|
}
|
||
|
return $escape_map->{$char};
|
||
|
}
|
||
|
|
||
|
sub escape_special_chars( $ ) {
|
||
|
my ($string) = @_;
|
||
|
$string =~ s/([\"&<>])/get_escape($1)/eg;
|
||
|
return $string;
|
||
|
}
|
||
|
|
||
|
############################################################################
|
||
|
#
|
||
|
# Function: strip_blanks( $string, $opts )
|
||
|
# Description: Strips blanks from a string
|
||
|
# If $opts->{leftonly} is true, then we strip only from the left end.
|
||
|
# If $opts->{rightonly} is true, then we strip only from the right end.
|
||
|
# If $opts->{all} is true, then we strip embedded blanks as well.
|
||
|
# Default behavior is to strip from both ends until 1st non-blank.
|
||
|
# Returns: a modified string
|
||
|
# Author: efl, 1/2002
|
||
|
#
|
||
|
############################################################################
|
||
|
sub strip_blanks {
|
||
|
my ($string, $opts) = @_;
|
||
|
|
||
|
my $in = $string;
|
||
|
|
||
|
if ( ! $opts->{rightonly} ) {
|
||
|
$string =~ s/^\s+(.*)/$1/g;
|
||
|
}
|
||
|
|
||
|
if ( ! $opts->{leftonly} ) {
|
||
|
$string =~ s/(.*)\s+$/$1/g;
|
||
|
}
|
||
|
|
||
|
if ( $opts->{all} ) {
|
||
|
$string =~ s/\s//g;
|
||
|
}
|
||
|
|
||
|
return $string;
|
||
|
}
|
||
|
|
||
|
|
||
|
############################################################################
|
||
|
#
|
||
|
# Function: valid_date( $year, $monthnum, $daynum)
|
||
|
# Description: Tell if a year/month/day combo is valid.
|
||
|
# Returns: 1 if valid, 0 if not
|
||
|
# Author: efl, 1/2002
|
||
|
# Modified: DED, 2/2005
|
||
|
#
|
||
|
############################################################################
|
||
|
sub valid_date( $ $ $ ) {
|
||
|
my ($year, $monthnum, $daynum) = @_;
|
||
|
|
||
|
if ( $daynum > 31 ) {
|
||
|
return 0;
|
||
|
} elsif ( $daynum == 31 &&
|
||
|
( $monthnum == 9 ||
|
||
|
$monthnum == 4 ||
|
||
|
$monthnum == 6 ||
|
||
|
$monthnum == 11 ) ) {
|
||
|
|
||
|
# "30 days has September, April, June, and November..."
|
||
|
return 0;
|
||
|
|
||
|
} elsif ( $monthnum == 2 && ($daynum > 29 || ($daynum == 29 && !($year % 4 == 0 && $year % 100 != 0))) ) {
|
||
|
return 0;
|
||
|
}
|
||
|
|
||
|
if ( $monthnum > 12 || $monthnum < 1 ) {
|
||
|
return 0;
|
||
|
}
|
||
|
|
||
|
# arbitrary year check...
|
||
|
if ( $year < 0 ) {
|
||
|
return 0;
|
||
|
}
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
############################################################################
|
||
|
#
|
||
|
# Function: datetime_to_secssince1970( $datetime )
|
||
|
# Description: Converts a string of the form MM/DD/YYYY or MM/DD/YYYY-HH:MM
|
||
|
# into seconds since 1970.
|
||
|
# Returns: secs since 1970, or 'undef' if failure
|
||
|
# Author: efl, 1/2002
|
||
|
#
|
||
|
############################################################################
|
||
|
sub datetime_to_secssince1970( $ ) {
|
||
|
my ($datetime) = @_;
|
||
|
|
||
|
my ($mon,$day,$year,$hour,$minute);
|
||
|
if ( $datetime =~ /^\s*(\d{1,2})\/(\d{1,2})\/(\d{4})\s*$/ ) {
|
||
|
($mon, $day, $year,$hour,$minute) = ($1,$2,$3,0,0);
|
||
|
} elsif ( $datetime =~ /^\s*(\d{1,2})\/(\d{1,2})\/(\d{4})-(\d\d):(\d\d)\s*$/ ) {
|
||
|
($mon, $day, $year,$hour,$minute) = ($1,$2,$3,$4,$5);
|
||
|
} else {
|
||
|
&logger::logerr("Unrecognized date format: [$datetime]");
|
||
|
return undef;
|
||
|
}
|
||
|
$mon -= 1;
|
||
|
$year = $year - 1900;
|
||
|
|
||
|
my $secs = POSIX::strftime("%s",0,$minute, $hour, $day, $mon, $year);
|
||
|
|
||
|
if ( $secs == -1 ) {
|
||
|
&logger::logerr("Unable to convert datetime [$datetime]");
|
||
|
}
|
||
|
|
||
|
return $secs;
|
||
|
}
|
||
|
|
||
|
|
||
|
sub genutil_test {
|
||
|
print "Content-Type: text/html\n\n";
|
||
|
|
||
|
my $in = "Ed's first test? Yes!! E-mail me at foo\@bar.com & talk.";
|
||
|
print "munge($in) = ".munge($in)."\n";
|
||
|
print "unmunge(munge($in)) = ".unmunge(munge($in))."\n";
|
||
|
|
||
|
return 1;
|
||
|
}
|
||
|
|
||
|
1;
|