use Kwiki::Plugin -Base;
use Kwiki::Installer -Base;
our $VERSION = '0.11';
const class_id => 'perl_tidy_module';
const css_file => 'perl_tidy_module.css';
sub register {
my $registry = shift;
$registry->add(prerequisite => 'cache');
$registry->add(wafl => perl_tidy_module => 'Kwiki::PerlTidyModule::Wafl');
}
sub to_html {
my $thing = $self->arguments;
my $file_name = $thing =~ /^[a-z0-9_]+$/
? $self->file_from_class_id($thing)
: $thing =~ /^[\w\:]+$/
? $self->file_from_module($thing)
: '';
return $self->wafl_error
unless $file_name;
return join '',
qq{<table class="perl_tidy_module"><tr><td><pre>\n},
$self->tidy($file_name),
qq{</pre></td></tr></table>\n};
}
sub file_from_class_id {
my $class_id = shift;
my $object = eval {$self->hub->load_class($class_id)}
or return;
$self->file_from_module(ref($object));
}
sub file_from_module {
my $module = shift;
eval "use $module; 1"
or return;
$module =~ s/::/\//g;
$module .= '.pm';
return $INC{$module};
}
sub tidy {
my $file_name = shift;
my $source = io($file_name)->slurp;
return $self->escape_html($source)
unless $file_name =~ /\.(pl|pm|cgi|t|dd)$/;
my $html = $self->hub->load_class('cache')->process(
sub { $self->cache_this($source) }, 'perl_tidy_module', $source
);
$html =~ s/^<pre>\s*(.*)\s*<\/pre>\s*\z/$1/s;
return $html;
}
sub cache_this {
my $source = shift;
require Perl::Tidy;
my $result;
eval {
Perl::Tidy::perltidy(
source => \$source,
destination => \$result,
argv => [qw( -q -html -pre -npro )],
);
};
$@ ? $source : $result;
}
__DATA__
=head1 NAME
Kwiki::PerlTidyModule - Kwiki Perl Tidy Module Plugin
=head1 SYNOPSIS
=head1 DESCRIPTION
=head1 AUTHOR
Brian Ingerson <INGY@cpan.org>
=head1 COPYRIGHT
Copyright (c) 2004. Brian Ingerson. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
__css/perl_tidy_module.css__
table.perl_tidy_module {
border-collapse: collapse;
margin: .5em;
}
table.perl_tidy_module td {
border: 1px;
border-style: solid;
padding: .5em;
}
.pd { color: #404080;} /* pod-text */
.c { color: #404080;} /* comment */
.cm { color: #800097;} /* comma */
.co { color: #800097;} /* colon */
.h { color: #804848;} /* here-doc-target */
.hh { color: #800000;} /* here-doc-text */
.q { color: #800000;} /* quote */
.v { color: #800000;} /* v-string */
.i { color: #008080;} /* identifier */
.k { color: #0000FF;} /* keyword */
.n { color: #E02020;} /* numeric */
.m { color: #C00080;} /* subroutine */
.j { color: #C00080;} /* label */
.w { color: #C00080;} /* bareword */
.p { color: #800080;} /* paren */
.s { color: #800080;} /* structure */
.sc { color: #800080;} /* semicolon */
.pu { color: #C44800;} /* punctuation */