#!/usr/bin/perl
##
## tc-utils.pl
## Some functions I frequentely uses in my cgi-scripts
##
## Copyright (C) 1999 Toni Cornelissen (toni@dse.nl)
##
## This program is free software; you can redistribute it and/or
## modify it under the terms of the GNU General Public License
## as published by the Free Software Foundation; either version 2
## of the License, or (at your option) any later version.
##
## This program is distributed in the hope that it will be useful,
## but WITHOUT ANY WARRANTY; without even the implied warranty of
## MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
## GNU General Public License for more details.
##
## You should have received a copy of the GNU General Public License
## along with this program; if not, write to the Free Software
## Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
##
require 'network.pl'; ## required for www.pl
require 'www.pl'; ## main routines
sub ASCII2HTML {
$code = shift;
## replace special characters
$code =~ s/&/&/gs;
$code =~ s//>/gs;
$code =~ s/"/"/gs;
## newlines are breaks
##$code =~ s/\n/
\n/gs;
##$code =~ s/ / /gs;
$code;
}
sub CGIMessage {
my $title = shift;
my @message = @_;
my $page =
"Content-type: text/html\n\n" .
"$title$title
";
foreach $line (@message) { $page .= $line }
$page;
}
sub ExtractFoot {
my $foottag = shift;
my $template = shift;
my $foot = "";
## Check if a foottag is present in the template
if ($template =~ /$foottag/) {
$foot = $template;
## the footer is the part after the foottag
$foot =~ s/.*$foottag/$foottag/s;
}
if (not $foot) {
## default footer
$foot =
"\n" .
"\n";
}
$foot;
} ## ExtractFoot;
sub ExtractHead {
my $headtag = shift;
my $template = shift;
my $head = "";
## Check if a headtag is present in the template
if ($template =~ /$headtag/) {
$head = $template;
## the header is the part until the bodytag
$head =~ s/$headtag.*/$headtag/s;
}
if (not $head) {
## Default header
$head =
"" .
"\n" .
"\n" .
"\n" .
"\n" .
"\n";
}
$head;
} ## ExtractHead
sub OpenURL {
my $URL = $_[0];
###print "url: $URL
\n";###
my ($status, $memo) = &www'open_http_url(*IN, $URL, 'quiet'); ## connect
if ($status ne 'ok') {
print "Content-type: text/html\n\nError: $memo ($URL)";
exit;
}
*IN;
} ## OpenURL
sub ReadUntil {
#
# Reads from *IN up and until the $until string is read or end of file
# is reached
#
local *IN = $_[0];
my $until = $_[1];
my @content = ();
my $continue = 1;
my $line = "";
while ($continue) {
$continue = ($line = );
if ($continue) {
(@content) = (@content, $line);
}
$continue = (($line !~ /$until/) && ($continue));
} ## while
@content;
} ## ReadUntil
sub ReadURL {
my $template_url = shift;
my $template = "";
## read only if template_url exists and is not empty
if ($template_url) {
## read template
*IN = &OpenURL($template_url);
while () {
$template .= $_;
}
}
$template;
} ## ReadURL;
sub TemplateURL {
my %env = @_;
my $template_url = "";
## if the template name was given as a parameter, use that
if (defined($env{'template'})) {
$template_url = $env{'template'};
}
## else treat the reffering page as template
else {
$template_url = $env{'HTTP_REFERER'};
}
$template_url;
} ## TemplateURL
sub date {
my %Month = (
uk => [
"January", "February", "March", "April",
"May", "June", "July", "August",
"September", "October", "November", "December"],
nl => [
"januari", "februari", "maart", "april",
"mei", "juni", "juli", "augustus",
"september", "oktober", "november", "december"]
);
my %Day = (
uk => [
"Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saterday"],
nl => [
"zondag", "maandag", "dinsdag", "woensdag",
"donderdag", "vrijdag", "zaterdag"]
);
my $lang = shift;
if ((!$lang) || ($lang !~ /^(nl)$/)) { $lang = "uk"; }
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime;
if ($sec < 10) { $sec = "0$sec"; }
if ($min < 10) { $min = "0$min"; }
$year += 1900;
"$Day{$lang}[$wday] $mday $Month{$lang}[$mon] $year / $hour:$min:$sec";
} ## date
sub DateString {
my %Month = (
uk => [
"January", "February", "March", "April",
"May", "June", "July", "August",
"September", "October", "November", "December"],
nl => [
"januari", "februari", "maart", "april",
"mei", "juni", "juli", "augustus",
"september", "oktober", "november", "december"]
);
my %Day = (
uk => [
"Sunday", "Monday", "Tuesday", "Wednesday",
"Thursday", "Friday", "Saterday"],
nl => [
"zondag", "maandag", "dinsdag", "woensdag",
"donderdag", "vrijdag", "zaterdag"]
);
my $date = shift;
my $lang = shift;
if ($lang !~ /^(nl)$/) { $lang = "uk"; }
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = gmtime($date);
if ($sec < 10) { $sec = "0$sec"; }
if ($min < 10) { $min = "0$min"; }
$year += 1900;
## "$Day{$lang}[$wday] $mday $Month{$lang}[$mon] $year / $hour:$min:$sec";
"$mday $Month{$lang}[$mon] $year";
} ## DateSting
sub SendMail {
my $content = shift;
my $to = shift;
my $cc = shift;
my $subject = shift;
my $from = shift;
my $MAIL = "/usr/sbin/sendmail";
open (M, "|$MAIL -t") || die "Cannot open: $MAIL\n";
print M "To: $to\n";
if ($from) { print M "From: $from\n"; }
if ($subject) { print M "Subject: $subject\n"; }
if ($cc) { print M "CC:\t$cc\n"; }
print M $content;
close(M);
} ## SendMail
1; ## require returns true;