#!/usr/perl/bin/perl -w
use strict;
BEGIN { my($tA, $bDir);
if (defined $ENV{SERVER_PORT})
{ $bDir = "$ENV{DOCUMENT_ROOT}/cgi-bin";
print "Context-type: text/html\n\n"; } ## CGI Dir (WEB)
else { $tA = "w:/webfiles/cgi-bin"; ## CGI Dir (DOS)
print "\n\n_[DOS_TEST]", "_" x 79,
"\n\nEnter String >>> ";
$ENV{QUERY_STRING} = ; ## Get String (DOS)
$ENV{DOCUMENT_ROOT} = "w:/web" } ## Home Dir (DOS)
push(@INC, $tA) }
my($gVer) = 1.03; ## Set Version
### Use... ###################################################################################################
## Set packages with are required. ##
##############################################################################################################
require "global.pl"; ## Use Global Package
my(@nKeys, %nLst, %nEsc); ## Set up Vars
### Catch Errors #############################################################################################
## If an error has occured due to the running of the script, it will be caught and sent to the sub called ##
## gError in the script : global.pl ##
##############################################################################################################
$SIG{__DIE__} = \&gErr; ## Send to Global Error
## Control below
### Extract Varaibles ########################################################################################
## Extract Variables from GET/POST/DOS String and place this in correct varaibles. ##
##############################################################################################################
chomp($ENV{QUERY_STRING}); ## Remove '\n'
my($nCmd, $nOpt) = split("::", $ENV{QUERY_STRING}); ## Split up Q/S
### Get Menu Contents ########################################################################################
## Open the menu contents file and extract all the information as to current articles, summaries and ##
## further information access. ##
##############################################################################################################
open (CFG, "$ENV{DOCUMENT_ROOT}/config/news")
or die("Cannot open /config/news ($!)"); ## Open News Contents
while () { ## Process News Contents
if (/^(\d+)\[h=([\S ]+)::a=([\S ]+)::b=([\S ]+)\]/) { ## Set so '#' @ start
## cancels the line.
$nLst{$1}{h} = $2; ## Headline
$nLst{$1}{a} = $3; ## Author
$nLst{$1}{b} = $4; }} ## Brief Info
close(CFG); ## Close Document
### Display Type #############################################################################################
## Using $nCmd (Command), the type of display can be chosen: ##
## - [b]brief (displays right aligned table with the three most recent storys and links to them) ##
## - [c]contents (full news contents table - 15 most recent articles) ##
## - [h]header (displays navigation bar for full articles pages) ##
## - [s]seach (displays search links for many search engines so with a click you can search the web) ##
## - [l]backlog (displays sets of 15 articles which are older than those in [c]) ##
##############################################################################################################
if ($nCmd eq "h") { &nHeaderSub($nOpt);} ## story header bar
elsif ($nCmd eq "s") { &nSearchSub($nOpt);} ## search links
elsif ($nCmd eq "c") { &nContentsSub; } ## contents listing
elsif ($nCmd eq "b") { &nBriefSub($nOpt); } ## brief table
elsif ($nCmd eq "l") { &nBackSub($nOpt); } ## backlog pages
else { die("No or Incorrect Display Type Given ($nCmd/$nOpt)"); } ## exit with error
#-Start Subs-------------------------------------------------------------------------------------------------#
### Brief Sub ################################################################################################
## Sub for displaying small table with 3 recent stories and their summaries, with links to main articles. ##
##############################################################################################################
sub nBriefSub
{
my($nTitle) = shift; ## Get title option
my($tA, $tB);
CYCL: { foreach my $nKey (sort {$b <=> $a}(keys %nLst)) { $tA++; ## Get Line Keys and
$nKeys[$tA] = $nKey; ## Store for access
last CYCL if ($tA == 3); } } ## Exit after first three
print <
Output
;
&nBriefSub("no"); ## Print 'news in brief...'
## table, without title
my(@nTime) = gmtime($nKeys[$nArtNo]);
$nTime[5] += 1900;
do {if ($nTime[$tB] < 10) { $nTime[$tB] = "0$nTime[$tB]"} $tB++ }
until ($tB == 5); ## Add Leading 0 (Zero)
my($nDate) = "$nTime[3].$nTime[4].$nTime[5] $nTime[2]:$nTime[1]";
print <$nLst{$nKeys[$nArtNo]}{h}
$nLst{$nKeys[$nArtNo]}{a}
$nDate
Output
;
}
### Search Sub ###############################################################################################
## Sub for coding and printing links to common search engines, using the article title as the key, so you ##
## can search them for more information about the current artcle. ##
##############################################################################################################
sub nSearchSub
{
my($nArt) = shift;
my($tA, $tB);
for (0..255) { $nEsc{chr()} = sprintf("%%%02X", $_); } ## Setup keycodes for
my($nStr) = $nLst{$nArt}{h}; ## title is search string
$nStr =~ s/([\W])/$nEsc{$1}/g; ## Convert all non-word
$nStr =~ s/%20/+/g;
##Altavista (www.altavisa.com)
my($nAlta) = "http://www.altavista.com/cgi-bin/query?pg=q&sc=on&q=$nStr&kl=XX&stype=stext&search.x=1&search.y=1";
##Excite (www.excite.com)
my($nExci) = "http://search.excite.com/search.gw?search=$nStr";
##Infoseek (www.infoseek.com)
my($nInfo) = "http://www.infoseek.com/titles?qt=$nStr&col=WW&svx=home_searchbox&sv=IS&lk=noframes";
##Yahoo! (www.yahoo.com)
my($nYaho) = "http://search.yahoo.com/bin/search?p=$nStr";
##Lycos (ww.lycos.com)
my($nLyco) = "http://www.lycos.com/cgi-bin/pursuit?matchmode=and&mtemp=main.sites&etemp=error&query=$nStr&cat=brit&x=1&y=1";
print <
__end of message__
search:
[altavista]
[excite]
[infoseek]
[yahoo]
[lycos]
Output
;
}
### Backlog Sub ##############################################################################################
## Sub for displaying the contents for all the articles on the site, displaying 15 headlines per page ##
##############################################################################################################
sub nBackSub
{
my($nStart) = shift;
my($tA, $tB);
CYCL: { foreach my $nKey (sort {$b <=> $a}(keys %nLst)) { $tA++; ## Get Line Keys
$nKeys[$tA] = $nKey; } } ## Store Line Keys
## max of 25 articles
print <
Output
;
my($nNext) = $nStart + 15;
print <next 15]
Output
;
print <search]
[contents]
Output
;
my($nPrev) = $nStart - 15;
print < 15;
[last 15]
Output
;
print <
| |
Output
;
$tA=$nStart;
CYCL: { do { $tA++; ## Cycle thru articles
last CYCL if !defined $nKeys[$tA]; ## If no more exit
my(@nTime) = gmtime($nKeys[$tA]);
$nTime[5] += 1900;
my($tB)= 0;
do {if ($nTime[$tB] < 10) { $nTime[$tB] = "0$nTime[$tB]"} $tB++ }
until ($tB == 5); ## Add Leading 0 (Zero)
my($nDate) = "$nTime[3].$nTime[4].$nTime[5]
$nTime[2]:$nTime[1]";
print <
|
Output
;
}
until ($tA == ($nStart + 15));} ## Max of 25 stories
if (!defined $nKeys[$nStart + 1]) { print "There are no articles in the backlog. |
" }
print "
\n"; ## Finish Table
}
#-Error and Global Control-----------------------------------------------------------------------------------#
sub gErr { my($gErr) = shift; ## Error Control
chomp($gErr); ## Get Error Info and
&gError("news.pl", $gVer, $gErr); } ## Pass to global error