#!/usr/bin/perl -w # perlhoo.pl - builds a Yahoo like Web directory # by Jonathan Eisenzopf. v1.1 19990319 # Copyright (c) 1999 internet.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@internet.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 <$reldir 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:

HTML print "\n"; print "\n"; print "\n"; print "\n"; print "
URL:",$query->param('url'),"
Title:",$query->param('title'),"
Description:",$query->param('description'),"
Your Name:",$query->param('name'),"
Your Email:",$query->param('email'),"

\n"; print <Return to $reldir
HTML &print_footer($reldir); } sub error { my $msg = shift; print "$msg\n"; die "$msg"; } sub print_add_screen { my $reldir = shift; print < PerlHoo - $reldir - Add a Resource

PerlHoo

Add a Resource to: $reldir

URL:
Title:
Description:
Your Name:
Your Email:

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 "
  • $pdir
    • \n"; } print "
    \n"; } sub print_footer { my $reldir = shift; print <Home | Suggest new link HTML } sub print_header { my $reldir = shift; my @parts = split(/\//,$reldir); print < PerlHoo - $reldir

    PerlHoo

    HTML print "

    Top"; for (my $i=0; $i < @parts; $i++) { if ($i == (@parts - 1)) { my $title = $parts[$i]; $title =~ s/_/ /g; print ": $parts[$i]"; } else { print ": $parts[$i]"; } } print "

    \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 () { chomp; $csv->parse($_); my @columns = $csv->fields(); print "
  • $columns[1] - $columns[2]\n"; } } }