PerlHoo, Part I | 7

PerlHoo Source
     1	#!/usr/bin/perl -wT
     2	
     3	# perlhoo.pl - builds a Yahoo like Web directory
     4	# by Jonathan Eisenzopf. v1.0 19990310
     5	# Copyright (c) 1999 internet.com LLC. All Rights Reserved.
     6	# Originally published and documented at http://www.webreference.com
     7	# You may use this code on a Web site only if this entire
     8	# copyright notice appears unchanged and you publicly display
     9	# on the Web site a link to http://www.webreference.com/perl/.
    10	#
    11	# Contact eisen@internet.com for all other uses.
    12	
    13	# Modules
    14	use strict;
    15	use Text::CSV;
    16	use CGI;
    17	
    18	# Constants
    19	my $datafile = 'perlhoo.csv';
    20	my $rootdir = '/www/perl/tutorial/2/directory';
    21	my $baseurl = '/cgi-bin/perlhoo.pl';
    22	
    23	# Main
    24	my $query = new CGI;
    25	print $query->header;
    26	
    27	my $reldir = $query->path_info;
    28	$reldir =~ s/^\/+//;
    29	$reldir =~ s/\/+$//;
    30	
    31	&print_header($reldir);
    32	&print_categories($reldir);
    33	&print_links("$rootdir/$reldir/$datafile");
    34	
    35	# Subroutines
    36	sub error {
    37	    my $msg = shift;
    38	    print "<FONT color=\"#FF0000\"><B>$msg</B></FONT>\n";
    39	    exit;
    40	}
    41	
    42	sub print_categories {
    43	    my $reldir = shift;
    44	    my $dir = "$rootdir/$reldir";
    45	    $dir =~ s/\/+$//;
    46	
    47	    opendir DIR,$dir ||  &error("Cannot open $dir: $!");
    48	    my @dirs = sort(grep -d, map "$dir/$_", grep !/^\./, readdir DIR);
    49	    closedir DIR;
    50	    
    51	    foreach my $thisdir (@dirs) {
    52		$thisdir =~ s/$rootdir\/$reldir//;
    53		$thisdir =~ s/\/+$//g;
    54		$thisdir =~ s/^\/+//g;
    55	
    56		my $url;
    57		if ($reldir =~ /\S+/) {
    58		    $url = "$baseurl/$reldir/$thisdir";
    59		} else {
    60		    $url = "$baseurl/$thisdir";
    61		}
    62	
    63		my $pdir = $thisdir;
    64		$pdir =~ s/_/ /g;
    65		print "<li><a href=\"$url\"><B>$pdir</B></a></li>\n";
    66	    }
    67	    print "<HR noshade>\n";
    68	}
    69	
    70	sub print_header {
    71	    my $reldir = shift;
    72	    my @parts = split(/\//,$reldir);
    73	    
    74	    print <<HTML;
    75	<html>
    76	<head><title>PerlHoo - $reldir</title></head>
    77	<body BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0033FF" VLINK="#660099">
    78	<center><H1>PerlHoo</H1></center>
    79	HTML
    80	
    81	    print "<p><H3><a href=\"$baseurl\">Top</a>";
    82	    for (my $i=0; $i     83		if ($i == (@parts - 1)) {
    84		    my $title = $parts[$i];
    85		    $title =~ s/_/ /g;
    86		    print ": $parts[$i]";
    87		} else {
    88		    print ": <a href=\"$baseurl/";
    89		    print join('/',@parts[0..$i]);
    90		    print "\">$parts[$i]";
    91		}
    92	    }
    93	    print "</H3></p><HR noshade>\n";
    94	}
    95	
    96	sub print_links {
    97	    my $datafile = shift;
    98	    if (-e $datafile) {
    99		open(DATA,$datafile) || &error("Cannot open $datafile: $!");
   100		my $csv = Text::CSV->new();
   101		while () {
   102		    chomp;
   103		    $csv->parse($_);
   104		    my @columns = $csv->fields();
   105		    print "<li><a href=\"$columns[0]\">$columns[1] - $columns[2]\n";
   106		}
   107	    }
   108	}

http://www.internet.com

Produced by Jonathan Eisenzopf and
Created: Feb. 14, 1999
Revised: Feb. 17, 1999

URL: http://www.webreference.com/perl/tutorial/2/