package PodViewer; use strict; use warnings; use base qw(CGI::Application); use CGI::Application::Plugin::TT 0.07; use CGI::Application::Plugin::HTMLPrototype; use CGI::Application::Plugin::ViewSource; use CGI::Util (); use LWP::UserAgent (); use HTML::TokeParser::Simple (); use CPAN::Config (); use Compress::Zlib; use File::Spec (); my $modules_source = File::Spec->catdir($CPAN::Config->{keep_source_where}, '/modules', '02packages.details.txt.gz'); sub setup { my $self = shift; $self->run_modes([qw( start autocomplete loadpod )]); } sub loadpod { my $self = shift; my $q = $self->query; my $name = $q->param('package_name'); my $p = HTML::TokeParser::Simple->new(url => 'http://search.cpan.org/search?module='.CGI::Util::escape($name)); my $html; my $divlevel = 0; my $starting = 0; while ( my $token = $p->get_token ) { no warnings qw(uninitialized); if ( $starting && $divlevel ) { if ( $token->is_start_tag('div') ) { $divlevel++; } elsif ( $token->is_end_tag('div') ) { $divlevel--; } elsif ( $token->is_tag('img') && $token->get_attr('src') =~ /^\// ) { next; # remove images with relative paths } elsif ( $token->is_tag('a') && $token->get_attr('href') =~ /^\// ) { # fully qualify relative paths $token->set_attr('href', 'http://search.cpan.org'.$token->get_attr('href')); } $html .= $token->as_is; } elsif ( $token->is_start_tag('div') && $token->get_attr('class') =~ /(pod|path)/ ) { $divlevel++; $starting++; $html .= $token->as_is; } } return $html || "Pod not found for module $name"; } sub autocomplete { my $self = shift; my $q = $self->query; my $name = $q->param('package_name'); my @names; if ($name) { my @options = map { qr/\Q$_\E/i } split ' ', $name; my $gz = Compress::Zlib::gzopen( $modules_source, "rb" ) or die "Cannot open $modules_source: $gzerrno\n"; while ($gz->gzreadline($_) > 0) { chomp; last unless $_; } # Example line: # CGI::Application::Session 0.07 C/CE/CEESHEK/CGI-Application-Session-0.07.tar.gz my $line; while ( $gz->gzreadline($line) > 0 && @names <= 6 ) { my ($package, $version, $location) = split /\s+/, $line, 3; push @names, format_package($package, $version, $location) unless grep { $package !~ $_ } @options; } $gz->gzclose(); } # The auto_complete_result method will properly format a response for you, # but the response I am making is a bit more complex than it allows, so I # am doing it the manual way #return $self->prototype->auto_complete_result(\@names); return ''; } sub format_package { my ($package, $version, $location) = @_; $version = '' if $version eq 'undef'; my $cpanid = (split /\//, $location)[2]; return qq{
  • $version
    $package
    $cpanid
  • }; } sub start { my $self = shift; return $self->tt_process(\*DATA); } 1; __DATA__ CGI::Application::Plugin::HTMLPrototype - PodViewer Example [% c.prototype.define_javascript_functions %]

    CGI::Application::Plugin::HTMLPrototype - PodViewer Example

    Code: PodViewer source

    Type in a part of a module name (or space separated list of search terms) and a list of CPAN modules matching your terms will be shown. Choose one and press enter (or click on the "Load Pod" button to load the documentation for that module!

    [% c.prototype.form_remote_tag( { url='podviewer.cgi' update='pod' loading=c.prototype.update_element_function( 'pod' { action='update' content='Loading Pod...' } ) } ) %] CPAN module:
    [% c.prototype.auto_complete_field( 'package_name', { url='podviewer.cgi' with="value+'&rm=autocomplete'" } ) %]