#!/usr/bin/perl -w

# phadmin.pl - builds a Yahoo like Web directory
# by Jonathan Eisenzopf. v1.0 19990629
# 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      = '/www/perlhoo';
my $baseurl      = '/cgi-bin/phadmin.pl';
my $new_datafile = 'perlhoo_new.csv';

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

# get relative directory from URL
my $reldir = $query->path_info;

# strip of leading and trailing /
$reldir =~ s/^\/+//;
$reldir =~ s/\/+$//;

# get directory based on $rootdir and $reldir
my $dir = $reldir =~ /\S+/ ? "$rootdir/$reldir" : ($rootdir);

# Main code body
if ($query->param('action') eq 'add') {
    &print_header;
    &add_link($dir);
    &list_categories($dir);
    &print_footer;
} elsif ($query->param('action') eq 'edit') {
    &edit_link($dir);
} elsif ($query->param('action') eq 'delete') {
    &print_header;
    &delete_link($dir,$query->param('url'),$query->param('type'));
    &list_categories($dir);
    &print_footer;
} else {
    &print_header;
    &list_categories($dir);
    &print_footer;
}    

# Subroutines
sub add_link {
    my $dir = shift;

    # delete link from $new_datafile if type is new
    &delete_link($dir,$query->param('url'),1) if ($query->param('type') eq 'new');

    # delete link from $datafile if it exists
    &delete_link($dir,$query->param('url'));

    # lock semaphore file
    open(SEM, "> $dir/$datafile.semaphore") || die "Cannot open $dir/$datafile.semaphore for write: $!";
    flock(SEM, 2) || die "Cannot get exclusive lock for $dir/$datafile.semaphore: $!";

    # open $datafile
    open(FILE, ">> $dir/$datafile") || die "Cannot open $dir/$datafile for write: $!";

    # append record to $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 all filehandles
    close(FILE);
    close(SEM);
    unlink "$dir/$datafile.semaphore";
}

sub delete_link {
    my ($dir,$url,$new) = @_;
    my $foundit = 0;    # set to 1 if we find the url

    # do we want to modify $datafile or $new_datafile
    my $file = ($new) ? "$new_datafile"
	: "$datafile";

    # if the file doesn't exist, simply exit
    return unless -e "$dir/$file";

    # open data file
    open(IN, "$dir/$file") || die "Cannot open $dir/$file for read: $!";
    
    # open temp file
    open(OUT, "> $dir/$file.$$") || die "Cannot open $dir/$file.$$ for write: $!";

    # loop over the data file, looking for $url
    while (<IN>) {
	if (/$url/) {               # skip the line if it contains the url
	    $foundit=1;
	} else {
	    print OUT;              # print to the temp file
	}
    }
    close(IN);
    close(OUT);

    # if we found the url, we need to move the tmp file to production
    if ($foundit > 0) {
	# lock semaphore file
	open(SEM, "> $dir/$file.semaphore") || die "Cannot open $dir/$file.semaphore for write: $!";
	flock(SEM, 2) || die "Cannot get exclusive lock for $dir/$file.semaphore: $!";

	# move the tmp file to production
	rename "$dir/$file.$$","$dir/$file";
	close(SEM);
	unlink "$dir/$file.semaphore";

    # otherwise, just delete the tmp file
    } else {
	unlink "$dir/$file.$$";
    }
}

sub edit_link {
    my $dir = shift;
    my $url = $query->param('url');
    my ($title,$description,$name,$email);
    &print_header;
    my $file = ($query->param('type') eq 'new') ? "$new_datafile"
	: "$datafile";
    my $entries = &retreive_entries("$dir/$file");

    foreach my $entry (@$entries) {
	if ($entry->[0] eq $url) {
	    $title = $entry->[1];
	    $description = $entry->[2];
	    $name = $entry->[3];
	    $email = $entry->[4];
	}
    }

    print <<HTML;
<TABLE BORDER=0 CELLSPACING=1 CELLPADDING=2 BGCOLOR="#FFED9A">
<FORM METHOD=POST ACTION="$baseurl/$reldir">
<input type=hidden name=action value="add">
HTML

    print '<input type=hidden name=type value="new">' if $query->param('type') eq 'new';
    print <<HTML;
<tr BGCOLOR="#FFCC00">
<th COLSPAN=2><FONT size=+2 face="Arial,Helvetica">PerlHoo Entry</font></th>
</tr>
<tr><th BGCOLOR="#FFCC00" align=right>URL</th>
<td><input name="url" size=60 value="$url"></td></tr>

<tr><th BGCOLOR="#FFCC00" align=right>Title</th>
<td><input name="title" size=60 value="$title"></td></tr>

<tr><th BGCOLOR="#FFCC00" align=right>Description</th>
<td><textarea name="description" rows="3" cols="60">$description</textarea></td></tr>

<tr><th BGCOLOR="#FFCC00" align=right>Submitter</th>
<td><input name="name" size=60 value="$name"></td></tr>

<tr><th BGCOLOR="#FFCC00" align=right>Email</th>
<td><input name="email" size=60 value="$email"></td></tr>
<tr BGCOLOR="#FFCC00"><td><input type=submit value=" Save Entry "></form></td>
</tr></table>
HTML
    &print_footer;
}

sub list_categories {
    my $dir = shift;
    my $reldir = $dir;
    $reldir =~ s#$rootdir/?##;
    my @parts = split(/\//,$reldir);

    my $category = "<a href=\"$baseurl\">Home</a>";
    for (my $i=0; $i < @parts; $i++) {	
	    $category .= ": <a href=\"$baseurl/";
	    $category .= join('/',@parts[0..$i]);
	    $category .= "\">$parts[$i]</a>";	
    }

    print '<table border="0" width="100%" cellpadding="1" cols="4" cellspacing="1" BGCOLOR="#FFED9A">';
    print "<tr><td colspan=\"4\" BGCOLOR=\"#FFCC00\"><B>$category</B></td></tr>\n";
    &print_entries("$dir/$new_datafile",$reldir,1);
    &print_entries("$dir/$datafile",$reldir);
    print "</table><BR>\n";

    opendir DIR,$dir || die "Cannot open $dir: $!\n";
    my @dirs = grep -d, map "$dir/$_", grep !/^\./, readdir DIR;
    closedir DIR;

    foreach my $dir (@dirs) {    
	&list_categories($dir);
    }    
}

sub print_entries {
    my ($datafile,$reldir,$new) = @_;
    my $entries = &retreive_entries($datafile);
    my $url;
    foreach my $entry (@$entries) {
	if ($new) {
	    $url = "$baseurl/$reldir?action=edit&url=$entry->[0]&type=new";
	    print "<tr bgcolor=\"#FF0000\">\n";
	} else {
	    $url = "$baseurl/$reldir?action=edit&url=$entry->[0]";
	    print "<tr>\n";
	}
	print "<td><a href=\"$url\" >$entry->[1]</a></td>\n";
	print "<td>$entry->[2]</td>\n";
	print "<td><a href=\"$entry->[0]\" target=\"_new\">$entry->[0]</a></td>\n";
	print "<td align=\"center\"><a href=\"$baseurl/$reldir?action=delete&url=$entry->[0]";
	print "&type=new" if $new;
	print "\">Delete</a></td></tr>\n";
    }  
}

sub retreive_entries {
    my $datafile = shift;
    my @entries = ();
    if (-e $datafile) {
	open(DATA,$datafile) || die "Cannot open $datafile: $!";
	my $csv = Text::CSV_XS->new();
	while (<DATA>) {
	    chomp;
	    $csv->parse($_);
	    my @columns = $csv->fields();
	    push(@entries,\@columns);
	}
    }
    return \@entries;
}

sub print_footer {
    print <<HTML;
</body></html>
HTML
}


sub print_header {
    print <<HTML;
<html>
<head><title>PerlHoo Admin</title></head>
<body BGCOLOR="#FFFFFF" TEXT="#000000" LINK="#0033FF" VLINK="#0033FF">
<TABLE WIDTH="100%" BORDER=0 CELLSPACING=0 CELLPADDING=1>
<tr align="center">
    <td width="70%" bgcolor="#CC0000"><font face="arial,helvetica" size="+2" color=white>PerlHoo Admin</font></td>
    <td width="30%" bgcolor="#000000">
      <TABLE WIDTH="100%" BORDER=0 CELLSPACING=0 CELLPADDING=4 BGCOLOR="#FFFFFF"><tr><td align="center">
        <a href="$baseurl">Home</a> | <a href="$baseurl/$reldir?action=edit">Add new site</a></td></tr>
      </table>
    </td>
</tr></table>

HTML
}