#!/usr/local/bin/perl

use strict;
use CGI;
use Pod::Xhtml;

#Inputs
my @css = CGI::param('css');
my $file = (CGI::param('file') =~ m|^([\w\-/]+\.\w+)$|)[0]; #Only allow sensibly named files (no ../ etc)
my $module = (CGI::param('module') =~ m|^([\w:]+)$|)[0];    #Only allow sensible module names
my $docroot = $ENV{DOCROOT} || $ENV{DOCUMENT_ROOT};

#Deduce filename
if(defined $module)
{
	$file = $module;
	$file =~ s|::|/|g;
 MODULESEARCH:
	foreach my $inc_path (@INC)
	{
		foreach my $ext (qw(pm pod)) {
			my $candidate = "$inc_path/$file.$ext";
			if(-f $candidate) {
				$file = $candidate;
				last MODULESEARCH;
			}
		}
	}
}
elsif(defined $file)
{
	$file = $docroot.$file;
}
elsif(defined $ENV{PATH_TRANSLATED})
{
	$file = $ENV{PATH_TRANSLATED};
}

#Render
print CGI::header();
if(not defined $file)
{
	print "No recognisable filename\n";
}
elsif(not -f $file)
{
	print "$file does not exist\n";
}
else
{
	#Render the XHTML
	my $link_parser = new LinkResolver(\@css);
	my $parser = new Pod::Xhtml(StringMode => 1, LinkParser => $link_parser);
	$parser->addHeadText(qq[<link rel="stylesheet" href="$_"/>\n]) for @css;
	$parser->parse_from_file($file);
	print $parser->asString();
}

#
# Subclass Pod::Hyperlink to create self-referring links
#

package LinkResolver;
use Pod::ParseUtils;
use base qw(Pod::Hyperlink);

sub new
{
	my $class = shift;
	my $css = shift;
	my $self = $class->SUPER::new();
	$self->{css} = $css;
	return $self;
}

sub node
{
	my $self = shift;
	if($self->SUPER::type() eq 'page')
	{
		my $url = "?module=".$self->SUPER::page();
		$url.=";css=".$_ for @{$self->{css}};
		return $url;
	}
	$self->SUPER::node(@_);
}

sub text
{
	my $self = shift;
	return $self->SUPER::page() if($self->SUPER::type() eq 'page');
	$self->SUPER::text(@_);
}

sub type
{
	my $self = shift;
	return "hyperlink" if($self->SUPER::type() eq 'page');
	$self->SUPER::type(@_);
}

1;

=head1 NAME

pod2xhtml - CGI to display POD as XHTML

=head1 SYNOPSIS

	http://localhost/cgi-bin/pod2xhtml.pl?file=/cgi-bin/pod2xhtml.pl
	http://localhost/cgi-bin/pod2xhtml.pl?module=Pod::Xhtml

=head1 DESCRIPTION

Displays POD of scripts within the web server's document root and modules within @INC.
If you keep your CGIs in a directory parallel to your web content, you can use the $DOCROOT environment variable to allow this script access.
For example if your web server layout is:

	/var/wwwroot/www
	/var/wwwroot/cgi-bin

You can add:

	SetEnv DOCROOT /var/wwwroot

to your Apache config to allow the script access to all the files below /var/wwwroot.

=head1 CGI PARAMETERS

 css - URL of stylesheet to apply
 file - name of file relative to document root
 module - name of module in @INC

=head1 VERSION

$Revision: 1.8 $ on $Date: 2004/10/22 14:44:05 $ by $Author: simonf $

=head1 AUTHOR

John Alden E<lt>cpan _at_ bbc _dot_ co _dot_ ukE<gt>

=head1 COPYRIGHT

(c) BBC 2004. This program is free software; you can redistribute it and/or
modify it under the GNU GPL.

See the file COPYING in this distribution, or http://www.gnu.org/licenses/gpl.txt

=cut