#!/usr/bin/perl
#!/usr/bin/perl
##########################################################
## Castle Links						
## Created: 06/17/1999			
##########################################################
# By: Castle CGI										
# WebSite: www.castellum.net				
##########################################################
##########################################################
# (C)Copyright 1999-2001 Castellum.net, All rights reserved	
##########################################################
# DISCLAIMER:						
# THIS PROGRAM IS PROVIDED WITHOUT WARRANTIES OF ANY    
# KIND, WHETHER EXPRESSED OR IMPLIED.   THIS PROGRAM IS 
# PROVIDED WIThOUT WARRANTIES AS TO PERFORMANCE, OR  	
# MERCHANTABILITY OF THIS PROGRAM.			
# TERMS OF USE:						
# THIS SCRIPT MAY BE MODIFIED, BUT NOT REDISTRIBUTED IN	
# ANY WAY, SHAPE, OR FORM.  IN ANY CASE, COPYRIGHT AND  
# SCRIPT INFORMATION MUST BE KEPT IN PLACE		
##########################################################
use Fcntl qw(:DEFAULT :flock); 


##################################
## GET QUERY STRING INTO %query
##################################
my %query = ();
foreach my $pair (split(/&/,$ENV{'QUERY_STRING'})){
	my($name,$value) = split(/=/,$pair);
	$name =~ s/\+/ /g;
	$name =~ s/%(..)/chr(hex($1))/ge;
	$value =~ s/\+/ /g;
	$value =~ s/%(..)/chr(hex($1))/ge;
	$query{$name}.= $value;
}

##################################
## GET FORM INPUT INTO %input
##################################
my $in = undef;
my %input = ();
read(STDIN, $in, $ENV{'CONTENT_LENGTH'});
foreach my $pair (split(/&/,$in)){
	my($name,$value) = split(/=/,$pair);
	$name =~ s/\+/ /g;
	$value =~ s/\+/ /g;
	$name =~ s/%(..)/chr(hex($1))/ge;
	$value =~ s/%(..)/chr(hex($1))/ge; 
	if ($input{$name}){$input{$name}.= ",";}  
	$input{$name}.= $value 
}

##################################
## LOAD SETUP INTO LOCAL %setup ##
##################################
my %setup = ();
open(SETUP, "clinks_setup.pl")||&TrueDie("Opening clinks_setup.pl: $!");
while(<SETUP>){
	chomp;
	my($name,$value) = split(/=/);
	$setup{$name} .= $value;
}
close(SETUP);
my $t_dir = $setup{'template_dir'};


###################################
## LOAD CATEGORIES
###################################
my %categories = ();
my $category_options = '';

open(CATS, "$setup{'category_file'}")||&Error("Opening $setup{'category_file'}: $!");
if ($setup{'flock'} == 1){flock(CATS,LOCK_SH);}
while(<CATS>){
	chomp;
	my($title,$count,$path,$addto,$desc) = split(/\|\|/);
	$categories{$path} = $_;
}
if ($setup{'flock'} == 1){flock(CATS,8);}
close(CATS);

foreach my $category (sort(keys %categories)){
	$category_options .= "<OPTION value=\"$category\">$category</OPTION>";
}


my $base_path = $query{'category'};
my $start = $query{'start'};
if ($input{'category'} ne ''){
	$base_path = $input{'category'};
	$start = 0;
	if ($base_path eq '/'){
		print "Location: main.cgi\n\n";
		exit;
	}
}

if (!$start > 0){$start = 0;}


###################################
## LOAD TEMPLATE
###################################
open(MASTER, "$t_dir/master.htm")||&DieNice("Openeing: $t_dir/master.htm $!");
my($temp1,$temp2) = split(/!INSERT!/,join('',<MASTER>));
close(MASTER);

open(TEMPLATE, "$t_dir/category.htm")||&DieNice("Opening: $t_dir/category.htm $!");
my $html = $temp1 . join('',<TEMPLATE>) . $temp2;
close(TEMPLATE);
$temp1 = undef;
$temp2 = undef;

my %vars = (
					'version'	=>		'4.51',
					'add_url'	=>		'add.cgi',
					'search_url'=>		'search.cgi',
					'new_url'	=>		'whatsnew.cgi',
					'old_url'	=>		'whatsold.cgi',
					'random_url'=>		'random.cgi',
					'next'		=>		'$NEXT',
					'previous'	=>		'$PREVIOUS'
);
$html =~ s/\$([vasnornp]\w+)/$vars{$1}/g;
$html =~ s/<!--CATEGORY OPTIONS-->/$category_options/gi;
##############################
## SUB CATEGORIES
##############################
my($top,$category1,$middle,$category2,$bottom) = split(/<!--CATEGORY-->/,$html);
$html = $top;
$top = undef;
my $i = 1;
foreach my $category (sort(keys %categories)){
	my($title,$count,$path,$addto,$desc) = split(/\|\|/,$categories{$category});
	if ($category =~ /^$base_path\/[ \w\!\@\#\$\%\^\&\*\(\)\_\+\-\[\]\;\,\.\<\>]+$/){
		my $sub = undef;
		if ($i == 1){$sub = "$category1$middle"; $i = 2;}else{$sub = "$category2"; $i = 1;}
		my $url = "category.cgi?category=$category\&start=0";
		$url  =~ s/([\%\{\}])/uc sprintf("%%%02x",ord($1))/eg;
		$url =~ s/ /+/gi;
		$sub =~ s/\$description/$desc/gi;
		$sub =~ s/\$link_count/$count/gi;
		$sub =~ s/\$title/$title/gi;
		$sub =~ s/\$path/$category/gi;
		$sub =~ s/\$url/$url/gi;
		$html .= $sub;
	}
}
$html .= $bottom;
$category1 = undef;
$middle = undef;
$category2 = undef;
$bottom = undef;

##############################
## LoadLinks and Print Them
##############################
# This is where it gets a little complicated.  Traditionally, the 
# script loads the entire array into memory.  This is a large memory
# hog and has been the cause of core dumps while working with large databases.
#
# In version 5 this will be fixed more so than it is now.  Right now we do some checking
# and figure out what to do.  It still loads all the links in a category into memory,
# but not the ENTIRE file.

my %displaylinks = ();
my @displaylinks = ();

open(LINKS, "$setup{'links_file'}")||&DieNice("Opening $setup{'links_file'}: $!");
if ($setup{'flock'} == 1){flock(LINKS,LOCK_SH);}
while(<LINKS>){
	chomp;
	my($ltitle,$ldescription,$lid,$lcat,$ldate,$lurl,$lemail) = split(/\|\|/);
	if ($lcat eq $base_path){
		$displaylinks{"$ltitle$lid"} = $_;
		push(@displaylinks,"$ltitle$lid");
	}	
}
if ($setup{'flock'} == 1){flock(LINKS,8);}
close(LINKS);


if ($setup{'link_order'} eq "alpha"){@displaylinks = sort {uc($a) cmp uc($b)} @displaylinks;}


my($top1,$link1,$middle1,$link2,$bottom1) = split(/<!--LINK-->/,$html);
$html = $top1;
$top1 = undef;

my $i = 1;
my $count = 0;
my $stop = $start + $setup{'perpage'};
my $prev = 0;
my $next = 0;

foreach my $link (@displaylinks){

	my $sub = "";
	if ($count >= $start && $count < $stop){
		my %vars = ();
		($vars{'title'},$vars{'description'},$vars{'id'},$vars{'NULLCAT'},$vars{'date'},$vars{'url'},$vars{'email'}) = split(/\|\|/,$displaylinks{$link});
		if ($i == 1){$sub = "$link1$middle1"; $i = 2;}else{$sub = "$link2"; $i = 1;}
		$sub =~ s/\$([tdidue]\w+)/$vars{$1}/g;
		$html .= $sub;
	
	}
	$count++;
}
$html .= $bottom1;
$link1 = undef;
$middle1 = undef;
$link2 = undef;
$bottom1 = undef;

if ($start > 0){
	my $previous = $start - $setup{'perpage'};
	my $prev_url = "category.cgi\?category=$base_path\&start=$perpage";
	$prev_url =~ s/ /+/gi;
	$prev_url =~ s/([\%\{\}])/uc sprintf("%%%02x",ord($1))/eg;
	$html =~ s/\$PREV/$prev_url/g;
}else{
	$html =~ s/<!--PREVIOUS-->(.|\r\n|\n)*<!--PREVIOUS-->//gi;
}
  

if ($count > $stop){
	my $next_url = "category.cgi\?category=$base_path\&start=$stop";
	$next_url =~ s/ /+/gi;
	$next_url =~ s/([\%\{\}])/uc sprintf("%%%02x",ord($1))/eg;
	$html =~ s/\$NEXT/$next_url/g;
}else{
	$html =~ s/<!--NEXT-->(.|\r\n|\n)*<!--NEXT-->//gi;
}


%vars = ();
($vars{'category'},$vars{'count'},$vars{'path'},$vars{'NULLADD'},$vars{'description'}) = split(/\|\|/, $categories{$base_path});

$html =~ s/\$([cpd]\w+)/$vars{$1}/g;

##############################
## PRINT HEADER
##############################
print "Content-type: text/html\n\n";
print '<!--';
print 'ClBvd2VyZWQgYnk6IENhc3RsZSBMaW5rcwooYylDb3B5cmlnaHQgMTk5OS0yMDAwIENhc3RlbGx1';
print 'bS5uZXQsIEFsbCBSaWdodHMgUmVzZXJ2ZWQKU2NyaXB0IEF2YWlsYWJsZSBBdCBodHRwOi8vd3d3';
print 'LmNhc3RlbGx1bS5uZXQK';
print '-->';

print $html;




##############################
## DIE SUB-ROUTINE
##############################

sub DieNice {
	my $error = shift;
	print "Content-type: text/html\n\n";
	print qq~
<html>
<head>
<title>Castle Links v$version</title>
</head>
<body bgcolor="#E9E9E9" link="#800000">
<h2 align="left">Fatal Error: $error</h2>
<p align="left">The script encountered an error while trying to complete your request.  If
this is an error on your part, please press the back button and correct it.</p>
<hr>
<h6 align="center">Powered By: <a href="http://www.castellum.net/cgi/clinks/">Castle
Links</a><br>
©1999-2001 <a href="http://www.castle-cgi.com">Castle CGI</a>, All Rights
Reserved<br>
Script available at <a href="http://www.castle-cgi.com">http://www.castle-cgi.com</a></h6>
<p align="center">&nbsp;</p>
</body>
</html>
~;
exit;

}


1;