#!/usr/bin/perl -w

# perlhoo.pl - builds a Yahoo like Web directory
# by Jonathan Eisenzopf. v1.1 19990319
# Copyright (c) 2012 quinstreet.com LLC. All Rights Reserved.
#
# 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
#
# Originally published and documented at http://www.webreference.com
# Contact eisen@quinstreet.com for all other uses.

# Modules
use strict;
use Text::CSV_XS;
use CGI;
use CGI::Carp qw(fatalsToBrowser);

# Constants
my $datafile     = 'perlhoo.csv';
my $rootdir      = '/home/eisen/work/articles/webreference/tutorial/3/directory';
my $baseurl      = '/cgi-bin/perlhoo.pl';
my $new_datafile = 'perlhoo_new.csv';

# Main
my $query = new CGI;
print $query->header;

my $reldir = $query->path_info;
$reldir =~ s/^\/+//;
$reldir =~ s/\/+$//;
 
if ($query->param('keywords') eq 'add') {
    if ($query->request_method eq 'GET') {
	&print_add_screen($reldir);
    } elsif ($query->request_method eq 'POST') {
	&add_link($reldir);
    }
} else {
    &print_hoo($reldir);
}

# Subroutines
sub add_link {
    my $reldir = shift;
    my $dir = "$rootdir/$reldir";
    $dir =~ s/\/+$//;

    open(FILE, ">> $dir/$new_datafile") || &error("Cannot open $dir/$new_datafile for write: $!");
    flock(FILE, 2) || &error("Cannot get exclusive lock for $dir/$new_datafile: $!");

    my $csv = Text::CSV_XS->new();
    print FILE $csv->string,"\n" 
	if $csv->combine($query->param('url'),$query->param('title'),$query->param('description'),$query->param('name'),$query->param('email'));
    close(FILE);

    &print_header($reldir);

    print <<HTML;
Thank you for your suggested addition to the PerlHoo <b>$reldir</b> category. 
While we do review all new site suggestions, we cannot guarantee that all 
submissions will be added. The following information will be sent to the 
directory editor:
<p>
<table border="0" cellpadding="2" cellspacing="2">
HTML

    print "<tr><td align=\"right\"><B>URL:</B></td><td>",$query->param('url'),"</td></tr>\n";
    print "<tr><td align=\"right\"><B>Title:</B></td><td>",$query->param('title'),"</td></tr>\n";
    print "<tr><td align=\"right\"><B>Description:</B></td><td>",$query->param('description'),"</td></tr>\n";
    print "<tr><td align=\"right\"><B>Your Name:</B></td><td>",$query->param('name'),"</td></tr>\n";
    print "<tr><td align=\"right\"><B>Your Email:</B></td><td>",$query->param('email'),"</td></tr></table></p>\n";

    print <<HTML;
<p>Return to <a href="$baseurl/$reldir">$reldir</a>
<hr noshade>
HTML

    &print_footer($reldir);
}

sub error {
    my $msg = shift;
    print "<FONT color=\"#FF0000\"><B>$msg</B></FONT>\n";
    die "$msg";
}

sub print_add_screen {
    my $reldir = shift;
    print <<HTML;
<html>
<head><title>PerlHoo - $reldir - Add a Resource</title></head>
<body BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0033FF" VLINK="#660099">
<center><H1>PerlHoo</H1></center>
<p><H3>Add a Resource to: $reldir</H3><HR noshade>
<form action="$baseurl/$reldir" method="POST">
<input type="hidden" name="keywords" value="add">
<table border="0" cellpadding="2" cellspacing="2">
<tr><td align="right"><B>URL:</B></td><td><input name="url" size="40"></td></tr>
<tr><td align="right"><B>Title:</B></td><td><input name="title" size="40"></td></tr>
<tr><td align="right"><B>Description:</B></td><td><textarea name="description" rows="3" cols="40"></textarea></td></tr>
<tr><td align="right"><B>Your Name:</B></td><td><input name="name" size="40"></td></tr>
<tr><td align="right"><B>Your Email:</B></td><td><input name="email" size="40"></td></tr>
<tr><td></td><td><input type="submit" value=" Submit Resource ">
<input type="reset" value=" Reset "></td></tr>
</table>
<HR noshade>
</form></p>
</html>
HTML
}

sub print_categories {
    my $reldir = shift;
    my $dir = "$rootdir/$reldir";
    $dir =~ s/\/+$//;

    opendir DIR,$dir ||  &error("Cannot open $dir: $!");
    my @dirs = sort(grep -d, map "$dir/$_", grep !/^\./, readdir DIR);
    closedir DIR;
    
    foreach my $thisdir (@dirs) {
	$thisdir =~ s/$rootdir\/$reldir//;
	$thisdir =~ s/\/+$//g;
	$thisdir =~ s/^\/+//g;

	my $url;
	if ($reldir =~ /\S+/) {
	    $url = "$baseurl/$reldir/$thisdir";
	} else {
	    $url = "$baseurl/$thisdir";
	}

	my $pdir = $thisdir;
	$pdir =~ s/_/ /g;
	print "<li><a href=\"$url\"><B>$pdir</B></a></li>\n";
    }
    print "<HR noshade>\n";
}

sub print_footer {
    my $reldir = shift;
    print <<HTML;
<center><a href="$baseurl">Home</a> | <a href="$baseurl/$reldir?add">Suggest new link</a></center>
HTML
}

sub print_header {
    my $reldir = shift;
    my @parts = split(/\//,$reldir);
    
    print <<HTML;
<html>
<head><title>PerlHoo - $reldir</title></head>
<body BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0033FF" VLINK="#660099">
<center><H1>PerlHoo</H1></center>
HTML

    print "<p><H3><a href=\"$baseurl\">Top</a>";
    for (my $i=0; $i < @parts; $i++) {
	if ($i == (@parts - 1)) {
	    my $title = $parts[$i];
	    $title =~ s/_/ /g;
	    print ": $parts[$i]";
	} else {
	    print ": <a href=\"$baseurl/";
	    print join('/',@parts[0..$i]);
	    print "\">$parts[$i]</a>";
	}
    }
    print "</H3></p><HR noshade>\n";
}

sub print_hoo {
    my $reldir = shift;
    &print_header($reldir);
    &print_categories($reldir);
    &print_links("$rootdir/$reldir/$datafile");
    &print_footer($reldir);
}

sub print_links {
    my $datafile = shift;
    if (-e $datafile) {
	open(DATA,$datafile) || &error("Cannot open $datafile: $!");
	my $csv = Text::CSV_XS->new();
	while (<DATA>) {
	    chomp;
	    $csv->parse($_);
	    my @columns = $csv->fields();
	    print "<li><a href=\"$columns[0]\">$columns[1]</a> - $columns[2]\n";
	}
    }
}
