#!/usr/bin/perl -w
use strict;
use warnings;
###############################
# CONSTANTS
my $ABSOLUTE_PATH = '/home/lentnews05/public_html';
my $SUCCESS = 0;
my $FAILURE = 1;
###############################
# PROGRAM STARTS HERE
my $INPUT = $ENV{"QUERY_STRING"};
if (!$INPUT) { FAILED("Please provide the Event Number in the address bar followed by a question mark."); exit; }
if (isNaN($INPUT))
{ FAILED("Please provide the Event Number in the address bar."); exit; }
if (length($INPUT) > 10)
{ FAILED("The Event Number cannot be longer than 10 digits."); exit; }
my $NEW_EVENT = $INPUT;
###############################
# MAIN PROGRAM
UPDATE($ABSOLUTE_PATH . '/main.htm');
UPDATE($ABSOLUTE_PATH . '/index.htm');
UPDATE($ABSOLUTE_PATH . '/index.html');
# Success
print "Content-type: text/html\n\n";
print "Update Successful\n";
print "\n";
print "Update Successful.
\n";
print "Event Number = $NEW_EVENT
\n";
print "\n";
exit;
###############################
# This function displays an
# error message.
#
sub FAILED
{
my $MSG = shift;
# Error message
print "Content-type: text/html\n\n";
print "Error\n";
print "\n";
print "Website did not update.
\n";
print "Error: $MSG
\n";
print "\n";
}
###############################
# This function overwrites the
# Event Number in the index file.
#
sub UPDATE
{
my $P;
my $DATA1;
my $DATA2;
my $FileName = shift;
my $DATA = ReadFile($FileName);
if (length($DATA) == 0)
{ FAILED("Couldn't read $FileName"); exit; }
$P = index($DATA, 'EVENT_NO = ');
if ($P < 0) { FAILED("Couldn't find EVENT_NO in $FileName"); exit; }
$DATA1 = substr($DATA, 0, $P);
$P = index($DATA, ';', $P);
if ($P < 0) { FAILED("$FileName doesn't have a proper text body."); exit; }
$DATA2 = substr($DATA, $P+1);
$DATA = $DATA1 . "EVENT_NO = $NEW_EVENT;" . $DATA2;
if (WriteFile($FileName, $DATA))
{ FAILED("Couldn't write to file - $FileName"); exit; }
}
################################################
#
# This function reads an entire file silently
# in raw binary mode and returns the contents
# in one big string. If an error occurs,
# an empty string is returned.
#
# Usage: STRING = ReadFile( FILE_NAME )
#
sub ReadFile
{
my $N;
my $DATA;
my $filename = shift;
return '' if !(-f $filename);
my $filesize = -s $filename;
if ($filesize == 0) { return ''; }
open(my $FILE, '<:raw', $filename) or return '';
$N = read($FILE, $DATA, $filesize);
close $FILE;
if (!defined $N) { return ''; }
return substr $DATA, 0, $N;
}
################################################
# This function adds some text to the end of
# a file or returns 1 if something went wrong.
#
# Usage: STATUS = AppendFile( FILE_NAME, STRING )
#
sub AppendFile
{
my ($filename, $DATA) = @_;
open(my $FILE, '>>', $filename) or return 1;
print $FILE $DATA or return 1;
close $FILE or return 1;
return 0;
}
################################################
sub WriteFile
{
my ($filename, $DATA) = @_;
open(my $FILE, '>', $filename) or return 1;
print $FILE $DATA or return 1;
close $FILE or return 1;
return 0;
}
################################################
# Prints a horizontal line to STDOUT.
#
# Usage: HR(OPTIONAL_STRING_BYTE)
#
# HR(); ---> ----------------------------
# HR('='); ---> ============================
#
#
sub HR
{
my $C = '-';
if ((scalar @_) > 0) { $C = shift; }
print "\n" . (substr($C, 0, 1)) x 80;
}
################################################
# This function extracts arguments from an URL
# string and returns them in pairs.
#
# Example: @R = getArgsURL("http://www.lentnews05.org/g/ar.cgi?c=123055&s=%28Top+Stories+%29#PGTOP");
# R[0] ---> "c"
# R[1] ---> "123055"
# R[2] ---> "s"
# R[3] ---> "(Top Stories)"
#
sub getArgsURL
{
my $S = shift;
my @OUTPUT;
my @X;
my $P;
$S = strAfter($S, '?');
$S = strBefore($S, '#');
@X = split('&', $S);
foreach $S (@X)
{
splitAB($S, '=');
push(@OUTPUT, decodeURLstr($a));
push(@OUTPUT, decodeURLstr($b));
}
return @OUTPUT;
}
################################################
# This function works almost like split()
# however it will only split STRING into two
# chunks. If the pattern is found, the section before
# the first occurrence of PATTERN goes into $a,
# and rest goes into $b.
#
# (This function has no return value. It just
# simply changes the values of $a and $b.)
#
# Usage : splitAB(STRING, PATTERN)
#
sub splitAB
{
my $S = shift;
my $P = shift;
$a = $b = '';
if (length($S) == 0) { return; }
if (length($P) == 0) { $a = $S; return; }
my $N = index($S, $P);
if ($N < 0) { $a = $S; return; }
$a = substr $S, 0, $N;
$b = substr $S, $N + length($P);
}
################################################
# This function returns the first half of STRING
# that comes before the first occurrence of PATTERN.
# If PATTERN is not found, then returns an empty string.
#
# Usage: STRING strBefore(STRING, PATTERN)
#
sub strBefore
{
my $STRING = shift;
my $PATTERN = shift;
my $P = index($STRING, $PATTERN);
return '' if ($P < 0);
return substr($STRING, 0, $P);
}
################################################
# This function returns the last half of STRING
# that comes after the first occurrence of PATTERN.
# If PATTERN is not found, then returns an empty string.
#
# Usage: STRING strAfter(STRING, PATTERN)
#
sub strAfter
{
my $STRING = shift;
my $PATTERN = shift;
my $P = index($STRING, $PATTERN);
return '' if ($P < 0);
return substr($STRING, $P + length($PATTERN));
}
############################################
#
# This function works like the index() function,
# except it looks for individual characters
# instead of an exact string match. It returns
# the position of the first single character in
# STRING that matches any of the characters in
# CHRS. If none of the characters in STRING
# match any character in CHRS, -1 is returned.
# Matching is case sensitive.
#
# If a third argument is supplied, this function
# works the opposite way: it returns the position
# of the first NON-matching character.
#
# Usage: INTEGER strchr(STRING, CHRS)
# INTEGER strchr(STRING, CHRS, MODE)
#
# Example: strchr("cat5hr", "0123456789") ---> 3
# strchr("sharks", "0123456789") ---> -1
# strchr("2,587.91", "0123456789.,", 0) ---> -1
# strchr("2,5?7.91", "0123456789.,", 0) ---> 3
#
sub strchr
{
my $STRING = shift;
my $CHRS = shift;
my $MODE = ((scalar @_) > 0) ? 1 : 0;
my $C;
for (my $i = 0; $i < length($STRING); $i++)
{
$C = substr($STRING, $i, 1);
if (((index($CHRS, $C)) < 0 ? 1 : 0) == $MODE)
{ return $i; }
}
return -1;
}
############################################
#
# This function compares characters in STRING1
# against a list of legal characters listed
# in STRING2 to see if any character in STRING1
# is not found in STRING2. If all match, the
# return value is 1. If even just one of the
# characters in STRING1 is not found anywhere
# in STRING2, the return value is 0.
# Matching is case sensitive.
#
# Usage: INTEGER chrset(STRING1, STRING2)
#
# Example: chrset("221", "12345") ---> 1
# chrset("21x", "12345") ---> 0
# chrset("box", "abcdef") ---> 0
#
sub chrset
{
my ($S, $SET) = @_;
for (my $i = 0; $i < length($S); $i++)
{ return 0 if (index($SET, substr($S, $i, 1)) < 0); }
return 1;
}
############################################
#
# This function returns 0 if the input string
# is a decimal number, or otherwise returns 1.
# Use this function to test small numbers only
# (less than 15 digits is safe)!
#
# Usage: INTEGER isNaN( STRING )
#
# Example:
# isNaN('.0009') ---> 0
# isNaN('12345') ---> 0
# isNaN('-1234.5717') ---> 0
# isNaN('abc55') ---> 1
#
sub isNaN
{
my $N = shift;
return 1 unless (defined $N);
return 1 unless (length($N) > 0);
for (my ($i, $C, $D) = 0; $i < length($N); $i++)
{
$C = ord(substr($N, $i, 1));
if ($C < 48 || $C > 57)
{
if ($C == 43 || $C == 45) { next if ($i == 0); }
elsif ($C == 46) { next if ($D++ == 0); }
return 1;
}
}
return 0;
}
############################################
#
# This function removes leading and trailing
# spaces, tabs, and new-line characters
# from a string and returns a new string.
# It can also be used to trim other characters
# such as leading and trailing zeroes.
#
# Usage: STRING trim(STRING)
# STRING trim(STRING, CHRS)
#
# Example: trim("\t a b c \r\n"); ---> "a b c"
# trim('$000090.50', '$0'); ---> "90.5"
# trim('CABxxAxABBCC', 'ABC'); ---> "xxAx"
#
sub trim
{
my $j = 0;
my $i = -1;
my $STR = shift;
my $REMOVE = ((scalar @_) > 0) ? shift : " \t\r\n";
if (length($STR) == 0) { return ''; }
for (my $x = 0; $x < length($STR); $x++)
{
if (index($REMOVE, substr($STR, $x, 1)) < 0)
{
if ($i < 0) { $i = $x; }
$j = $x - $i + 1;
}
}
return substr($STR, $i, $j);
}
############################################
#
# This function converts an integer (0-255)
# to a two-digit hexadecimal string.
#
# Usage: STRING toHex( NUMBER )
#
sub toHex
{
my $N = int( shift );
return '00' if ($N <= 0);
return 'FF' if ($N >= 255);
my $X = '0123456789ABCDEF';
my $LO = $N & 0x0F;
my $HI = $N >> 4;
return substr($X, $HI, 1) . substr($X, $LO, 1);
}
############################################
#
# This function is the same as the escape()
# function in JavaScript. It takes the input
# string and leaves letters and numbers and
# 7 special characters intact but converts
# all the other characters to %XX format
# where XX is a hex number.
#
# Only the following 7 special characters
# are left intact : /@+*-._
#
# Usage: STRING escape( STRING )
#
# Example: "Hello World!" --> "Hello%20World%21"
#
sub escape
{
my $C;
my $BYTE;
my $ENCODE;
my $INPUT = shift;
my @OUTPUT;
for (my $i = 0; $i < length($INPUT); $i++)
{
$ENCODE = 0;
$BYTE = substr($INPUT, $i, 1);
$C = ord($BYTE);
if ($C < 42 || $C > 122) { $ENCODE = 1; }
elsif ($C > 57 && $C < 64) { $ENCODE = 1; }
elsif ($C > 90 && $C < 95) { $ENCODE = 1; }
elsif ($C == 44 || $C == 96) { $ENCODE = 1; }
$BYTE = ($ENCODE) ? '%' . toHex($C) : $BYTE;
push(@OUTPUT, $BYTE);
}
return join("", @OUTPUT);
}
############################################
# This is the opposite of the escape() function.
#
sub unescape
{
my $XX;
my $BYTE;
my $INPUT = shift;
my @OUTPUT;
for (my $i = 0; $i < length($INPUT); $i++)
{
$BYTE = substr($INPUT, $i, 1);
if (ord($BYTE) == 37)
{
$BYTE = '';
$XX = substr($INPUT, $i+1, 2);
if (length($XX) == 2)
{
$i += 2;
$BYTE = chr(hex($XX));
}
}
push(@OUTPUT, $BYTE);
}
return join("", @OUTPUT);
}
################################################
# This function decodes an URL-style string.
# Works like the unescape function, however
# it will also convert '+' signs to spaces.
#
sub decodeURLstr
{
my $S = shift;
$S =~ tr /+/ /;
return unescape($S);
}