#!/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:
| URL: | ",$query->param('url')," |
| Title: | ",$query->param('title')," |
| Description: | ",$query->param('description')," |
| Your Name: | ",$query->param('name')," |
| Your Email: | ",$query->param('email')," |