r76259 - in /branches/upstream/libcgi-application-plugin-viewcode-perl: ./ current/ current/lib/ current/lib/CGI/ current/lib/CGI/Application/ current/lib/CGI/Application/Plugin/ current/t/ current/t/lib/ current/t/lib/MyBase/
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Tue Jun 21 22:41:23 UTC 2011
Author: periapt-guest
Date: Tue Jun 21 22:41:21 2011
New Revision: 76259
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=76259
Log:
[svn-inject] Installing original source of libcgi-application-plugin-viewcode-perl (1.02)
Added:
branches/upstream/libcgi-application-plugin-viewcode-perl/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/Build.PL
branches/upstream/libcgi-application-plugin-viewcode-perl/current/Changes
branches/upstream/libcgi-application-plugin-viewcode-perl/current/MANIFEST
branches/upstream/libcgi-application-plugin-viewcode-perl/current/META.yml
branches/upstream/libcgi-application-plugin-viewcode-perl/current/Makefile.PL
branches/upstream/libcgi-application-plugin-viewcode-perl/current/README
branches/upstream/libcgi-application-plugin-viewcode-perl/current/TODO
branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/ViewCode.pm
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/00-pod.t
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/01-pod-coverage.t
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/02-view_code.t
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/03-view_pod.t
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/04-errors.t
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase.pm
branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/MyApp.pm
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/Build.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/Build.PL?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/Build.PL (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/Build.PL Tue Jun 21 22:41:21 2011
@@ -1,0 +1,22 @@
+use strict;
+use warnings;
+use Module::Build;
+use lib './t/lib';
+
+my $builder = Module::Build->new(
+ module_name => 'CGI::Application::Plugin::ViewCode',
+ license => 'perl',
+ dist_author => 'Michael Peters <mpeters at plusthree.com>',
+ dist_version_from => 'lib/CGI/Application/Plugin/ViewCode.pm',
+ requires => {
+ 'Test::More' => 0,
+ 'CGI::Application' => 4.00,
+ 'Syntax::Highlight::Perl::Improved' => 1.0,
+ 'Pod::Xhtml' => 1.0,
+ 'Test::LongString' => 0,
+ },
+ create_makefile_pl => 'small',
+ create_readme => 1,
+);
+
+$builder->create_build_script();
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/Changes?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/Changes (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/Changes Tue Jun 21 22:41:21 2011
@@ -1,0 +1,30 @@
+Revision history for CGI-Application-Plugin-ViewCode
+
+1.02
+ - Added ability to link to specific lines with an anchor tag
+ - Changed Build.PL create_makefile_pl option to 'small' so I don't
+ have to deal with EU::MM install details as well
+
+1.01
+ - No code changes, just cleaned up Makefile.PL and test scripts
+ to handle installation under CPAN
+
+1.00
+ - Added view_pod run mode to allow just the viewing of the formatted
+ POD using Pod::Xhtml
+
+0.04
+ - Now works with CGI::Application::Plugin::DevPopup
+
+0.03 July 12, 2005
+ - Better test coverage (98%)
+ - fail better if the user's mode_param() returns a reference
+ - doc fixes
+
+0.02 June 25, 2005
+ - Renamed 'ViewCode' from 'ViewSource'
+ - Removed hard coding of run mode param ('rm') into links
+
+0.01 June 25, 2005
+ - First version, released on an unsuspecting world.
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/MANIFEST?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/MANIFEST (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/MANIFEST Tue Jun 21 22:41:21 2011
@@ -1,0 +1,15 @@
+Build.PL
+Changes
+lib/CGI/Application/Plugin/ViewCode.pm
+Makefile.PL
+MANIFEST
+META.yml # Will be created by "make dist"
+README
+t/00-pod.t
+t/01-pod-coverage.t
+t/02-view_code.t
+t/03-view_pod.t
+t/04-errors.t
+t/lib/MyBase.pm
+t/lib/MyBase/MyApp.pm
+TODO
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/META.yml?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/META.yml (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/META.yml Tue Jun 21 22:41:21 2011
@@ -1,0 +1,20 @@
+---
+name: CGI-Application-Plugin-ViewCode
+version: 1.02
+author:
+ - Michael Peters <mpeters at plusthree.com>
+abstract: View the source of the running application
+license: perl
+resources:
+ license: http://dev.perl.org/licenses/
+requires:
+ CGI::Application: 4
+ Pod::Xhtml: 1
+ Syntax::Highlight::Perl::Improved: 1
+ Test::LongString: 0
+ Test::More: 0
+provides:
+ CGI::Application::Plugin::ViewCode:
+ file: lib/CGI/Application/Plugin/ViewCode.pm
+ version: 1.02
+generated_by: Module::Build version 0.2703
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/Makefile.PL?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/Makefile.PL (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/Makefile.PL Tue Jun 21 22:41:21 2011
@@ -1,0 +1,6 @@
+# Note: this file was auto-generated by Module::Build::Compat version 0.03
+ use Module::Build::Compat 0.02;
+
+ Module::Build::Compat->run_build_pl(args => \@ARGV);
+ require Module::Build;
+ Module::Build::Compat->write_makefile(build_class => 'Module::Build');
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/README?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/README (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/README Tue Jun 21 22:41:21 2011
@@ -1,0 +1,118 @@
+NAME
+ CGI::Application::Plugin::ViewCode - View the source of the running
+ application
+
+SYNOPSIS
+ In your CGI::Application based class
+
+ use CGI::Application::Plugin::ViewCode;
+
+ Then you can view your module's source (or pod) as it's running by
+ changing the url
+
+ ?rm=view_code
+ ?rm=view_code#215
+ ?rm=view_code&pod=0&line_no=0
+ ?rm=view_code&module=CGI-Application
+
+ ?rm=view_pod
+ ?rm=view_pod&module=CGI-Application
+
+INTERFACE
+ This plugin works by adding extra run modes (named `view_code' and `
+ view_pod ') to the application. By calling this run mode you can see the
+ source or POD of the running module (by default) or you can specify
+ which module you would like to view (see SECURITY).
+
+ view_code
+
+ This extra run mode will accept the following arguments in the query
+ string:
+
+ module
+ The name of the module to view. By default it is the module
+ currently being run. Also, since colons (':') aren't simply typed
+ into URL's, you can just substitute '-' for '::'.
+
+ ?rm=view_code?module=My-Base-Class
+
+ highlight
+ Boolean indicates whether syntax highlighting (using
+ Syntax::Highlight::Perl::Improved) is `on' or `off'. By default it
+ is `on'.
+
+ line_no
+ Boolean indicates whether the viewing of line numbers is `on' or
+ `off'. By default it is `on'. It `line_no' is on, you can also
+ specify which line number you want to see by adding an anchor to the
+ link:
+
+ ?rm=view_code#215
+
+ This will take you immediately to line 215 of the current
+ application module.
+
+ pod Boolean indicates whether POD is seen or not. By default it is
+ seen>.
+
+ view_pod
+
+ This extra run mode will accept the following arguments in the query
+ string:
+
+ module
+ The name of the module to view. By default it is the module
+ currently being run. Also, since colons (':') aren't simply typed
+ into URL's, you can just substitute '-' for '::'.
+
+ ?rm=view_pod?module=My-Base-Class
+
+AS A POPUP WINDOW
+ This plugin can be used in conjunction with
+ CGI::Application::Plugin::DevPopup. If we detect that
+ CGI::Application::Plugin::DevPopup is running and turned on, we will
+ create a sub-report that includes the highlighted source code.
+
+ So you can simply do the following:
+
+ BEGIN { $ENV{CAP_DEVPOPUP_EXEC} = 1; } # turn it on for real
+ use CGI::Application::Plugin::DevPopup;
+ use CGI::Application::Plugin::ViewCode;
+
+ Befault, this report will be the same thing produced by `view_code'. If
+ you want this report to include the `view_pod' report, simply set the
+ the `$ENV{CAP_VIEWCODE_POPUP_POD}' to true. You can also turn off the
+ `view_code' report but setting `$ENV{CAP_VIEWCODE_POPUP_CODE}' to false.
+
+ # have the POD report, but not the code in the dev popup window
+ BEGIN {
+ $ENV{CAP_DEVPOPUP_EXEC} = 1; # turn it on for real
+ $ENV{CAP_VIEWCODE_POPUP_POD} = 1; # turn on POD report
+ $ENV{CAP_VIEWCODE_POPUP_CODE} = 0; # turn off code report
+ }
+ use CGI::Application::Plugin::DevPopup;
+ use CGI::Application::Plugin::ViewCode;
+
+SECURITY
+ This plugin is designed to be used for development only. Please do not
+ use it in a production system as it will allow anyone to see the source
+ code for any loaded module. Consider yourself warned.
+
+AUTHOR
+ Michael Peters, `<mpeters at plusthree.com>'
+
+BUGS
+ Please report any bugs or feature requests to
+ `bug-cgi-application-plugin-viewsource at rt.cpan.org', or through the web
+ interface at
+ http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-Vi
+ ewCode. I will be notified, and then you'll automatically be notified of
+ progress on your bug as I make changes.
+
+ACKNOWLEDGEMENTS
+COPYRIGHT & LICENSE
+ Copyright 2005 Michael Peters, All Rights Reserved.
+
+ This program is free software; you can redistribute it and/or modify it
+ under the same terms as Perl itself.
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/TODO
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/TODO?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/TODO (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/TODO Tue Jun 21 22:41:21 2011
@@ -1,0 +1,3 @@
+For 1.0
++ allow a limit to the paths for links in source
++ integrate with CAP::DevPopup
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/ViewCode.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/ViewCode.pm?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/ViewCode.pm (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/lib/CGI/Application/Plugin/ViewCode.pm Tue Jun 21 22:41:21 2011
@@ -1,0 +1,387 @@
+package CGI::Application::Plugin::ViewCode;
+use warnings;
+use strict;
+
+=head1 NAME
+
+CGI::Application::Plugin::ViewCode - View the source of the running application
+
+=cut
+
+our $VERSION = '1.02';
+
+# DEFAULT_STYLES taken from Apache::Syntax::Highlight::Perl by Enrico Sorcinelli
+our %DEFAULT_STYLES = (
+ 'Comment_Normal' => 'color:#006699;font-style:italic;',
+ 'Comment_POD' => 'color:#001144;font-style:italic;',
+ 'Directive' => 'color:#339999;font-style:italic;',
+ 'Label' => 'color:#993399;font-style:italic;',
+ 'Quote' => 'color:#0000aa;',
+ 'String' => 'color:#0000aa;',
+ 'Subroutine' => 'color:#998800;',
+ 'Variable_Scalar' => 'color:#008800;',
+ 'Variable_Array' => 'color:#ff7700;',
+ 'Variable_Hash' => 'color:#8800ff;',
+ 'Variable_Typeglob' => 'color:#ff0033;',
+ 'Whitespace' => 'white-space: pre;',
+ 'Character' => 'color:#880000;',
+ 'Keyword' => 'color:#000000;',
+ 'Builtin_Operator' => 'color:#330000;',
+ 'Builtin_Function' => 'color:#000011;',
+ 'Operator' => 'color:#000000;',
+ 'Bareword' => 'color:#33AA33;',
+ 'Package' => 'color:#990000;',
+ 'Number' => 'color:#ff00ff;',
+ 'Symbol' => 'color:#000000;',
+ 'CodeTerm' => 'color:#000000;',
+ 'DATA' => 'color:#000000;',
+ 'LineNumber' => 'color:#BBBBBB;'
+);
+
+our %SUBSTITUTIONS = (
+ '<' => '<',
+ '>' => '>',
+ '&' => '&',
+);
+
+=head1 SYNOPSIS
+
+In your CGI::Application based class
+
+ use CGI::Application::Plugin::ViewCode;
+
+Then you can view your module's source (or pod) as it's running by changing the url
+
+ ?rm=view_code
+ ?rm=view_code#215
+ ?rm=view_code&pod=0&line_no=0
+ ?rm=view_code&module=CGI-Application
+
+ ?rm=view_pod
+ ?rm=view_pod&module=CGI-Application
+
+=head1 INTERFACE
+
+This plugin works by adding extra run modes (named C<view_code> and C< view_pod >) to the
+application. By calling this run mode you can see the source or POD of the running module
+(by default) or you can specify which module you would like to view (see L<SECURITY>).
+
+
+=head2 view_code
+
+This extra run mode will accept the following arguments in the query string:
+
+=over
+
+=item module
+
+The name of the module to view. By default it is the module currently being run. Also,
+since colons (':') aren't simply typed into URL's, you can just substitute '-' for '::'.
+
+ ?rm=view_code?module=My-Base-Class
+
+=item highlight
+
+Boolean indicates whether syntax highlighting (using L<Syntax::Highlight::Perl::Improved>)
+is C<on> or C<off>. By default it is C<on>.
+
+=item line_no
+
+Boolean indicates whether the viewing of line numbers is C<on> or C<off>. By default it is C<on>.
+It C<line_no> is on, you can also specify which line number you want to see by adding an anchor
+to the link:
+
+ ?rm=view_code#215
+
+This will take you immediately to line 215 of the current application module.
+
+=item pod
+
+Boolean indicates whether POD is seen or not. By default it is seen>.
+
+=back
+
+
+=head2 view_pod
+
+This extra run mode will accept the following arguments in the query string:
+
+=over
+
+=item module
+
+The name of the module to view. By default it is the module currently being run. Also,
+since colons (':') aren't simply typed into URL's, you can just substitute '-' for '::'.
+
+ ?rm=view_pod?module=My-Base-Class
+
+=back
+
+=head1 AS A POPUP WINDOW
+
+This plugin can be used in conjunction with L<CGI::Application::Plugin::DevPopup>. If we detect
+that L<CGI::Application::Plugin::DevPopup> is running and turned on, we will create a sub-report
+that includes the highlighted source code.
+
+
+So you can simply do the following:
+
+ BEGIN { $ENV{CAP_DEVPOPUP_EXEC} = 1; } # turn it on for real
+ use CGI::Application::Plugin::DevPopup;
+ use CGI::Application::Plugin::ViewCode;
+
+Befault, this report will be the same thing produced by C<view_code>. If you want this
+report to include the C<view_pod> report, simply set the the C<$ENV{CAP_VIEWCODE_POPUP_POD}>
+to true. You can also turn off the C<view_code> report but setting
+C<$ENV{CAP_VIEWCODE_POPUP_CODE}> to false.
+
+ # have the POD report, but not the code in the dev popup window
+ BEGIN {
+ $ENV{CAP_DEVPOPUP_EXEC} = 1; # turn it on for real
+ $ENV{CAP_VIEWCODE_POPUP_POD} = 1; # turn on POD report
+ $ENV{CAP_VIEWCODE_POPUP_CODE} = 0; # turn off code report
+ }
+ use CGI::Application::Plugin::DevPopup;
+ use CGI::Application::Plugin::ViewCode;
+
+=cut
+
+sub import {
+ my $caller = scalar(caller);
+ $caller->add_callback( init => \&_add_runmode );
+
+ # if we are running under CGI::Application::Plugin::DevPopup
+ if( $ENV{CAP_DEVPOPUP_EXEC} ) {
+ # if we wan't to add the POD report
+ if( exists $ENV{CAP_VIEWCODE_POPUP_POD} && $ENV{CAP_VIEWCODE_POPUP_POD} ) {
+ $caller->add_callback( devpopup_report => \&_view_pod );
+ }
+ # include the view_code report by default unless it's turned off
+ if(! (exists $ENV{CAP_VIEWCODE_POPUP_CODE} && !$ENV{CAP_VIEWCODE_POPUP_CODE}) ) {
+ $caller->add_callback( devpopup_report => \&_view_code );
+ }
+ }
+}
+
+sub _add_runmode {
+ my $self = shift;
+ $self->run_modes(
+ view_code => \&_view_code,
+ view_pod => \&_view_pod
+ );
+}
+
+sub _view_code {
+ my $self = shift;
+ my $query = $self->query;
+
+ my %options;
+ foreach my $opt qw(highlight line_no pod) {
+ if( defined $query->param($opt) ) {
+ $options{$opt} = $query->param($opt);
+ } else {
+ $options{$opt} = 1;
+ }
+ }
+
+ # get the file to be viewed
+ my $module = _module_name($query->param('module') || ref($self));
+ # change into file name
+ my $file = _module_file_name($module);
+
+ # make sure the file exists
+ if( $file && -e $file ) {
+ my $IN;
+ open($IN, $file)
+ or return _error("Could not open $file for reading! $!");
+ my @lines= <$IN>;
+
+ # if we aren't going to highlight then turn all colors/styles
+ # into simple black
+ my %styles = %DEFAULT_STYLES;
+ my $style_sec = '';
+ foreach my $style (keys %styles) {
+ $styles{$style} = 'color:#000000;'
+ if( !$options{highlight} );
+ $style_sec .= ".$style { $styles{$style} }\n";
+ }
+
+ # now use Syntax::Highlight::Perl::Improved to do the work
+ require Syntax::Highlight::Perl::Improved;
+ my $formatter = Syntax::Highlight::Perl::Improved->new();
+ $formatter->define_substitution(%SUBSTITUTIONS);
+ foreach my $style (keys %styles) {
+ $formatter->set_format($style, [qq(<span class="$style">), qq(</span>)]);
+ }
+ @lines = $formatter->format_string(@lines);
+
+ # if we want line numbers
+ if( $options{line_no} ) {
+ my $i = 1;
+ @lines = map {
+ (qq(<span class="LineNumber"><a name="$i">) . $i++ . qq(:</a></span> ). $_)
+ } @lines;
+ }
+
+ # apply any other transformations necessary
+ if( $options{highlight} || !$options{pod} ) {
+ foreach my $line (@lines) {
+ # if they don't want the pod
+ if( !$options{pod} ) {
+ if( $line =~ /<span class="Comment_POD"/ ) {
+ $line = '';
+ next;
+ }
+ }
+
+ # if they are highlighting
+ if( $options{highlight} ) {
+ if( $line =~ /<span class="Package">([^<]*)<\/span>/ ) {
+ my $package = $1;
+ my $link = $package;
+ $link =~ s/::/-/g;
+ my $rm = $self->mode_param();
+ $rm = ref $rm ? 'rm' : $rm; # not really anything we can do if their mode_param returns a sub ref
+ $link = "?$rm=view_code&module=$package;view_code_no_popup=1";
+ $line =~ s/<span class="Package">[^<]*<\/span>/<a class="Package" href="$link">$package<\/a>/;
+ }
+ }
+ }
+ }
+ my $code = join('', @lines);
+
+ # if we are under CGI::Application::Plugin::DevPopup then let's create this as a report instead
+ if( $ENV{CAP_DEVPOPUP_EXEC} && !$query->param('view_code_no_popup') ) {
+ $self->devpopup->add_report(
+ title => 'View Code',
+ summary => "View code of $module",
+ report => "<style>$style_sec</style><pre>$code</pre>",
+ );
+ } else {
+ return qq(
+ <html>
+ <head>
+ <title>$module - View Source</title>
+ <style>$style_sec</style>
+ </head>
+ <body>
+ <pre>$code</pre>
+ </body>
+ </html>
+ );
+ }
+ } else {
+ return _error( ($file ? "File $file " : "Module $module ") . "does not exist!");
+ }
+}
+
+sub _view_pod {
+ my $self = shift;
+ my $query = $self->query;
+
+ # get the file to be viewed
+ my $module = _module_name($query->param('module') || ref($self));
+ # change into file name
+ my $file = _module_file_name($module);
+
+ # make sure the file exists
+ if( $file && -e $file ) {
+ require Pod::Xhtml;
+ my $pod_parser = new Pod::Xhtml(
+ StringMode => 1,
+ MakeIndex => 0,
+ FragmentOnly => 1,
+ TopLinks => 0,
+ MakeMeta => 0,
+ );
+ $pod_parser->parse_from_file($file);
+ my $pod = $pod_parser->asString;
+
+ # if we are under CGI::Application::Plugin::DevPopup then let's create this as a report instead
+ if( $ENV{CAP_DEVPOPUP_EXEC} && !$query->param('view_code_no_popup') ) {
+ $self->devpopup->add_report(
+ title => 'View POD',
+ summary => "View POD of $module",
+ report => "<pre>$pod</pre>",
+ );
+ } else {
+ return qq(
+ <html>
+ <head>
+ <title>$module - View POD</title>
+ </head>
+ <body>
+ <pre>$pod</pre>
+ </body>
+ </html>
+ );
+ }
+ } else {
+ return _error( ($file ? "File $file " : "Module $module ") . "does not exist!");
+ }
+}
+
+
+sub _module_name {
+ my $name = shift;
+ $name =~ s/-/::/g;
+ return $name;
+}
+
+sub _module_file_name {
+ my $module = shift;
+ # change into file name
+ $module =~ s/::/\//g;
+ $module .= '.pm';
+ return $INC{$module};
+}
+
+
+sub _error {
+ my $message = shift;
+ return qq(
+ <html>
+ <head>
+ <title>View Source Error!</title>
+ </head>
+ <body>
+ <h1 style="color: red">Error!</h1>
+ <strong>Sorry, but there was an error in your
+ request to view the source:
+ <blockquote><em>$message</em></blockquote>
+ </body>
+ </html>
+ );
+}
+
+1;
+
+__END__
+
+=head1 SECURITY
+
+This plugin is designed to be used for development only. Please do not use it in a
+production system as it will allow anyone to see the source code for any loaded module.
+Consider yourself warned.
+
+=head1 AUTHOR
+
+Michael Peters, C<< <mpeters at plusthree.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-cgi-application-plugin-viewsource at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CGI-Application-Plugin-ViewCode>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 ACKNOWLEDGEMENTS
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2005 Michael Peters, All Rights Reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/00-pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/00-pod.t?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/00-pod.t (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/00-pod.t Tue Jun 21 22:41:21 2011
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/01-pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/01-pod-coverage.t?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/01-pod-coverage.t (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/01-pod-coverage.t Tue Jun 21 22:41:21 2011
@@ -1,0 +1,4 @@
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok();
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/02-view_code.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/02-view_code.t?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/02-view_code.t (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/02-view_code.t Tue Jun 21 22:41:21 2011
@@ -1,0 +1,122 @@
+use Test::More;
+use CGI;
+use lib 't/lib';
+use MyBase::MyApp;
+use strict;
+
+plan(tests => 23);
+
+$ENV{'CGI_APP_RETURN_ONLY'} = 1;
+
+# 1..4
+# view_code
+{
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ unlike($output, qr/String \{ color:#000000/);
+ like($output, qr/<span class="String">/);
+ like($output, qr/<span class="LineNumber"><a name="1">1/);
+ like($output, qr/<span class="Comment_POD">/);
+}
+
+# 5..8
+# view_code highlight=0
+{
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ highlight => 0,
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/String \{ color:#000000/);
+ like($output, qr/<span class="String">/);
+ like($output, qr/<span class="LineNumber"><a name="1">1/);
+ like($output, qr/<span class="Comment_POD">/);
+}
+
+# 9..12
+# view_code hightlight=0, line_no=0
+{
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ highlight => 0,
+ line_no => 0,
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/String \{ color:#000000/);
+ like($output, qr/<span class="String">/);
+ unlike($output, qr/<span class="LineNumber"><a name="1">1/);
+ like($output, qr/<span class="Comment_POD">/);
+}
+
+# 13..16
+# view_code hightlight=0, line_no=0, pod=0
+{
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ highlight => 0,
+ line_no => 0,
+ pod => 0,
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/String \{ color:#000000/);
+ like($output, qr/<span class="String">/);
+ unlike($output, qr/<span class="LineNumber"><a name="1">1/);
+ unlike($output, qr/<span class="Comment_POD">/);
+}
+
+# 17..23
+# module and package links
+{
+ # using '::'
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ module => 'MyBase::MyApp',
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/<span class="Keyword">package<.+><a class="Package" href="[^"]+">MyBase::MyApp</);
+
+ # using '-'
+ $cgi = CGI->new({
+ rm => 'view_code',
+ module => 'MyBase-MyApp',
+ });
+ $app = MyBase::MyApp->new( QUERY => $cgi );
+ $output = $app->run();
+ like($output, qr/<span class="String">/);
+ like($output, qr/<span class="Keyword">package<.+><a class="Package" href="[^"]+">MyBase::MyApp</);
+
+ # following links
+ my ($link) = $output =~ /<a href="\?([^"]+)>MyBase</;
+ $cgi = CGI->new($link);
+ $output = $app->run(QUERY => $cgi);
+ like($output, qr/<span class="Keyword">package<.+><a class="Package" href="[^"]+">MyBase::MyApp</);
+
+
+ # follow links with a different mode_param()
+ $cgi = CGI->new({
+ mode => 'view_code',
+ module => 'MyBase-MyApp',
+ });
+ $app = MyBase::MyApp->new( QUERY => $cgi );
+ $app->mode_param('mode');
+ $output = $app->run();
+ like($output, qr/<span class="String">/);
+ like($output, qr/<span class="Keyword">package<.+><a class="Package" href="[^"]+">MyBase::MyApp</);
+
+ # following links
+ ($link) = $output =~ /<a href="\?([^"]+)>MyBase</;
+ $cgi = CGI->new($link);
+ $output = $app->run(QUERY => $cgi);
+ like($output, qr/<span class="Keyword">package<.+><a class="Package" href="[^"]+">MyBase::MyApp</);
+}
+
+
+
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/03-view_pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/03-view_pod.t?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/03-view_pod.t (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/03-view_pod.t Tue Jun 21 22:41:21 2011
@@ -1,0 +1,35 @@
+use Test::More;
+use Test::LongString;
+use CGI;
+use lib 't/lib';
+use MyBase::MyApp;
+use strict;
+
+plan(tests => 3);
+
+$ENV{'CGI_APP_RETURN_ONLY'} = 1;
+
+# 1..3
+# view_pod
+{
+ my $cgi = CGI->new({
+ rm => 'view_pod',
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ contains_string($output, q(<h1 id="NAME_MyBase_MyApp_Stuff">NAME MyBase::MyApp - Stuff</h1>));
+
+ $cgi = CGI->new({
+ rm => 'view_pod',
+ module => 'CGI::Application',
+ });
+ $app = MyBase::MyApp->new( QUERY => $cgi );
+ $output = $app->run();
+ contains_string($output, q(<h1 id="NAME">NAME</h1>));
+ like_string($output, qr/>CGI::Application\s-\s+Framework for building reusable web-applications</);
+}
+
+
+
+
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/04-errors.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/04-errors.t?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/04-errors.t (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/04-errors.t Tue Jun 21 22:41:21 2011
@@ -1,0 +1,44 @@
+use Test::More;
+use CGI;
+use lib 't/lib';
+use MyBase::MyApp;
+use strict;
+
+#plan(tests => 23);
+plan('no_plan');
+
+$ENV{'CGI_APP_RETURN_ONLY'} = 1;
+
+# 1..2
+# non existant module
+{
+ my $module = 'Some::NonExistant::Module';
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ module => $module,
+ });
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/View Source Error/i);
+ like($output, qr/Module \Q$module\E does not exist/i);
+}
+
+# 3..4
+# non existant file
+{
+ my $module = 'Some::NonExistant::Module';
+ my $file = 'Some/NonExistant/Module.pm';
+ my $cgi = CGI->new({
+ rm => 'view_code',
+ module => $module,
+ });
+ $INC{$file} = $file;
+ my $app = MyBase::MyApp->new( QUERY => $cgi );
+ my $output = $app->run();
+ like($output, qr/View Source Error/i);
+ like($output, qr/File \Q$file\E does not exist/i);
+}
+
+
+
+
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase.pm?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase.pm (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase.pm Tue Jun 21 22:41:21 2011
@@ -1,0 +1,8 @@
+package MyBase;
+use base 'CGI::Application';
+
+=head1 NAME MyBase
+
+=cut
+
+1;
Added: branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/MyApp.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/MyApp.pm?rev=76259&op=file
==============================================================================
--- branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/MyApp.pm (added)
+++ branches/upstream/libcgi-application-plugin-viewcode-perl/current/t/lib/MyBase/MyApp.pm Tue Jun 21 22:41:21 2011
@@ -1,0 +1,24 @@
+package MyBase::MyApp;
+use base 'MyBase';
+use strict;
+use CGI::Application::Plugin::ViewCode;
+
+=head1 NAME MyBase::MyApp - Stuff
+
+=cut
+
+sub setup {
+ my $self = shift;
+ $self->run_modes(
+ stuff => 'stuff',
+ );
+
+ $self->start_mode('stuff');
+}
+
+sub stuff {
+ my $self = shift;
+ return qq(Some Stuff);
+}
+
+1;
More information about the Pkg-perl-cvs-commits
mailing list