#!/usr/bin/perl 

# floret 
# Creates a nested HTML list ('sitemap') of files in a directory.
# Copyright (C) 2007-2008 Chad Loseby
# version 0.8, 2008-01-26
# Homepage: http://loseby.net/software/floret/
# See README for more information
#
# small portions derived from tree.pl, http://www.danielnaber.de/tree/
# copyright (C) 1998-2003 Daniel Naber under the GPL
#
# small portions derived from blosxom, http://blosxom.sourceforge.net
# copyright (C) 2003 Rael Dornfest under a free use license

# COPYRIGHT:
# 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.

use strict; 
use CGI qw/:standard :netscape/;

###########################################################
# User configuration
###########################################################

### The following options are important to make floret work. 

# What is the title of the website?
my $title = "My Website";

# What is the short description of the website?
my $subtitle = "a website about John Doe";

# Where are the pages of the site kept?
my $datadir = "/Library/WebServer/Documents/pages";

# Where is the template that you would like to use?
# (leave blank for the bare-bones, default template)
my $tpl_path = "/Library/WebServer/Documents/cml-template.xhtml";

# What's my preferred base URL for this blog (leave blank for automatic)?
my $url = "";

###########################################################
# Main program
###########################################################

### Declare the subroutines

# crawl subroutine 
# Crawls through the given split path and returns 
# a string of HTML links to the files and folders it found
sub crawl;

# check subroutine 
# Checks to see if the passed split path is in the current @path_info
# and returns a string of HTML links if it is
sub check;

# get_link subroutine 
# Returns an HTML link for the split path that is passed to it
sub get_link;

# get_title subroutine
# Returns a title based on the last item of a path array
sub get_title;

# split2URL subroutine 
# takes a split path and returns an appropriate URL
sub split2URL;

# split2fs subroutine 
# takes a split path and returns an appropriate file system path
sub split2fs;

### Set up some basic information

# Use the stated preferred URL or figure it out automatically
$url ||= url();
$url =~ s/^included:/http:/; # Fix for SSI
$url =~ s!/$!!;

# Drop / from end of $datadir
$datadir =~ s!/$!!;

# Split and sanitize the path
my @url_path = split m{/}, path_info() || param('path');
foreach my $el (@url_path) {
	$el =~ /^(\w[\w.]*)$/;
	$el = $1;
}

### Generate the page

# Check to see if we may want to serve this page up as valid XHTML 1.1
if ($tpl_path =~ /^.*\.xhtml$/i || $tpl_path =~ /^.*\.xht$/i) {
	if ($ENV{'HTTP_ACCEPT'} =~ /application\/xhtml\+xml/) {
      print "Content-type: application/xhtml+xml; charset=utf-8\n\n";
	} else {
      print "Content-type: text/html; charset=utf-8\n\n";
	}
} else {
   print "Content-type: text/html; charset=utf-8\n\n";
}
my @start_path = ("");
my $output;
my $body;
my $body_title;
my $html_title;

# Generate the navigation and store it
my $nav = crawl(@start_path);

# Generate a title for the body
if($#url_path > 0) {
	$body_title = get_title($url_path[$#url_path]);
	$html_title = "$title - $body_title";
} else {
	$body_title = "Welcome to $title";
	$html_title = "$title - $subtitle";
}

# Grab the appropriate text file, or generate one, and store it in $body
if($url_path[$#url_path] =~ /^.*\.txt$/i) {
	my $bodypath = split2fs(@url_path);
	
	# Make sure that text file exists
	if(-f $bodypath) {
		# Open the text file, copy it into $body, and close it
		open (BODY, $bodypath) || die ("Could not open file: $!");
		while(<BODY>) {
			$_ =~ s/(\$\w+)/$1/gee;
			$body .= $_;
		}
		close (BODY);
	} else {
                $body_title = "404 - Page Not Found";
                $html_title = "404 - Page Not Found";
                $body .= "The page or file that you have requested is not \n";
                $body .= "found. Please use the navigation links at the left ";
                $body .= "to find the page you are looking for. \n";
        }

} else {
	if(-d split2fs(@url_path)) {
		my $bodypath = split2fs(@url_path) . "/index.txt";
		
		# If the directory has an index.txt
		if(-f $bodypath) {
			# open the index.txt, copy it into $body, and close it
			open(BODY, $bodypath) || die ("Could not open file: $!");
			while(<BODY>) {
				$_ =~ s/(\$\w+)/$1/gee;
				$body .= $_;
			}
			close(BODY); 
		} else {
			# If not, copy a directory listing into body
			$body .= crawl(@url_path);
		}
	} else {
		$body_title = "404 - Page Not Found";
		$html_title = "404 - Page Not Found";
		$body .= "The page or file that you have requested is not found. \n";
		$body .= "Please use the navigation links at the left to find the ";
		$body .= "page you are looking for. \n";
	}
}

# Read in the template and expand the variables, 
# or use the default template.
if(-f $tpl_path) {
	open (TMP, $tpl_path) || die ("Could not open file: $!");
	while(<TMP>) {
		$_ =~ s/(\$\w+)/$1/gee;
		print;
	}
	close (TMP);
} else {
   print("<!DOCTYPE html PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" ");
   print("\"http://www.w3.org/TR/html4/loose.dtd\"> \n");
	print("<html><head><title>");
	print("$html_title");
	print("</title></head>\n");
	print("<body><h1>$title</h1>\n");
	print("<h2>$subtitle</h2>\n");
	print("<hr><table border=\"0\" cellpadding=\"2\" width=\"100%\">\n");
	print("<tr><td width=\"20%\" valign=\"top\"><ul><li>$title/$nav</ul></td>\n");
	print("<td width=\"80%\" valign=\"top\"><h3>$body_title</h3>\n");
	print("<p>$body</td></tr></table>\n");
	print("</body></html>\n");
}

###########################################################
# Subroutine Definitions
###########################################################

# crawl subroutine 
# Crawls through the given split path and returns 
# a string of HTML links to the files and folders it found
sub crawl {
	my @called_path = @_;
	my $fspath = split2fs(@called_path);
	
	# Read the contents of the directory
	chdir($fspath) or die "Cannot chdir to $fspath: $!\n";
	opendir(DIR, $fspath) or die "Cannot open $fspath: $!\n";
	my @contents = readdir(DIR);
	closedir(DIR);
	
	# Links may be ignored completely
	@contents = grep { not -l } @contents;
	
	# No hidden files and ".." directories
	@contents = grep {!/^\./} @contents;
	
	# Get directories
	my @dirs = grep {-d} @contents;
	# Get files
	my @files = grep {-f} @contents;
	
	my $output .= "<ul>\n";
	
	# Go through all directories in this directory
	foreach my $d (sort(@dirs)) {
		my @new_path = @called_path;
		push(@new_path, $d);
		$output .= get_link(@new_path); 	# Get a link in the nav to this dir
		$output .= check(@new_path); 	  	# Check to see if this new path needs
													# to be expanded in the nav
	}
	
	# Go through all the files in this directory
	foreach my $f (sort(@files)) {
		# Check to see if this is a file we should really print a link for... 
		if(($f =~ /^.*\.txt$/i) || ($f =~ /^.*\.url$/i)) {
			unless($f =~ /^index\.txt$/i) {
				my @new_path = @called_path;
				push (@new_path, $f);   # Add the new file to the current path
				$output .= get_link(@new_path); 	# Get a link in the nav to 
															# this file
			}
		}
	}
	$output .= "</ul>\n";
	return $output;
}

# check subroutine 
# Checks to see if the passed split path is in the current @path_info
# and returns a string of HTML
sub check {
	my @called_path = @_;
	my $count = 0;
	my $output = "";
	foreach my $step (@called_path) {
		if(($step eq $url_path[$count]) && ($count == $#called_path) && ($count > 0)){
			$output .= "<li>" . crawl(@called_path) . "</li>";
		}
		$count++;
	}
	return $output;
}
		
# get_link subroutine 
# Returns an HTML link for the split path that is passed to it
sub get_link {
	my @called_path = @_;
	my $output = "";
	
	# Take the filename or directory name and spruce it up
	my $ltitle = $called_path[$#called_path];
	$ltitle = get_title($ltitle);
	
	if($called_path[$#called_path] =~ /^.*\.url$/i) {
		my $fpath = split2fs(@called_path);
		
		# Get the first line of the .url file
		open (FIN, $fpath) || die ("Could not open file: $!");
		my $turl = <FIN>;
		close (FIN);
		chomp($turl);
		
		$output .= "<li><a href=\"$turl\">$ltitle</a><br /></li>\n";
	} else {
		my $absurl = split2URL(@called_path);
		if($called_path[$#called_path] =~ /^.*\.txt$/i) {
			$output .= "<li><a href=\"$absurl\">$ltitle</a><br /></li>\n";
		} else {
			$output .= "<li><a href=\"$absurl\">$ltitle/</a><br /></li>\n";
		}
	}
	return $output;
}

# get_title subroutine
# Returns a title based on the last item of a path array
sub get_title {
	my $output = shift;
	
	# Replace any underscores with spaces
	$output =~ s/_/ /go;
	# Remove the .txt, if it is present
	$output =~ s/\.txt//;
	# Remove the .url, if it is present
	$output =~ s/\.url//;
	
	return $output;
}

# split2URL subroutine
# takes a split path and returns an appropriate URL
sub split2URL {
	my @called_path = @_;
	my $retval = $url . join("/", @called_path);
	return $retval;
}

# split2fs subroutine
# takes a split path and returns an appropriate file system path
sub split2fs {
	my @called_path = @_;
	my $retval =  $datadir . join("/", @called_path);
	return $retval;
}