#!/usr/bin/perl
##########################################################
$version = "korbase.pl version 1.3";
##########################################################
#
# Modified 1999-08-09 by Werner Knudsen (wkn@post1.com)
#
#############################################################################
# Define Variables
# $mailprog defines the location of your sendmail program on your unix
# system. $smtpserver is the name of the smtp server to use, if $usesmtp is set.
use Socket;
use MimeLite;
$mailprog = '/usr/lib/sendmail -oi';
$smtpserver = 'email';
$usesmtp = 0;
$| = 1; # Autoflush
# our script name
$self = $ENV{'SCRIPT_NAME'};
$self = "http://kor.dk/cgi-bin/korbase.pl";
# $configpath defines the base location of the configuration file
# $templatepath defines the base location of the template files
# $datapath defines the base location of the database files
$configpath = '/home/dan12851/public_html/kor/cgi-data';
$templatepath = '/home/dan12851/public_html/kor';
$datapath = '/home/dan12851/public_html/kor/cgi-data';
$statusfile = 'update.js';
$datafile = 'kor.csv';
$database = 'kordb';
$details_template = 'indhold.template';
$show_template = 'liste.template';
$showform_template = 'opdater.htm';
$msg_template = 'msg.htm';
$to = 'wkbackup@gmail.com';
$from = 'webmaster@kor.dk';
$masterpassword = 'wknkor';
# @referers allows forms to be located only on servers which are defined
# in this field. This fixes a security hole in the last version which
# allowed anyone on any server to use your FormMail script.
# Place 'file:///' in the list to allow you to test your forms from your
# PC without having to upload them to your server every time you change them.
@referers = ('kor.dk','dueodde','file:///');
%DKtoENG = (
'Kor' => "Choir",
'Organisation' => "Organization",
'Forlag' => "Publisher",
'Websted' => "Website",
'Anden kategori' => "Other category"
);
##### END of variable declarations ####
&get_date;
&ReadParse( *inddata );
$kor_id = $inddata{"kor_id"};
$todo = $inddata{"to_do"};
$order = $inddata{"order"};
if ($order eq '') { $order = 'Kor-navn'; }
$string = $inddata{"string"};
if ($string eq '') { $string = '.'; }
if ($todo eq 'add') { &addFromCsv(); }
elsif ($todo eq 'testid') { &testid(); }
elsif ($todo eq 'details') { &details(); }
elsif ($todo eq 'show') { &show(); }
elsif ($todo eq 'showform') { &showform(); }
elsif ($todo eq 'update') { &update(); }
elsif ($todo eq 'convertXYZ') { &convert(); }
elsif ($todo eq 'delete') { &delete(); }
elsif ($todo eq 'status') { &statusUpdate($kor_id); &home(); }
elsif ($todo eq 'mail') { &send_mail('Database sendt'); &show(); }
else { &show(); }
exit;
# END OF MAIN PROGRAM
sub home {
print "Content-type: text/html\n";
print "Location: http://kor.dk/home.htm\n\n";
exit;
}
sub testid {
print "Content-type: text/html\n\n";
# print "Location: $service\n\n";
if (&idExists($kor_id)) {
$res = "$kor_id er allerede optaget. Luk dette vidue og prøv med en ny værdi.\n";
} else {
$res = "$kor_id er ledig. Luk dette vindue og fortsæt med oprettelsen.\n";
}
print <<"(END HTML)";
Test af $kor_id
Kor-id: test af $kor_id
$res
(END HTML)
return $fundet;
}
sub idExists {
local ($kor_id) = @_;
$fundet = 0;
if ( open(GB,"$datapath/$datafile") == 0 ) {
die "Cannot open $datapath/$datafile\n";
}
dbmopen %ass, "$datapath/$database", 0666;
#undef %ass;
if (defined $ass{$kor_id}) {
$fundet = 1;
}
dbmclose %ass;
while () {
if ($_ =~ /"(.*)"/) {
@fields = split /";"/, $1;
if ($fields[2] eq $kor_id) {
$fundet = 1;
}
}
}
return $fundet;
}
sub show {
#
# Show basic values
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$show_template") == 0 ) {
#print "test";
#exit;
die "Cannot open $templatepath/$show_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
$lines =~ /(.*)(.*)<\/repeat>(.*)/i;
$front = $1;
$body = $2;
$rear = $3;
$output = $front;
dbmopen %ass, "$datapath/$database", 0666;
%orders = ();
foreach $key (sort keys %ass) {
$value = $ass {$key};
if ($value =~ /$string/i) {
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
&fieldsToNames;
$kornavnSort = lc($kornavn);
if ($order eq 'URL') {
$orders {"$url_dk:$kornavnSort:$key"} = $key;
} elsif ($order eq 'Kategori') {
$orders {"$kategori:$kornavnSort:$key"} = $key;
} elsif ($order eq 'Dato') {
$orders {"$opdateret:$kornavnSort:$key"} = $key;
} else {
$orders {"$kornavnSort:$key"} = $key;
}
}
}
}
$string = $inddata{"string"};
foreach $orderkey (sort keys %orders) {
$key = $orders {$orderkey};
$value = $ass {$key};
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
# print "Fundet: $key, $fields[3].
\n";
&fieldsToNames;
if ($url_dk) {
$korref = "$kornavn";
} else {
$korref = "$kornavn";
}
$korref = "$kornavn";
if ($url_eng) {
$choirref = "$choirname";
} else {
$choirref = "$choirname";
}
$choirref = "$choirname";
if ($url_logo) {
$logoref = "";
} else {
$logoref = "";
}
if ($url_img) {
$imgref = "";
} else {
$imgref = "";
}
$part = $body;
$part =~ s/\$kor_id/$kor_id/g;
$part =~ s/\$kategori/$kategori/g;
$part =~ s/\$category/$category/g;
$part =~ s/\$url_dk/$url_dk/g;
$part =~ s/\$url_eng/$url_eng/g;
$part =~ s/\$kornavn/$kornavn/g;
$part =~ s/\$choirname/$choirname/g;
$part =~ s/\$korref/$korref/g;
$part =~ s/\$choirref/$choirref/g;
$part =~ s/\$url_logo/$url_logo/g;
$part =~ s/\$url_img/$url_img/g;
$part =~ s/\$logoref/$logoref/g;
$part =~ s/\$imgref/$imgref/g;
$part =~ s/\$beskrivelse/$beskrivelse/g;
$part =~ s/\$description/$description/g;
$part =~ s/\$kommentar/$kommentar/g;
$part =~ s/\$land/$land/g;
$part =~ s/\$egenskaber/$egenskaber/g;
$part =~ s/\$anden_kategori/$anden_kategori/g;
$part =~ s/\$andet_land/$andet_land/g;
$output = "$output $part";
$i = 0;
foreach $field (@fields) {
# print "$i --> $field
\n"; $i++;
}
}
}
dbmclose %ass;
$output = "$output $rear";
$output =~ s/\$string/$string/g;
$output =~ s/\$order/$order/g;
print $output;
}
sub details {
#
# Show record details
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$details_template") == 0 ) {
die "Cannot open $templatepath/$details_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n/FunnyN/g;
# $lines =~ s/\r//g;
$lines =~ /(.*)(.*)<\/repeat>(.*)/i;
$front = $1;
$body = $2;
$rear = $3;
$output = $front;
dbmopen %ass, "$datapath/$database", 0666;
%orders = ();
$key = $kor_id;
$value = $ass {$key};
if ($value =~ /$string/i) {
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
&fieldsToNames;
$kornavnSort = lc($kornavn);
if ($order eq 'URL') {
$orders {"$url_dk:$kornavnSort:$key"} = $key;
} elsif ($order eq 'Kategori') {
$orders {"$kategori:$kornavnSort:$key"} = $key;
} elsif ($order eq 'Dato') {
$orders {"$opdateret:$kornavnSort:$key"} = $key;
} else {
$orders {"$kornavnSort:$key"} = $key;
}
}
}
$string = $inddata{"string"};
foreach $orderkey (sort keys %orders) {
$key = $orders {$orderkey};
$value = $ass {$key};
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
# print "Fundet: $key, $fields[3].
\n";
&fieldsToNames;
if ($url_dk) {
$korref = "$kornavn";
} else {
$korref = "$kornavn";
}
if ($url_eng) {
$choirref = "$choirname";
} else {
$choirref = "$choirname";
}
if ($url_logo) {
$logoref = "";
} else {
$logoref = "";
}
if ($url_img) {
$imgref = "";
} else {
$imgref = "";
}
$part = "$output $body";
$part =~ s/\$kor_id/$kor_id/g;
$part =~ s/\$kategori/$kategori/g;
$part =~ s/\$category/$category/g;
$part =~ s/\$url_dk/$url_dk/g;
$part =~ s/\$url_eng/$url_eng/g;
$part =~ s/\$kornavn/$kornavn/g;
$part =~ s/\$choirname/$choirname/g;
$part =~ s/\$korref/$korref/g;
$part =~ s/\$choirref/$choirref/g;
$part =~ s/\$url_logo/$url_logo/g;
$part =~ s/\$url_img/$url_img/g;
$part =~ s/\$logoref/$logoref/g;
$part =~ s/\$imgref/$imgref/g;
$part =~ s/\$beskrivelse/$beskrivelse/g;
$part =~ s/\$description/$description/g;
$part =~ s/\$name/$name/g;
$part =~ s/\$email/$email/g;
$part =~ s/\$kommentar/$kommentar/g;
$part =~ s/\$land/$land/g;
$part =~ s/\$egenskaber/$egenskaber/g;
$part =~ s/\$anden_kategori/$anden_kategori/g;
$part =~ s/\$andet_land/$andet_land/g;
$output = "$part";
$i = 0;
foreach $field (@fields) {
# print "$i --> $field
\n"; $i++;
}
}
}
dbmclose %ass;
$output = "$output $rear";
$output =~ s/\$string/$string/g;
$output =~ s/\$order/$order/g;
$output =~ s/FunnyN/\n/g;
print $output;
}
sub showform {
#
# Show HTML form
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$showform_template") == 0 ) {
die "Cannot open $templatepath/$showform_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
$lines =~ /(.*)(.*)<\/repeat>(.*)/i;
$front = $1;
$body = $2;
$rear = $3;
$output = '';
$part = $lines;
dbmopen %ass, "$datapath/$database", 0666;
$value = $ass {$kor_id};
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
# print "Fundet: $key, $fields[3].
\n";
$msg = "Du kan nu opdatere dine oplysninger. Udfyld alle felter så udførligt, du kan, de vil blive brugt til din præsentation i Kor.dk.";
$part =~ s/\$msg/$msg/g;
&fieldsToNames;
$part =~ s/\$kor_id/$kor_id/g;
$part =~ s/\$password/$password/g;
$part =~ s/\$kornavn/$kornavn/g;
$part =~ s/\$url_dk/$url_dk/g;
$part =~ s/\$choirname/$choirname/g;
$part =~ s/\$url_eng/$url_eng/g;
$part =~ s/\$url_logo/$url_logo/g;
$part =~ s/\$url_img/$url_img/g;
$part =~ s/\$name/$name/g;
$part =~ s/\$email/$email/g;
$part =~ s/\$kategori/$kategori/g;
$part =~ s/\$anden_kategori/$anden_kategori/g;
$part =~ s/\$land/$land/g;
$part =~ s/\$andet_land/$andet_land/g;
$part =~ s/\$beskrivelse/$beskrivelse/g;
$part =~ s/\$description/$description/g;
$part =~ s/\$egenskaber/$egenskaber/g;
$part =~ s/\$kommentar/$kommentar/g;
$output = "$output $part";
}
dbmclose %ass;
$output = "$output $rear";
print $output;
}
sub update {
#
# Update from form input
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$showform_template") == 0 ) {
die "Cannot open $templatepath/$showform_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
$lines =~ /(.*)(.*)<\/repeat>(.*)/i;
$front = $1;
$body = $2;
$rear = $3;
$output = '';
$part = $lines;
$subject = 'opdateret';
dbmopen %ass, "$datapath/$database", 0777;
$value = $ass {$kor_id};
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
# print "Fundet: $key, $fields[3].
\n";
if ($inddata{password} eq $masterpassword) {
$inddata{password} = $fields[3];
}
if ($fields[3] ne $inddata{password}) {
$opdateret = 0;
$msg = "Du har ikke indtastet det rigtige password. Prøv igen.";
} else {
$opdateret = 1;
if ($inddata{nypassword1}) {
if ($inddata{nypassword1} eq $inddata{nypassword2}) {
$inddata{password} = $inddata{nypassword1};
}
}
$subject = "$subject - $fields[2]";
&namesToFields;
$csv = join '";"', @fields;
$csv = "\"$csv\"";
$ass {$kor_id} = $csv;
$msg = "Dine oplysninger er nu opdateret. Du kan lave flere ændringer nedenfor, hvis du ønsker det.";
}
$part =~ s/\$msg/$msg/g;
&fieldsToNames;
$part =~ s/\$kor_id/$kor_id/g;
$part =~ s/\$password/$password/g;
$part =~ s/\$kornavn/$kornavn/g;
$part =~ s/\$url_dk/$url_dk/g;
$part =~ s/\$choirname/$choirname/g;
$part =~ s/\$url_eng/$url_eng/g;
$part =~ s/\$url_logo/$url_logo/g;
$part =~ s/\$url_img/$url_img/g;
$part =~ s/\$name/$name/g;
$part =~ s/\$email/$email/g;
$part =~ s/\$kategori/$kategori/g;
$part =~ s/\$anden_kategori/$anden_kategori/g;
$part =~ s/\$land/$land/g;
$part =~ s/\$andet_land/$andet_land/g;
$part =~ s/\$beskrivelse/$beskrivelse/g;
$part =~ s/\$description/$description/g;
$part =~ s/\$egenskaber/$egenskaber/g;
$part =~ s/\$kommentar/$kommentar/g;
$output = "$output $part";
#print "((( $part )))
\n";
}
dbmclose %ass;
$output = "$output $rear";
print "$output";
if ($opdateret) {
&send_mail($subject);
}
}
sub delete {
#
# Delete entry
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$msg_template") == 0 ) {
die "Cannot open $templatepath/$msg_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
$lines =~ /(.*)(.*)<\/repeat>(.*)/i;
$front = $1;
$body = $2;
$rear = $3;
$output = '';
$part = $lines;
$subject = 'slettet';
dbmopen %ass, "$datapath/$database", 0777;
$value = $ass {$kor_id};
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
# print "Fundet: $key, $fields[3].
\n";
if (($fields[3] ne $inddata{password}) && ($inddata{password} ne $masterpassword)) {
$opdateret = 0;
$msg = "Kor-id og password passer ikke sammen. Prøv igen.";
} else {
$opdateret = 1;
$subject = "$subject - $fields[2]";
delete $ass{$kor_id};
$msg = "Kor-id $kor_id er nu slettet.";
}
$part =~ s/\$msg/$msg/g;
$output = "$output $part";
}
dbmclose %ass;
$output = "$output $rear";
print $output;
if ($opdateret) {
&send_mail($subject);
}
}
sub addFromCsv {
#
# Add records from csv text file
#
print "Content-type: text/html\n\n";
if ( open(GB,"$templatepath/$msg_template") == 0 ) {
die "Cannot open $templatepath/$msg_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
if ( open(GB,"$datapath/$datafile") == 0 ) {
die "Cannot open $datapath/$datafile\n";
}
dbmopen %ass, "$datapath/$database", 0777;
# undef %ass;
$msg = '';
$subject = 'aktiveret';
$activated = '';
while () {
if ($_ =~ /"(.*)"/) {
@fields = split /";"/, $1;
if (!defined $ass{$fields[2]}) {
if (($fields[2] eq $kor_id) or ($kor_id eq '.')) {
$activated = $fields[2];
$ass{$fields[2]} = $_;
$subject = "$subject - $fields[2]";
$msg = "$msg Aktiveret: $fields[2].
\n";
}
}
}
}
close GB;
dbmclose %ass;
if ($activated) {
&statusUpdate ($activated);
}
$lines =~ s/\$msg/$msg/g;
$output = $lines;
print $output;
&send_mail($subject);
}
sub convert {
#
# To be used for database conversions
#
print "Content-type: text/html\n\n";
$datafile = 'kor.csv';
$datafile = 'kor.20101008.txt';
if ( open(GB,"$templatepath/$msg_template") == 0 ) {
die "Cannot open $templatepath/$msg_template\n";
}
while () {
$lines = "$lines $_";
}
close GB;
$lines =~ s/\n//g;
$lines =~ s/\r//g;
if ( open(GB,"$datapath/$datafile") == 0 ) {
die "Cannot open $datapath/$datafile\n";
}
dbmopen %ass, "$datapath/$database", 0777;
undef %ass;
$msg = '';
$subject = 'konverteret';
$activated = '';
while () {
if ($_ =~ /"(.*)"/) {
@fields = split /";"/, $1;
if (!defined $ass{$fields[2]}) {
# if (($fields[2] eq $kor_id) or ($kor_id eq '.')) {
if ($fields[2] eq $kor_id) {
$activated = $fields[2];
$ass{$fields[2]} = $_;
$subject = "$subject - $fields[2]";
$msg = "$msg Konverteret: $fields[2].
\n";
}
}
}
}
close GB;
dbmclose %ass;
if ($activated) {
&statusUpdate ($activated);
}
$lines =~ s/\$msg/$msg/g;
$output = $lines;
print $output;
&send_mail($subject);
}
sub fieldsToNames {
#
# Convert from hash to variables
#
$opdateret = $fields[0];
$kor_id = $fields[2];
$password = $fields[3];
$url_dk = $fields[5];
$url_eng = $fields[7];
$kornavn = $fields[4];
$choirname = $fields[6];
if ($url_dk eq 'http://') { $url_dk = ''; }
if ($url_eng eq 'http://') { $url_eng = ''; }
if (($url_eng eq '') and ($choirname)) { $url_eng = $url_dk; }
if (($url_dk eq '') and ($kornavn)) { $url_dk = $url_eng; }
if ($kornavn eq '') { $kornavn = $url_dk; }
if ($choirname eq '') { $choirname = $url_eng; }
$url_logo = $fields[8];
$url_img = $fields[9];
if ($url_logo eq 'http://') { $url_logo = ''; }
if ($url_img eq 'http://') { $url_img = ''; }
$name = $fields[10];
$email = $fields[11];
$kategori = $fields[12];
$category = $DKtoENG{$kategori};
$anden_kategori = $fields[13];
$land = $fields[14];
$andet_land = $fields[15];
$beskrivelse = $fields[16];
$description = $fields[17];
$egenskaber = $fields[18];
$kommentar = $fields[19];
}
sub namesToFields {
#
# Convert from input fields to hash
#
$fields[0] = $date ;
$fields[1] = '' ;
$fields[2] = $inddata{'kor_id'} ;
$fields[3] = $inddata{'password'} ;
$fields[4] = $inddata{'kornavn'} ;
$fields[5] = $inddata{'url_dk'} ;
$fields[6] = $inddata{'choirname'} ;
$fields[7] = $inddata{'url_eng'} ;
$fields[8] = $inddata{'url_logo'} ;
$fields[9] = $inddata{'url_img'} ;
$fields[10] = $inddata{'name'} ;
$fields[11] = $inddata{'email'} ;
$fields[12] = $inddata{'kategori'} ;
$fields[13] = $inddata{'anden_kategori'} ;
$fields[14] = $inddata{'land'} ;
$fields[15] = $inddata{'andet_land'} ;
$fields[16] = $inddata{'beskrivelse'} ;
$fields[16] =~ s/\n/
/g;
$fields[16] =~ s/\r//g;
$fields[17] = $inddata{'description'} ;
$fields[17] =~ s/\n/
/g;
$fields[17] =~ s/\r//g;
$fields[18] = $inddata{'egenskaber'} ;
$fields[18] =~ s/\n/
/g;
$fields[18] =~ s/\r//g;
$fields[19] = $inddata{'kommentar'} ;
$fields[19] =~ s/\n/
/g;
$fields[19] =~ s/\r//g;
}
sub statusUpdate {
#
# Update status javascript file
#
local ($id) = @_;
# Data
dbmopen %ass, "$datapath/$database", 0666;
$kor_id = '';
@k = keys %ass;
$antal = @k + 0;
$value = $ass {$id};
if ($value =~ /$string/i) {
if ($value =~ /"(.*)"/) {
@fields = split /";"/, $1;
&fieldsToNames;
}
}
dbmclose %ass;
if (! $kor_id) {return;}
unless (open (OUT, ">$templatepath/$statusfile")) { $err="$err Fejl: kunne ikke skrive til $templatepath/$statusfile $!\n"; return;}
else {
flock(OUT,2);
print OUT "var antalMedl = $antal;\n";
print OUT "var kor_id = \"$kor_id\";\n";
print OUT "var url_dk = \"$url_dk\";\n";
print OUT "var url_eng = \"$url_eng\";\n";
print OUT "var kornavn = \"$kornavn\";\n";
print OUT "var choirname = \"$choirname\";\n";
$dato = substr $opdateret, 0, 10;
print OUT "var lastupdate = \"$dato\";\n";
flock(OUT,8);
close (OUT);
}
}
sub send_mail {
#
# Send mail about updates
#
local ($subject) = @_;
# Data
dbmopen %ass, "$datapath/$database", 0666;
$csvline = '';
foreach $key (sort keys %ass) {
$value = $ass {$key};
$csvline = "$csvline$value\n";
}
dbmclose %ass;
unless (open (OUT, ">$datapath/$datafile.txt")) { $err="$err Fejl: kunne ikke skrive til kopi $datapath/$datafile.txt $!\n"; return;}
else {
flock(OUT,2);
print OUT "$csvline";
flock(OUT,8);
close (OUT);
}
# Create a new multi-part message:
$msg = new MIME::Lite
From =>"$from",
To =>"$to",
Cc =>"",
Subject =>"Kor.dk $subject",
Type =>'multipart/mixed';
attach $msg
Type =>'TEXT',
Data =>"Kor.dk $subject";
attach $msg
Type =>'TEXT',
Path =>"$datapath/$datafile.txt",
Filename =>"$datafile.txt",
Encoding =>'quoted-printable';
&open_mail();
$msg->print(\*MAIL);
&close_mail();
}
sub send_mail_no_attach {
#
# Send mail about updates
#
local ($subject) = @_;
# Open The Mail Program
&open_mail();
print MAIL "To: $to\n";
print MAIL "From: $from\n";
print MAIL "Reply-to: $from\n";
print MAIL "Subject: kor.dk $subject\n\n";
# Data
dbmopen %ass, "$datapath/$database", 0666;
$csvline = '';
foreach $key (sort keys %ass) {
$value = $ass {$key};
$csvline = "$csvline$value\n";
}
dbmclose %ass;
print MAIL $csvline;
# Close the Mail Program
&close_mail();
}
sub open_mail {
# Open MAIL file handle
if ($usesmtp) {
#print "HTTP/1.0 200 OK\n" if ($ENV{'PERLXS'} eq "PerlIS");
#print "Content-type: text/html\n\n";
# Use smtp for mail
$proto = (getprotobyname('tcp'))[2];
$port = (getservbyname('smtp', 'tcp'))[2];
$thisaddr = (gethostbyname(""))[4];
$smptaddr = (gethostbyname($smtpserver))[4];
$this = pack('Sna4x8', AF_INET, 0, $thisaddr);
$smtp = pack('Sna4x8', AF_INET, $port, $smptaddr);
if (!socket(MAIL, AF_INET, SOCK_STREAM, $proto)) { die $!; }
if (!bind(MAIL, $this)) { die $!; }
if (!connect(MAIL, $smtp)) { die $!; }
$oldfh = select(MAIL); $| = 1; select($oldfh);
if (eof(MAIL))
{
print "OOPS ! eof(MAIL) == TRUE
";
exit(-1);
}
$_ = ; if (/^[45]/) { close MAIL; die "$_
\n"; }
print MAIL "helo localhost\r\n";
print MAIL "mail from: <$from>\r\n";
$emails = $to;
while ($emails =~ /[^\w\.\@]*([\w\.]+\@[\w\.]+)/g) {
print MAIL "rcpt to: <$1>\r\n";
}
print MAIL "data\r\n";
} else {
# Use mail program (sendmail) for mail
open(MAIL,"|$mailprog -t");
}
}
sub close_mail {
# close MAIL file handle
if ($usesmtp) {
# close smtp session
print MAIL "\r\n.\r\n";
print MAIL "quit\r\n";
$_ = ; if (/^[45]/) { close MAIL; die "$_
\n"; }
}
close (MAIL);
}
sub get_date {
if ($language eq 'english') {
# Language: English. #
# Define arrays for the day of the week and month of the year. #
@days = ('Sunday','Monday','Tuesday','Wednesday',
'Thursday','Friday','Saturday');
@months1 = ('01','02','03','04','05','06','07','08','09','10','11','12');
@months2 = ('January','February','March','April','May','June','July',
'August','September','October','November','December');
# Get the current time and format the hour, minutes and seconds. Add #
# 1900 to the year to get the full 4 digit year. #
($sec,$min,$hour,$mday,$mon,$year,$year2,$wday) = (localtime(time))[0,1,2,3,4,5,5,6];
$time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
$year2 += 1900;
# Format the date. #
$dater = "$days[$wday], $months2[$mon] $mday, $year2 at $time";
$date = "$year2/$months1[$mon]/$mday/$time";
} else {
# Default language: Danish. #
# Define arrays for the day of the week and month of the year. #
@days = ('Søndag','Mandag','Tirsdag','Onsdag',
'Torsdag','Fredag','Lørdag');
@months1 = ('01','02','03','04','05','06','07','08','09','10','11','12');
@months2 = ('januar','februar','marts','april','maj','juni','juli',
'august','september','oktober','november','december');
# Get the current time and format the hour, minutes and seconds. Add #
# 1900 to the year to get the full 4 digit year. #
($sec,$min,$hour,$mday,$mon,$year,$year2,$wday) = (localtime(time))[0,1,2,3,4,5,5,6];
$time = sprintf("%02d:%02d:%02d",$hour,$min,$sec);
$year2 += 1900;
# Format the date. #
$dater = "$days[$wday], $mday. $months2[$mon] $year2 kl. $time";
$date = "$year2/$months1[$mon]/$mday/$time";
}
}
# ----------
sub FixDate {
# dayname, month, day, time, year
$datepattern='\s*(\w*)\s*(\w*)\s*(\d*)\s*([:|\d]*)\s*\w*\s*(\d*)';
$date =~ /$datepattern/;
$date = "$1 $3\. $2 $5 $4";
# dansk...
$date =~ s/Mon/Man/;
$date =~ s/Tue/Tir/;
$date =~ s/Wed/Ons/;
$date =~ s/Thu/Tor/;
$date =~ s/Fri/Fre/;
$date =~ s/Sat/Lør/;
$date =~ s/Sun/Søn/;
}
# ----------
sub ReadParse {
local (*in) = @_ if @_;
local ($i, $key, $val);
# Read in text
if (&MethGet) {
$in = $ENV{'QUERY_STRING'};
} elsif (&MethPost) {
read(STDIN,$in,$ENV{'CONTENT_LENGTH'});
}
@in = split(/[&;]/,$in);
foreach $i (0 .. $#in) {
# Convert plus's to spaces
$in[$i] =~ s/\+/ /g;
# Split into key and value.
($key, $val) = split(/=/,$in[$i],2); # splits on the first =.
# Convert %XX from hex numbers to alphanumeric
$key =~ s/%(..)/pack("c",hex($1))/ge;
$val =~ s/%(..)/pack("c",hex($1))/ge;
# Associate key and value
$in{$key} .= "\0" if (defined($in{$key})); # \0 is the multiple separator
$in{$key} .= $val;
}
return scalar(@in);
}
# PrintHeader
# Returns the magic line which tells WWW that we're an HTML document
sub PrintHeader {
return "Content-type: text/html\n\n";
}
# MethGet
# Return true if this cgi call was using the GET request, false otherwise
sub MethGet {
return ($ENV{'REQUEST_METHOD'} eq "GET");
}
# MethPost
# Return true if this cgi call was using the POST request, false otherwise
sub MethPost {
return ($ENV{'REQUEST_METHOD'} eq "POST");
}
# MyURL
# Returns a URL to the script
sub MyURL {
local ($port);
$port = ":" . $ENV{'SERVER_PORT'} if $ENV{'SERVER_PORT'} != 80;
return 'http://' . $ENV{'SERVER_NAME'} . $port . $ENV{'SCRIPT_NAME'};
}
# CgiError
# Prints out an error message which which containes appropriate headers,
# markup, etcetera.
# Parameters:
# If no parameters, gives a generic error message
# Otherwise, the first parameter will be the title and the rest will
# be given as different paragraphs of the body
sub CgiError {
local (@msg) = @_;
local ($i,$name);
if (!@msg) {
$name = &MyURL;
@msg = ("Error: script $name encountered fatal error");
};
print &PrintHeader;
print "$msg[0]\n";
print "$msg[0]
\n";
foreach $i (1 .. $#msg) {
print "$msg[$i]
\n";
}
print "\n";
}
# CgiDie
# Identical to CgiEror, but also quits with the passed error message.
sub CgiDie {
local (@msg) = @_;
&CgiError (@msg);
die @msg;
}
# PrintVariables
# Nicely formats variables in an associative array passed as a parameter
# And returns the HTML string.
sub PrintVariables {
local (%in) = @_;
local ($old, $out, $output);
$old = $*; $* =1;
$output .= "\n\n";
foreach $key (sort keys(%in)) {
foreach (split("\0", $in{$key})) {
($out = $_) =~ s/\n/
\n/g;
$output .= "- $key\n
- $out
\n";
}
}
$output .= "
\n";
$* = $old;
return $output;
}
# PrintVariablesShort
# Now obsolete; just calls PrintVariables
sub PrintVariablesShort {
return &PrintVariables(@_);
}
1; #return true