—package
Kwiki::PerlTidyModule;
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'
);
}
package
Kwiki::PerlTidyModule::Wafl;
use
Spoon::Formatter;
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
;
my
$result
;
eval
{
Perl::Tidy::perltidy(
source
=> \
$source
,
destination
=> \
$result
,
argv
=> [
qw( -q -html -pre -npro )
],
);
};
$@ ?
$source
:
$result
;
}
package
Kwiki::PerlTidyModule;
__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 */