Pod-Webserver-3.10000755001750001750 012461070614 12701 5ustar00ronron000000000000Pod-Webserver-3.10/Build.PL000444001750001750 274512461070614 14342 0ustar00ronron000000000000use 5.004; # Sane minimum, I think. use strict; use warnings; use Module::Build; # ----------------------------------------------- my $class = Module::Build->subclass(code => <<'EOF'); sub ACTION_authortest { my($self) = @_; $self->depends_on('build'); $self->depends_on('manifest'); $self->depends_on('distmeta'); $self->test_files( qw< t xt/author > ); $self->recursive_test_files(1); $self->depends_on('test'); return; } EOF $class -> new ( module_name => 'Pod::Webserver', license => 'artistic_2', dist_abstract => 'Minimal web server for local Perl documentation', dist_author => 'Sean M. Burke C', build_requires => { 'Test::More' => 0.94, # 'Test::Pod' => 1.45, # Make it optional. See t/pod.t 'Test::TCP' => 2.02, 'Test::Version' => 1.002003, }, configure_requires => { 'Module::Build' => 0.3800, }, requires => { 'File::Spec' => 0, 'File::Spec::Unix' => 0, 'IO::Socket' => 0, 'Pod::Simple' => 3.01, 'Pod::Simple::HTML' => 0, 'Pod::Simple::HTMLBatch' => 0, 'Pod::Simple::Progress' => 0, 'strict' => 0, 'Test::Version' => 1.002003, 'warnings' => 0, }, resources => { bugtracker => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Pod-Webserver', license => 'http://opensource.org/licenses/Artistic-2.0', repository => 'https://github.com/ronsavage/Pod-Webserver', }, ) -> create_build_script(); Pod-Webserver-3.10/README000444001750001750 243712461070614 13724 0ustar00ronron000000000000README for Pod::Webserver Time-stamp: "2004-05-25 18:22:38 ADT" Pod::Webserver Pod::Webserver -- minimal web server to serve local Perl documentation SYNOPSIS (Running from a prompt) % podwebserver You can now point your browser at http://localhost:8020/ DESCRIPTION This module can be run as an application that works as a minimal web server to serve local Perl documentation. It's like L except it works through your browser. Run "podwebserver -h" for a list of runtime options. INSTALLATION You install this module-suite, as you would install any perl module library, by running these commands: perl Makefile.PL make make test make install If you want to install a private copy of this module-suite in your home directory, then you should try to produce the initial Makefile with something like this command: perl Makefile.PL PREFIX=~/perl See perldoc perlmodinstall for more information on installing modules. SUPPORT Questions, bug reports, useful code bits, and suggestions for this module should just be sent to me at sburke@cpan.org AVAILABILITY The latest version of this module is available from the Comprehensive Perl Archive Network (CPAN). Visit to find a CPAN site near you. Pod-Webserver-3.10/META.json000444001750001750 357212461070614 14466 0ustar00ronron000000000000{ "abstract" : "Minimal web server for local Perl documentation", "author" : [ "Sean M. Burke C" ], "dynamic_config" : 1, "generated_by" : "Module::Build version 0.4211", "license" : [ "artistic_2" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Pod-Webserver", "prereqs" : { "build" : { "requires" : { "Test::More" : "0.94", "Test::TCP" : "2.02", "Test::Version" : "1.002003" } }, "configure" : { "requires" : { "Module::Build" : "0.38" } }, "runtime" : { "requires" : { "File::Spec" : "0", "File::Spec::Unix" : "0", "IO::Socket" : "0", "Pod::Simple" : "3.01", "Pod::Simple::HTML" : "0", "Pod::Simple::HTMLBatch" : "0", "Pod::Simple::Progress" : "0", "Test::Version" : "1.002003", "strict" : "0", "warnings" : "0" } } }, "provides" : { "Pod::Webserver" : { "file" : "lib/Pod/Webserver.pm", "version" : "3.10" }, "Pod::Webserver::Connection" : { "file" : "lib/Pod/Webserver/Connection.pm", "version" : "3.09" }, "Pod::Webserver::Daemon" : { "file" : "lib/Pod/Webserver/Daemon.pm", "version" : "3.10" }, "Pod::Webserver::Request" : { "file" : "lib/Pod/Webserver/Request.pm", "version" : "3.10" }, "Pod::Webserver::Response" : { "file" : "lib/Pod/Webserver/Response.pm", "version" : "3.10" } }, "release_status" : "stable", "resources" : { "license" : [ "http://www.perlfoundation.org/artistic_license_2_0" ] }, "version" : "3.10" } Pod-Webserver-3.10/Makefile.PL000444001750001750 323512461070614 15013 0ustar00ronron000000000000use 5.004; # Sane minimum, I think. use strict; use warnings; use ExtUtils::MakeMaker; # ----------------------------------------------- # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. my(%params) = ( ($] ge '5.005') ? ( AUTHOR => 'Sean M. Burke C', ABSTRACT => 'Minimal web server for local Perl documentation', ) : (), clean => { FILES => 'blib/* Makefile MANIFEST Pod-Webserver-*' }, dist => { COMPRESS => 'gzip', SUFFIX => 'gz' }, DISTNAME => 'Pod-Webserver', EXE_FILES => ['bin/podwebserver'], NAME => 'Pod::Webserver', PL_FILES => {}, PREREQ_PM => { 'File::Spec' => 0, 'File::Spec::Unix' => 0, 'IO::Socket' => 0, 'Pod::Simple' => 3.01, 'Pod::Simple::HTML' => 0, 'Pod::Simple::HTMLBatch' => 0, 'Pod::Simple::Progress' => 0, 'strict' => 0, 'Test::More' => 0.94, # 'Test::Pod' => 1.45, # Make it optional. See xt/author/pod.t 'Test::TCP' => 2.02, 'Test::Version' => 1.002003, 'warnings' => 0, }, VERSION_FROM => 'lib/Pod/Webserver.pm', ); if ( ($ExtUtils::MakeMaker::VERSION =~ /^\d\.\d\d$/) && ($ExtUtils::MakeMaker::VERSION > 6.30) ) { $params{LICENSE} = 'artistic_2_0'; } if ($ExtUtils::MakeMaker::VERSION ge '6.46') { $params{META_MERGE} = { resources => { bugtracker => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Pod-Webserver', license => 'http://opensource.org/licenses/Artistic-2.0', repository => 'https://github.com/ronsavage/Pod-Webserver', }, }; } WriteMakefile(%params); Pod-Webserver-3.10/Changelog.ini000444001750001750 754212461070614 15436 0ustar00ronron000000000000[Module] Name=Pod::Webserver: Changelog.Creator=Module::Metadata::Changes V 2.05 Changelog.Parser=Config::IniFiles V 2.83 [V 3.10] Date=2014-01-25T13:32:00 Comments= < - Added an explicit VERSION to Pod::Webserver::Daemon, to pass the tests on Perl version 5.10.0. EOT [V 3.04] Date=2006-09-12T12:00:00 Comments= < - Applied a patch from Nicholas Clark to eliminate the dependency on LWP, so the module could be incorporated into the Perl core. Mad props to Nick for the networking code! EOT [V 3.03] Date=2004-06-20T12:00:00 Deploy.Action=Upgrade Deploy.Reason=Security Comments= < - No code changes; I merely added some extra docs about -T and security and @INC things. - Thanks for all your supportive email! I am surprised by what a hit this module has become! EOT [V 3.02] Date=2004-05-25T12:00:00 Comments= < - First released version. EOT [V 1.00] Date=2004-05-24T12:00:00 Comments=- Sean M. Burke Pod-Webserver-3.10/Changes000444001750001750 712612461070614 14337 0ustar00ronron000000000000Revision history for Perl module Pod::Webserver: 3.10 Sun Jan 25 13:32:00 2014 - Change default timeout from 5 to 24 hours. - Rewrite bareword filehandles (INX) to use a variable (my $fh). - Rename github repo from Pod--Webserver to Pod-Webserver - My new standard. Update Build.PL and Makefile.PL to match. - Reformat the docs, and this file, slighty, to be <= 100 chars per line - My new standard. 3.09 Wed Feb 26 15:53:00 2014 - Use Test::TCP's Net::EmptyPort to pick a port to use for testing. See daemon.t. Note: The env var $PODWEBSERVERPORT (used only for testing) still takes precedence. 3.08 Fri Feb 14 13:28:00 2014 - Change t/daemon.t to use $ENV{PODWBSERVERPORT} || 39383, not 8020, for both server and client. This means tests run even if 'podwebserver' is aleady running. 3.07 Fri Feb 14 12:00:00 2014 - Split out each package into its own file. - Rearrange methods per file into alphabetical order. - Clean up datestamps in this file. 3.06 Mon Feb 10 12:00:00 2014 - Ron Savage is now co-maint. - Remove 'require 5;' from the source. If you're running Perl V 4, you'll have even more problems now. - Add a -t (timeout) parameter. The unit is seconds. Timeout defaults (as always) to 18,000 = 5 hours. This addresses RT#21582. Thanx to Ivor Williams for the 2006 report. Yes, it has been a regrettably long time, hasn't it? - Remove spaces in option string passed to Getopt::Std. This addresses RT#44520. Thanx to Marek.Rouchal for the 2009 report. This problem was also noted in RT#55106. Thanx to COSMICNET for the 2010 report. This problem was also noted in RT#62939. Thanx to Allison Randal for the 2010 report. - Add -d (dirs to include) and -e (dirs to exclude) parameters. This addresses RT#55106. Thanx to COSMICNET for the 2010 patch. - Flag RT#59890 as not-an-error, since http://localhost:8020/pods/perlfaq is not (presumably) output by the code, and hence is not the jumping-off point for any within-FAQ links. - Re-word error messages, and use die rather than a combination of die and Carp. - Change licence from Perl to Artistic 2, since the Perl licence is not listed at http://opensource.org/licenses. - Switch tests from using Test to Test::More. - Move podwebserver script into bin/. - Add Build.PL. - Create repository on github and add to Build.PL and Makefile.PL. - Add t/version.t. - Add xt/author/pod.t. - Expand docs slightly. - Ensure port and timeout parameters are integers. Print help and exit if not. - Expand help message. - Include File::Spec in the pre-reqs. It's used by the new -d and -e options. - Replace brief MANIFEST.SKIP with long version (copied from GraphViz2). - Reformat this file so it can be read by Module::Metadata::Changes' ini.report.pl. - Rename ChangeLog to Changes. - Add Changelog.ini (output of ini.report.pl). 3.05 Wed Jan 09 12:00:00 2008 - Allison Randal - Added an explicit VERSION to Pod::Webserver::Daemon, to pass the tests on Perl version 5.10.0. 3.04 Tue Sep 12 12:00:00 2006 - Allison Randal - Applied a patch from Nicholas Clark to eliminate the dependency on LWP, so the module could be incorporated into the Perl core. Mad props to Nick for the networking code! 3.03 Sun Jun 20 12:00:00 2004 - Sean M. Burke - No code changes; I merely added some extra docs about -T and security and @INC things. - Thanks for all your supportive email! I am surprised by what a hit this module has become! 3.02 Tue May 25 12:00:00 2004 - Sean M. Burke - First released version. 1.00 Mon May 24 12:00:00 2004 - Sean M. Burke Pod-Webserver-3.10/META.yml000444001750001750 231212461070614 14305 0ustar00ronron000000000000--- abstract: 'Minimal web server for local Perl documentation' author: - 'Sean M. Burke C' build_requires: Test::More: '0.94' Test::TCP: '2.02' Test::Version: '1.002003' configure_requires: Module::Build: '0.38' dynamic_config: 1 generated_by: 'Module::Build version 0.4211, CPAN::Meta::Converter version 2.142060' license: artistic_2 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Pod-Webserver provides: Pod::Webserver: file: lib/Pod/Webserver.pm version: '3.10' Pod::Webserver::Connection: file: lib/Pod/Webserver/Connection.pm version: '3.09' Pod::Webserver::Daemon: file: lib/Pod/Webserver/Daemon.pm version: '3.10' Pod::Webserver::Request: file: lib/Pod/Webserver/Request.pm version: '3.10' Pod::Webserver::Response: file: lib/Pod/Webserver/Response.pm version: '3.10' requires: File::Spec: '0' File::Spec::Unix: '0' IO::Socket: '0' Pod::Simple: '3.01' Pod::Simple::HTML: '0' Pod::Simple::HTMLBatch: '0' Pod::Simple::Progress: '0' Test::Version: '1.002003' strict: '0' warnings: '0' resources: license: http://www.perlfoundation.org/artistic_license_2_0 version: '3.10' Pod-Webserver-3.10/MANIFEST000444001750001750 53612461070614 14153 0ustar00ronron000000000000bin/podwebserver Build.PL Changelog.ini Changes lib/Pod/Webserver.pm lib/Pod/Webserver/Connection.pm lib/Pod/Webserver/Daemon.pm lib/Pod/Webserver/Request.pm lib/Pod/Webserver/Response.pm Makefile.PL MANIFEST META.json META.yml Module meta-data (added by MakeMaker) README t/about_verbose.t t/daemon.t t/pod_webserver.t t/version.t xt/author/pod.t Pod-Webserver-3.10/bin000755001750001750 012461070614 13451 5ustar00ronron000000000000Pod-Webserver-3.10/bin/podwebserver000555001750001750 10312461070614 16215 0ustar00ronron000000000000#!/usr/bin/perl #-T use Pod::Webserver; Pod::Webserver::httpd(); Pod-Webserver-3.10/lib000755001750001750 012461070614 13447 5ustar00ronron000000000000Pod-Webserver-3.10/lib/Pod000755001750001750 012461070614 14171 5ustar00ronron000000000000Pod-Webserver-3.10/lib/Pod/Webserver.pm000444001750001750 4400712461070614 16655 0ustar00ronron000000000000package Pod::Webserver; use parent 'Pod::Simple::HTMLBatch'; use strict; use vars qw( $VERSION @ISA ); use Pod::Webserver::Daemon; use Pod::Webserver::Response; use Pod::Simple::HTMLBatch; use Pod::Simple::TiedOutFH; use Pod::Simple; use IO::Socket; use File::Spec; use File::Spec::Unix (); our $VERSION = '3.10'; # ------------------------------------------------ BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } elsif( ($ENV{'PODWEBSERVERDEBUG'} || '') =~ m/^(\d+)$/ ) { my $x = $1; *DEBUG = sub(){$x} } else { *DEBUG = sub () {0}; } } # End of BEGIN. # ------------------------------------------------ #sub Pod::Simple::HTMLBatch::DEBUG () {5} # ------------------------------------------------ sub add_to_fs { # add an item to my virtual in-memory filesystem my($self,$file,$type,$content) = @_; die "Missing filespec\n" unless defined $file and length $file; $file = "/$file"; $file =~ s{/+}{/}s; $type ||= $file eq '/' ? 'text/html' # special case : $file =~ m/\.dat?/ ? 'application/octet-stream' : $file =~ m/\.html?/ ? 'text/html' : $file =~ m/\.txt/ ? 'text/plain' : $file =~ m/\.gif/ ? 'image/gif' : $file =~ m/\.jpe?g/ ? 'image/jpeg' : $file =~ m/\.png/ ? 'image/png' : 'text/plain' ; $content = '' unless defined ''; $self->{'__daemon_fs'}{"\e$file"} = $type; \( $self->{'__daemon_fs'}{$file} = $content ); } # End of add_to_fs. # ------------------------------------------------ sub _arg_h { my $class = ref($_[0]) || $_[0]; $_[0]->_arg_V; print join "\n", "Usage:", " podwebserver = Start podwebserver on localhost:8020. Search \@INC", " podwebserver -p 1234 = Start podwebserver on localhost:1234", " podwebserver -p 1234 -H blorp = Start podwebserver on blorp:1234", " podwebserver -t 3600 = Auto-exit in 1 hour. Default => 18000 (5 hours). 0 => No timeout", " podwebserver -d /path/to/lib = Ignore \@INC, and only search within /path/to/lib", " podwebserver -e /path/to/skip = Exclude /path/to/skip files", " podwebserver -q = Quick startup (but no Table of Contents)", " podwebserver -v = Run with verbose output to STDOUT", " podwebserver -h = See this message", " podwebserver -V = Show version information", "\nRun 'perldoc $class' for more information.", ""; return; } # End of _arg_h. # ------------------------------------------------ sub _arg_V { my $class = ref($_[0]) || $_[0]; # # Anything else particularly useful to report here? # print '', __PACKAGE__, " version $VERSION", # and report if we're running a subclass: (__PACKAGE__ eq $class) ? () : (" ($class)"), "\n", ; print " Running under perl version $] for $^O", (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n"; print " Win32::BuildNumber ", &Win32::BuildNumber(), "\n" if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber(); print " MacPerl verison $MacPerl::Version\n" if defined $MacPerl::Version; return; } # End of _arg_V. # ------------------------------------------------ sub _contents_filespec { return '/' } # overriding the superclass's # ------------------------------------------------ sub filespecsys { $_[0]{'_filespecsys'} || 'File::Spec::Unix' } # ------------------------------------------------ sub _get_options { my($self) = shift; $self->verbose(0); return unless @ARGV; require Getopt::Std; my %o; Getopt::Std::getopts( "d:e:H:hp:qt:Vv" => \%o ) || die "Failed to parse options\n"; # The 2 switches that shortcut the run: $o{'h'} and exit( $self->_arg_h || 0); $o{'V'} and exit( $self->_arg_V || 0); $self->_arg_h, exit(0) if ($o{p} and ($o{p} !~ /^\d+$/) ); $self->_arg_h, exit(0) if ($o{t} and ($o{t} !~ /^\d+$/) ); $self->dir_exclude( [ map File::Spec->canonpath($_), split(/:|;/, $o{'e'}) ] ) if ($o{'e'}); $self->dir_include( [ map File::Spec->canonpath($_), split(/:|;/, $o{'d'}) ] ) if ($o{'d'}); $self->httpd_host( $o{'H'} ) if $o{'H'}; $self->httpd_port( $o{'p'} ) if $o{'p'}; $self->httpd_timeout( $o{'t'} ) if $o{'t'}; $self->skip_indexing(1) if $o{'q'}; $self->verbose(4) if $o{'v'}; return; } # End of _get_options. # ------------------------------------------------ # Run me as: perl -MPod::HTTP -e Pod::Webserver::httpd # or (assuming you have it installed), just run "podwebserver" sub httpd { my $self = @_ ? shift(@_) : __PACKAGE__; $self = $self->new unless ref $self; $self->{'_batch_start_time'} = time(); $self->_get_options; $self->_init_options; $self->contents_file('/'); $self->prep_for_daemon; my $daemon = $self->new_daemon || return; my $url = $daemon->url; $url =~ s{//default\b}{//localhost} if $^O =~ m/Win32/; # lame hack DEBUG > -1 and print "You can now open your browser to $url\n"; return $self->run_daemon($daemon); } # End of httpd. # ------------------------------------------------ sub _init_options { my($self) = shift; $self->dir_exclude([]); $self->dir_include([@INC]); } # End of _init_options. # ------------------------------------------------ sub makepath { return } # overriding the superclass's # ------------------------------------------------ #sub muse { return 1 } # ------------------------------------------------ sub new_daemon { my $self = shift; my @opts; push @opts, LocalHost => $self->httpd_host if (defined $self->httpd_host); push @opts, LocalPort => $self->httpd_port || 8020; if (defined $self->httpd_timeout) { if ($self->httpd_timeout > 0) { push @opts, Timeout => $self->httpd_timeout; } } else { push @opts, Timeout => 24 * 3600; # Default to exit after 24 hours of idle time. } $self->muse( "Starting daemon with options {@opts}" ); Pod::Webserver::Daemon->new(@opts) || die "Can't start a daemon: $!\n"; } # End of _new_daemon. # ------------------------------------------------ sub prep_for_daemon { my($self) = shift; DEBUG > -1 and print "I am process $$ = perl ", __PACKAGE__, " v$VERSION\n"; $self->{'__daemon_fs'} = {}; # That's where we keep the bodies!!!! $self->{'__expires_as_http_date'} = time2str(24*3600+time); $self->{ '__start_as_http_date'} = time2str( time); $self->add_to_fs( 'robots.txt', 'text/plain', join "\cm\cj", "User-agent: *", "Disallow: /", "", "", "# I am " . __PACKAGE__ . " v$VERSION", "", "", ); $self->add_to_fs( '/', 'text/html', # We get this only when we start up in -q mode: "* Perl Pod server *\n

Example URL: http://whatever/Getopt/Std\n\n" ); $self->_spray_css( '/' ); $self->_spray_javascript( '/' ); DEBUG > 5 and print "In FS: ", join(' ', map qq{"$_"}, sort grep !m/^\e/, keys %{ $self->{'__daemon_fs'} }), "\n"; $self->prep_lookup_table(); return; } # End of prep_for_daemon. # ------------------------------------------------ sub prep_lookup_table { my $self = shift; my $m2p; if( $self->skip_indexing ) { $self->muse("Skipping \@INC indexing."); } else { if($self->progress) { DEBUG and print "Using existing progress object\n"; } elsif( DEBUG or ($self->verbose() >= 1 and $self->verbose() <= 5) ) { require Pod::Simple::Progress; $self->progress( Pod::Simple::Progress->new(4) ); } my $search = $Pod::Simple::HTMLBatch::SEARCH_CLASS->new; my $dir_include = $self->dir_include; if(DEBUG > -1) { if ($#{$self->dir_include} >= 0) { print " Indexing all of @$dir_include -- this might take a minute.\n"; } else { print " Indexing all of \@INC -- this might take a minute.\n"; DEBUG > 1 and print "\@INC = [ @INC ]\n"; } $self->{'httpd_has_noted_inc_already'} ++; } $m2p = $self->modnames2paths($dir_include ? $dir_include : undef); $self->progress(0); # Filter out excluded folders while ( my ($key, $value) = each %$m2p ) { DEBUG > 1 and print "-e $value, ", (grep $value =~ /^\Q$_\E/, @{ $self->dir_exclude }), "\n"; delete $m2p->{$key} if grep $value =~ /^\Q$_\E/, @{ $self->dir_exclude }; } die "Missing path\n" unless $m2p and keys %$m2p; DEBUG > -1 and print " Done scanning \n"; foreach my $modname (sort keys %$m2p) { my @namelets = split '::', $modname; $self->note_for_contents_file( \@namelets, 'crunkIn', 'crunkOut' ); } $self->write_contents_file('crunkBase'); } $self->{'__modname2path'} = $m2p || {}; return; } # End of prep_lookup_table. # ------------------------------------------------ sub run_daemon { my($self, $daemon) = @_; while( my $conn = $daemon->accept ) { if( my $req = $conn->get_request ) { #^^ That used to be a while(... instead of an if( ..., but the # keepalive wasn't working so great, so let's just leave it for now. # It's not like our server here is streaming GIFs or anything. DEBUG and print "Answering connection at ", localtime()."\n"; $self->_serve_thing($conn, $req); } $conn->close; undef($conn); } $self->muse("HTTP Server terminated"); return; } # End of run_daemon. # ------------------------------------------------ sub _serve_pod { my($self, $modname, $filename, $resp) = @_; unless( -e $filename and -r _ and -s _ ) { # sanity $self->muse( "But filename $filename is no good!" ); return; } my $modtime = (stat(_))[9]; # use my own modtime whynot! $resp->content(''); my $contr = $resp->content_ref; $Pod::Simple::HTMLBatch::HTML_EXTENSION = $Pod::Simple::HTML::HTML_EXTENSION = ''; $resp->header('Last-Modified' => time2str($modtime) ); my $retval; if( # This is totally gross and hacky. So unless your name rhymes # with "Pawn Lurk", you have to cover your eyes right now. $retval = $self->_do_one_batch_conversion( $modname, { $modname => $filename }, '/', Pod::Simple::TiedOutFH->handle_on($contr), ) ) { $self->muse( "$modname < $filename" ); } else { $self->muse( "Ugh, couldn't convert $modname" ); } return $retval; } # End of _serve_pod. # ------------------------------------------------ sub _serve_thing { my($self, $conn, $req) = @_; return $conn->send_error(405) unless $req->method eq 'GET'; # sanity my $path = $req->url; $path .= substr( ($ENV{PATH} ||''), 0, 0); # to force-taint it. my $fs = $self->{'__daemon_fs'}; my $pods = $self->{'__modname2path'}; my $resp = Pod::Webserver::Response->new(200); $resp->content_type( $fs->{"\e$path"} || 'text/html' ); $path =~ s{:+}{/}g; my $modname = $path; $modname =~ s{/+}{::}g; $modname =~ s{^:+}{}; $modname =~ s{:+$}{}; $modname =~ s{:+$}{::}g; if( $modname =~ m{^([a-zA-Z0-9_]+(?:::[a-zA-Z0-9_]+)*)$}s ) { $modname = $1; # thus untainting } else { $modname = ''; } DEBUG > 1 and print "Modname $modname ($path)\n"; if( $fs->{$path} ) { # Is it in our mini-filesystem? $resp->content( $fs->{$path} ); $resp->header( 'Last-Modified' => $self->{ '__start_as_http_date'} ); $resp->header( 'Expires' => $self->{'__expires_as_http_date'} ); $self->muse("Serving pre-cooked $path"); } elsif( $modname eq '' ) { $resp = ''; # After here, it's only untainted module names } elsif( $pods->{$modname} ) { # Is it known pod? #$self->muse("I know $modname as ", $pods->{$modname}); $self->_serve_pod( $modname, $pods->{$modname}, $resp ) or $resp = ''; } else { # If it's not known, look for it. # This is necessary for indexless mode, and also useful just in case # the user has just installed a new module (after the index was generated) my $fspath = $Pod::Simple::HTMLBatch::SEARCH_CLASS->new->find($modname); if( defined($fspath) ) { #$self->muse("Found $modname as $fspath"); $self->_serve_pod( $modname, $fspath, $resp ); } else { $resp = ''; $self->muse("Can't find $modname in \@INC"); unless( $self->{'httpd_has_noted_inc_already'} ++ ) { $self->muse(" \@INC = [ @INC ]"); } } } $resp ? $conn->send_response( $resp ) : $conn->send_error(404); return; } # End of _serve_thing. # ------------------------------------------------ sub _wopen { # overriding the superclass's my($self, $outpath) = @_; return Pod::Simple::TiedOutFH->handle_on( $self->add_to_fs($outpath) ); } # End of _wopen. # ------------------------------------------------ sub write_contents_file { my $self = shift; $Pod::Simple::HTMLBatch::HTML_EXTENSION = $Pod::Simple::HTML::HTML_EXTENSION = ''; return $self->SUPER::write_contents_file(@_); } # End of write_contents_file. # ------------------------------------------------ sub url_up_to_contents { return '/' } # overriding the superclass's # ------------------------------------------------ # Inlined from HTTP::Date to avoid a dependency { my @DoW = qw(Sun Mon Tue Wed Thu Fri Sat); my @MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); sub time2str (;$) { my $time = shift; my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time); sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT", $DoW[$wday], $mday, $MoY[$mon], $year+1900, $hour, $min, $sec); } } # ------------------------------------------------ __PACKAGE__->Pod::Simple::_accessorize( 'dir_include', 'dir_exclude', 'httpd_port', 'httpd_host', 'httpd_timeout', 'skip_indexing', ); httpd() unless caller; # ------------------------------------------------ 1; __END__ =head1 NAME Pod::Webserver -- Minimal web server for local Perl documentation =head1 SYNOPSIS % podwebserver ... You can now open your browser to http://localhost:8020/ =head1 DESCRIPTION This module can be run as an application that works as a minimal web server to serve local Perl documentation. It's like L except it works through your browser. C displays help: Pod::Webserver version 3.06 Running under perl version 5.018002 for linux Usage: podwebserver = Start podwebserver on localhost:8020. Search @INC podwebserver -p 1234 = Start podwebserver on localhost:1234 podwebserver -p 1234 -H blorp = Start podwebserver on blorp:1234 podwebserver -t 3600 = Auto-exit in 1 hour. Default => 86000 (24 hours) 0 => No timeout, but does not work for me podwebserver -d /path/to/lib = Ignore @INC, and only search within /path/to/lib podwebserver -e /path/to/skip = Exclude /path/to/skip files podwebserver -q = Quick startup (but no Table of Contents) podwebserver -v = Run with verbose output to STDOUT podwebserver -h = See this message podwebserver -V = Show version information Run 'perldoc Pod::Webserver' for more information. =head1 SECURITY (AND @INC) Pod::Webserver is not what you'd call a gaping security hole -- after all, all it does and could possibly do is serve HTML versions of anything you could get by typing "perldoc SomeModuleName". Pod::Webserver won't serve files at arbitrary paths or anything. But do consider whether you're revealing anything by basically showing off what versions of modules you've got installed; and also consider whether you could be revealing any proprietary or in-house module documentation. And also consider that this exposes the documentation of modules (i.e., any Perl files that at all look like modules) in your @INC dirs -- and your @INC probably contains "."! If your current working directory could contain modules I you don't want anyone to see, then you could do two things: The cheap and easy way is to just chdir to an uninteresting directory: mkdir ~/.empty; cd ~/.empty; podwebserver The more careful approach is to run podwebserver under perl in -T (taint) mode (as explained in L), and to explicitly specify what extra directories you want in @INC, like so: perl -T -Isomepath -Imaybesomeotherpath -S podwebserver You can also use the -I trick (that's a capital "igh", not a lowercase "ell") to add dirs to @INC even if you're not using -T. For example: perl -I/that/thar/Module-Stuff-0.12/lib -S podwebserver An alternate approach is to use your shell's environment-setting commands to alter PERL5LIB or PERLLIB before starting podwebserver. These -T and -I switches are explained in L. But I'll note in passing that you'll likely need to do this to get your PERLLIB environment variable to be in @INC... perl -T -I$PERLLIB -S podwebserver (Or replacing that with PERL5LIB, if that's what you use.) =head2 ON INDEXING '.' IN @INC Pod::Webserver uses the module Pod::Simple::Search to build the index page you see at http://yourservername:8020/ (or whatever port you choose instead of 8020). That module's indexer has one notable DWIM feature: it reads over @INC, except that it skips the "." in @INC. But you can work around this by expressing the current directory in some other way than as just the single literal period -- either as some more roundabout way, like so: perl -I./. -S podwebserver Or by just expressing the current directory absolutely: perl -I`pwd` -S podwebserver Note that even when "." isn't indexed, the Pod in files under it are still accessible -- just as if you'd typed "perldoc whatever" and got the Pod in F<./whatever.pl> =head1 SEE ALSO This module is implemented using many CPAN modules, including: L L L L See also L and L =head1 COPYRIGHT AND DISCLAIMERS Copyright (c) 2004-2006 Sean M. Burke. All rights reserved. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. 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. =head1 Repository L =head1 AUTHOR Original author: Sean M. Burke C. Maintained by: Allison Randal C and Ron Savage C. =cut Pod-Webserver-3.10/lib/Pod/Webserver000755001750001750 012461070614 16135 5ustar00ronron000000000000Pod-Webserver-3.10/lib/Pod/Webserver/Daemon.pm000444001750001750 337012461070614 20036 0ustar00ronron000000000000package Pod::Webserver::Daemon; use strict; use warnings; use Pod::Webserver::Connection; our $VERSION = '3.10'; use Socket qw(PF_INET SOCK_STREAM SOMAXCONN inet_aton sockaddr_in); # ------------------------------------------------ sub accept { my $self = shift; my $sock = $self->{__sock}; my $rin = ''; vec($rin, fileno($sock), 1) = 1; # Sadly getting a valid returned time from select is not portable my $end = $self->{Timeout} + time; do { if (select ($rin, undef, undef, $self->{Timeout})) { # Ready for reading; my $got = do {local *GOT; \*GOT}; #$! = ""; accept $got, $sock or die "Error: accept failed: $!\n"; return Pod::Webserver::Connection->new($got); } } while (time < $end); return undef; } # End of accept. # ------------------------------------------------ sub new { my $class = shift; my $self = {@_}; $self->{LocalHost} ||= 'localhost'; # Anonymous file handles the 5.004 way: my $sock = do {local *SOCK; \*SOCK}; my $proto = getprotobyname('tcp') or die "Error in getprotobyname: $!\n"; socket($sock, PF_INET, SOCK_STREAM, $proto) or die "Can't create socket: $!\n"; my $host = inet_aton($self->{LocalHost}) or die "Can't resolve hostname '$self->{LocalHost}'\n"; my $sin = sockaddr_in($self->{LocalPort}, $host); bind $sock, $sin or die "Couldn't bind to $self->{LocalHost}:$self->{LocalPort}: $!\n"; listen $sock, SOMAXCONN or die "Couldn't listen on socket: $!\n"; $self->{__sock} = $sock; return bless $self, $class; } # End of accept. # ------------------------------------------------ sub url { my $self = shift; return "http://$self->{LocalHost}:$self->{LocalPort}/"; } # End of url. # ------------------------------------------------ 1; Pod-Webserver-3.10/lib/Pod/Webserver/Request.pm000444001750001750 74512461070614 20246 0ustar00ronron000000000000package Pod::Webserver::Request; use strict; use warnings; our $VERSION = '3.10'; # ------------------------------------------------ sub method { return $_[0]->{method}; } # End of method. # ------------------------------------------------ sub new { my $class = shift; return bless {@_}, $class } # End of new. # ------------------------------------------------ sub url { return $_[0]->{url}; } # End of url. # ------------------------------------------------ 1; Pod-Webserver-3.10/lib/Pod/Webserver/Response.pm000444001750001750 170512461070614 20431 0ustar00ronron000000000000package Pod::Webserver::Response; use strict; use warnings; our $VERSION = '3.10'; # ------------------------------------------------ # The real methods are setter/getters. We only need the setters. sub AUTOLOAD { my ($attrib) = $Pod::Webserver::Response::AUTOLOAD =~ /([^:]+)$/; $_[0]->{$attrib} = $_[1]; } # End of AUTOLOAD. # ------------------------------------------------ # The real method is a setter/getter. We only need the getter. sub content_ref { my $self = shift; return \$self->{content}; } # End of content_ref. # ------------------------------------------------ sub DESTROY {}; # ------------------------------------------------ sub header { my $self = shift; push @{$self->{header}}, @_; } # End of header. # ------------------------------------------------ sub new { my ($class, $status_code) = @_; return bless {code=>$status_code}, $class; } # End of new. # ------------------------------------------------ 1; Pod-Webserver-3.10/lib/Pod/Webserver/Connection.pm000444001750001750 331212461070614 20726 0ustar00ronron000000000000package Pod::Webserver::Connection; use strict; use warnings; use Pod::Webserver::Request; our $VERSION = '3.09'; # ------------------------------------------------ sub close { close $_[0]->{__fh}; } # End of close. # ------------------------------------------------ sub get_request { my $self = shift; my $fh = $self->{__fh}; my $line = <$fh>; if (!defined $line or !($line =~ m!^([A-Z]+)\s+(\S+)\s+HTTP/1\.\d+!)) { $self->send_error(400); return; } return Pod::Webserver::Request->new(method=>$1, url=>$2); } # End of get_request. # ------------------------------------------------ sub new { my ($class, $fh) = @_; return bless {__fh => $fh}, $class } # End of new. # ------------------------------------------------ sub send_error { my ($self, $status_code) = @_; my $message = "HTTP/1.0 $status_code HTTP error code $status_code\n" . "Date: " . Pod::Webserver::time2str(time) . "\n" . <<"EOM"; Content-Type: text/plain Something went wrong, generating code $status_code. EOM $message =~ s/\n/\15\12/gs; print {$self->{__fh}} $message; } # End of send_error. # ------------------------------------------------ sub send_response { my ($self, $response) = @_; my $message = "HTTP/1.0 200 OK\n" . "Date: " . Pod::Webserver::time2str(time) . "\n" . "Content-Type: $response->{content_type}\n"; # This is destructive, but for our local purposes it doesn't matter while (my ($name, $value) = splice @{$response->{header}}, 0, 2) { $message .= "$name: $value\n"; } $message .= "\n$response->{content}"; $message =~ s/\n/\15\12/gs; print {$self->{__fh}} $message; } # End of send_response. # ------------------------------------------------ 1; Pod-Webserver-3.10/t000755001750001750 012461070614 13144 5ustar00ronron000000000000Pod-Webserver-3.10/t/pod_webserver.t000444001750001750 463712461070614 16346 0ustar00ronron000000000000use strict; use warnings; use Test::More tests => 14; BEGIN { chdir "t" if -e "t"; } use Pod::Webserver; ok 1; # Test inlined time2str routine. require Time::Local if $^O eq "MacOS"; my $offset = ($^O eq "MacOS") ? Time::Local::timegm(0,0,0,1,0,70) : 0; my $time = (760233600 + $offset); # assume broken POSIX counting of seconds ok (Pod::Webserver::time2str($time), 'Thu, 03 Feb 1994 00:00:00 GMT'); # Test mock request object. my $req = Pod::Webserver::Request->new(method=>'GET', url=>'http://www.cpan.org'); ok ($req); ok ($req->method, 'GET'); ok ($req->url, 'http://www.cpan.org'); # Test mock response object. $time = (1139520862 + $offset); my $resp = Pod::Webserver::Response->new(200); ok ($resp); $resp->content('Dummy content.'); $resp->content_type( 'text/html' ); $resp->header( 'Last-Modified' => Pod::Webserver::time2str($time) ); $resp->header( 'Expires' => Pod::Webserver::time2str($time) ); # Test mock connection object response. my $testfile = 'dummysocket.txt'; open(my $fh, ">$testfile"); my $conn = Pod::Webserver::Connection->new(*$fh); ok ($conn); $conn->send_response($resp); $conn->close; my $captured_response; { open(COMP, $testfile); local $/ = ''; $captured_response = ; close COMP; unlink $testfile; } my $compare = "HTTP\/1.0 200 OK Date: .* GMT Content-Type: text\/html Last-Modified: Thu, 09 Feb 2006 21:34:22 GMT Expires: Thu, 09 Feb 2006 21:34:22 GMT Dummy content."; $compare =~ s/\n/\15\12/gs; ok ($captured_response, qr/$compare/); # Test mock connection object sending errors. open($fh, ">$testfile"); $conn = Pod::Webserver::Connection->new(*$fh); ok ($conn); $conn->send_error('404'); $conn->close; my $captured_error; { open(COMP, $testfile); local $/ = ''; $captured_error = ; close COMP; unlink $testfile; } $compare = "HTTP\/1.0 404 HTTP error code 404 Date: .* GMT Content-Type: text\/plain Something went wrong, generating code 404."; $compare =~ s/\n/\15\12/gs; ok ($captured_error, qr/$compare/); # Test mock connection object retrieving requests. open($fh, "+>$testfile"); print $fh "GET http://www.cpan.org/index.html HTTP/1.0\15\12"; close $fh; open($fh, "$testfile"); $conn = Pod::Webserver::Connection->new(*$fh); ok ($conn); $req = $conn->get_request; ok ($req); if ($req) { ok ($req->method, 'GET'); ok ($req->url, 'http://www.cpan.org/index.html'); } else { ok 0; ok 0; } $conn->close; unlink $testfile; exit; Pod-Webserver-3.10/t/daemon.t000444001750001750 354012461070614 14733 0ustar00ronron000000000000use strict; use warnings; use IO::Socket; use Test::More tests => 8; use Net::EmptyPort 'empty_port'; BEGIN { chdir "t" if -e "t"; if($ENV{PERL_CORE}) { @INC = '../lib'; } else { push @INC, '../lib'; } $ENV{'PODWEBSERVERPORT'} = empty_port() if (! $ENV{'PODWEBSERVERPORT'}); } # When run with the single argument 'client', the test script should run # a dummy client and exit. my $mode = shift || ''; my $port = $ENV{'PODWEBSERVERPORT'}; if ($mode eq 'client') { my $sock = IO::Socket::INET->new("localhost:$port") or die "Couldn't connect to localhost:$port: $!"; send ($sock,"GET Pod/Simple HTTP/1.0\15\12", 0x4); exit; } use Pod::Webserver; ok 1; my $ws = Pod::Webserver->new(); ok ($ws); $ws->dir_exclude([]); $ws->dir_include([@INC]); $ws->verbose(0); $ws->httpd_timeout(10); $ws->httpd_port($port); $ws->prep_for_daemon; my $daemon; eval { $daemon = $ws->new_daemon; }; if ($@) { die $@ . "Try setting the PODWEBSERVERPORT environment variable to another port"; } ok ($daemon); my $sock = $daemon->{__sock}; #shutdown ($sock, 2); # Create a dummy client in another process. use Config; my $perl = $Config{'perlpath'}; open(my $fh, "$perl daemon.t client |") or die "Can't exec client: $!"; # Accept a request from the dummy client. my $conn = $daemon->accept; ok ($conn); my $req = $conn->get_request; ok ($req); ok ($req->url, 'Pod/Simple'); ok ($req->method, 'GET'); $conn->close; close $fh; # Test the response from the daemon. my $testfile = 'dummysocket.txt'; open($fh, '>', $testfile); $conn = Pod::Webserver::Connection->new(*$fh); $ws->_serve_thing($conn, $req); $conn->close; my $captured_response; { open(my $fh1, $testfile); local $/ = ''; $captured_response = <$fh1>; close $fh1; unlink $testfile; } ok ($captured_response, qr/Pod::Simple/); shutdown ($sock, 2); exit; Pod-Webserver-3.10/t/version.t000444001750001750 26512461070614 15136 0ustar00ronron000000000000use strict; use warnings; use Test::More; use Test::Version 'version_all_ok', {is_strict => 1}; # ------------------------------------------------ version_all_ok; done_testing; Pod-Webserver-3.10/t/about_verbose.t000444001750001750 415212461070614 16327 0ustar00ronron000000000000use strict; use warnings; use Test::More tests => 2; ok 1; use Pod::Webserver; #chdir "t" if -e "t"; { my @out; push @out, "\n\nPerl v", defined($^V) ? sprintf('%vd', $^V) : $], " under $^O ", (defined(&Win32::BuildNumber) and defined &Win32::BuildNumber()) ? ("(Win32::BuildNumber ", &Win32::BuildNumber(), ")") : (), (defined $MacPerl::Version) ? ("(MacPerl version $MacPerl::Version)") : (), "\n" ; # Ugly code to walk the symbol tables: my %v; my @stack = (''); # start out in %:: my $this; my $count = 0; my $pref; while(@stack) { $this = shift @stack; die "Too many packages?" if ++$count > 1000; next if exists $v{$this}; next if $this eq 'main'; # %main:: is %:: #print "Peeking at $this => ${$this . '::VERSION'}\n"; if(defined $this . '::VERSION') { $v{$this} = $this . '::VERSION'; } elsif( defined *{$this . '::ISA'} or defined &{$this . '::import'} or ($this ne '' and grep defined *{$_}{'CODE'}, values %{$this . "::"}) # If it has an ISA, an import, or any subs... ) { # It's a class/module with no version. $v{$this} = undef; } else { # It's probably an unpopulated package. ## $v{$this} = '...'; } $pref = length($this) ? ($this . '::') : ''; push @stack, map m/^(.+)::$/ ? "$pref$1" : (), keys %{$this || {} }; #print "Stack: @stack\n"; } push @out, " Modules in memory:\n"; delete @v{'', '[none]'}; foreach my $p (sort {lc($a) cmp lc($b)} keys %v) { my($indent) = ' ' x (2 + ($p =~ tr/:/:/)); push @out, ' ', $indent, $p, defined($v{$p}) ? " v$v{$p};\n" : ";\n"; } push @out, sprintf "[at %s (local) / %s (GMT)]\n", scalar(gmtime), scalar(localtime); my $x = join '', @out; $x =~ s/^/#/mg; print $x; } print "# Running", (chr(65) eq 'A') ? " in an ASCII world.\n" : " in a non-ASCII world.\n", "#\n", ; print "# \@INC:\n", map("# [$_]\n", @INC), "#\n#\n"; print "# \%INC:\n"; foreach my $x (sort {lc($a) cmp lc($b)} keys %INC) { print "# [$x] = [", $INC{$x} || '', "]\n"; } print "#\n# Bye from ", __FILE__, "\n"; ok 1; Pod-Webserver-3.10/xt000755001750001750 012461070614 13334 5ustar00ronron000000000000Pod-Webserver-3.10/xt/author000755001750001750 012461070614 14636 5ustar00ronron000000000000Pod-Webserver-3.10/xt/author/pod.t000444001750001750 20412461070614 15716 0ustar00ronron000000000000use Test::More; eval "use Test::Pod 1.45"; plan skip_all => "Test::Pod 1.45 required for testing POD" if $@; all_pod_files_ok();