#!/usr/bin/perl -wT
# perlhoo.pl - builds a Yahoo like Web directory
# by Jonathan Eisenzopf. v1.0 19990310
# Copyright (c) 2012 quinstreet.com LLC. All Rights Reserved.
# Originally published and documented at http://www.webreference.com
# You may use this code on a Web site only if this entire
# copyright notice appears unchanged and you publicly display
# on the Web site a link to http://www.webreference.com/perl/.
#
# Contact eisen@quinstreet.com for all other uses.
# Modules
use strict;
use Text::CSV;
use CGI;
# Constants
my $datafile = 'perlhoo.csv';
my $rootdir = '/www/perl/tutorial/2/directory';
my $baseurl = '/cgi-bin/perlhoo.pl';
# Main
my $query = new CGI;
print $query->header;
my $reldir = $query->path_info;
$reldir =~ s/^\/+//;
$reldir =~ s/\/+$//;
&print_header($reldir);
&print_categories($reldir);
&print_links("$rootdir/$reldir/$datafile");
# Subroutines
sub error {
my $msg = shift;
print "$msg\n";
exit;
}
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_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_links {
my $datafile = shift;
if (-e $datafile) {
open(DATA,$datafile) || &error("Cannot open $datafile: $!");
my $csv = Text::CSV->new();
while () {
chomp;
$csv->parse($_);
my @columns = $csv->fields();
print "$columns[1] - $columns[2]\n";
}
}
}