baz.
foo '''bar''' baz.
}}}
--- expected
foo <bar> baz.
foo bar baz.
- foo <bar> bar.
- foo bar baz.
- foo <bar> bar.
- foo bar baz.
foo <bar> baz.
foo '''bar''' baz.
### citation link
--- input
>> Someone's original text
>> Someone's original text
>> Someone's original text
> Someone else's reply text
> Someone else's reply text
My reply text
>> Someone's original text
My reply text
--- expected
Someone's original text
Someone's original text
Someone's original text
Someone else's reply text
Someone else's reply text
My reply text
Someone's original text
My reply text
libtext-trac-perl-0.15/t/pod.t 0000644 0001750 0001750 00000000214 10761015565 015160 0 ustar nacho nacho #!perl -T
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();
libtext-trac-perl-0.15/t/07-custom_url.t 0000644 0001750 0001750 00000003412 10761015565 017021 0 ustar nacho nacho #!perl -T
use strict;
use Test::Base;
use Text::Trac;
delimiters('###');
plan tests => 1 * blocks;
my $p = Text::Trac->new(
trac_attachment_url => 'http://mizzy.org/attachment',
trac_changeset_url => 'http://mizzy.org/changeset',
trac_log_url => 'http://mizzy.org/log',
trac_milestone_url => 'http://mizzy.org/milestone',
trac_report_url => 'http://mizzy.org/report',
trac_source_url => 'http://mizzy.org/source',
trac_ticket_url => 'http://mizzy.org/ticket',
trac_wiki_url => 'http://mizzy.org/wiki',
);
sub parse {
local $_ = shift;
$p->parse($_);
$p->html;
}
filters { input => 'parse', expected => 'chomp' };
run_is 'input' => 'expected';
__DATA__
### attachment
--- input
attachment:ticket:33:DSCF0001.jpg
--- expected
attachment:ticket:33:DSCF0001.jpg
### changeset
--- input
[1]
--- expected
[1]
### revision log
--- input
r1:3
--- expected
r1:3
### milestone
--- input
milestone:1.0
--- expected
milestone:1.0
### report
--- input
{1}
--- expected
{1}
### source
--- input
source:trunk/COPYING
--- expected
source:trunk/COPYING
### ticket
--- input
#1
--- expected
#1
### wiki
--- input
TracLinks
--- expected
TracLinks
libtext-trac-perl-0.15/t/03-trac-links.t 0000755 0001750 0001750 00000017344 11001131347 016665 0 ustar nacho nacho use strict;
use t::TestTextTrac;
run_tests;
__DATA__
### ticket link test 1
--- input
#1
--- expected
#1
### ticket link test 2
--- input
ticket:1
--- expected
ticket:1
### ticket link test 3
--- input
!#1
--- expected
#1
### ticket link test 4
--- input
!ticket:1
--- expected
ticket:1
### ticket link test 5
--- input
[ticket:1]
--- expected
1
### ticket link test 6
--- input
[ticket:1 ticket 1]
--- expected
ticket 1
### ticket link test 7
--- input
![ticket:1]
--- expected
[ticket:1]
### report link test 1
--- input
{1}
--- expected
{1}
### report link test 2
--- input
report:1
--- expected
report:1
### report link test 3
--- input
!{1}
--- expected
{1}
### report link test 4
--- input
!report:1
--- expected
report:1
### report link test 5
--- input
[report:1]
--- expected
1
### report link test 6
--- input
[report:1 report 1]
--- expected
report 1
### report link test 7
--- input
![report:1]
--- expected
[report:1]
### changeset link test 1
--- input
[1]
--- expected
[1]
### changeset link test 2
--- input
changeset:1
--- expected
changeset:1
### changeset link test 3
--- input
r1
--- expected
r1
### changeset link test 4
--- input
[changeset:1]
--- expected
1
### changeset link test 5
--- input
[changeset:1 changeset 1]
--- expected
changeset 1
### changeset link test 6
--- input
![1]
--- expected
[1]
### changeset link test 7
--- input
!changeset:1
--- expected
changeset:1
### changeset link test 8
--- input
!r1
--- expected
r1
### changeset link test 9
--- input
![changeset:1]
--- expected
[changeset:1]
### revision log link test 1
--- input
r1:3
--- expected
r1:3
### revision log link test 2
--- input
[1:3]
--- expected
[1:3]
### revision log link test 3
--- input
log:#1:3
--- expected
log:#1:3
### revision log link test 4
--- input
[log:#1:3]
--- expected
#1:3
### revision log link test 5
--- input
[log:#1:3 log 1 - 3]
--- expected
log 1 - 3
### wiki link test 1
--- input
TracLinks
--- expected
TracLinks
### wiki link test 2
--- input
wiki:trac_links
--- expected
wiki:trac_links
### wiki link test 3
--- input
!TracLinks
--- expected
TracLinks
### wiki link test 4
--- input
!wiki:TracLinks
--- expected
wiki:TracLinks
### wiki link test 5
--- input
[wiki:TracLinks Trac Links]
--- expected
Trac Links
### milestone link test 1
--- input
milestone:1.0
--- expected
milestone:1.0
### milestone link test 2
--- input
[milestone:1.0]
--- expected
1.0
### milestone link test 3
--- input
[milestone:1.0 milestone 1.0]
--- expected
milestone 1.0
### milestone link test 4
--- input
!milestone:1.0
--- expected
milestone:1.0
### milestone link test 5
--- input
![milestone:1.0]
--- expected
[milestone:1.0]
### attahcment link test 1
--- input
attachment:ticket:33:DSCF0001.jpg
--- expected
attachment:ticket:33:DSCF0001.jpg
### attahcment link test 2
--- input
attachment:wiki:TracLinks:DSCF0001.jpg
--- expected
attachment:wiki:TracLinks:DSCF0001.jpg
### attahcment link test 3
--- input
[attachment:ticket:33:DSCF0001.jpg]
--- expected
ticket:33:DSCF0001.jpg
### attahcment link test 4
--- input
[attachment:ticket:33:DSCF0001.jpg file]
--- expected
file
### attahcment link test 5
--- input
!attachment:ticket:33:DSCF0001.jpg
--- expected
attachment:ticket:33:DSCF0001.jpg
### attahcment link test 6
--- input
!attachment:wiki:TracLinks:DSCF0001.jpg
--- expected
attachment:wiki:TracLinks:DSCF0001.jpg
### attahcment link test 7
--- input
![attachment:wiki:TracLinks:DSCF0001.jpg]
--- expected
[attachment:wiki:TracLinks:DSCF0001.jpg]
### source link test 1
--- input
source:trunk/COPYING
--- expected
source:trunk/COPYING
### source link test 2
--- input
source:trunk/COPYING#200
--- expected
source:trunk/COPYING#200
### source link test 3
--- input
[source:trunk/COPYING]
--- expected
trunk/COPYING
### source link test 4
--- input
[source:trunk/COPYING COPYING]
--- expected
COPYING
### source link test 5
--- input
[source:trunk/COPYING#200]
--- expected
trunk/COPYING#200
### source link test 6
--- input
[source:trunk/COPYING#200 COPYING]
--- expected
COPYING
### source link test 7
--- input
!source:trunk/COPYING
--- expected
source:trunk/COPYING
### source link test 8
--- input
!source:trunk/COPYING#200
--- expected
source:trunk/COPYING#200
### source link test 9
--- input
![source:trunk/COPYING]
--- expected
[source:trunk/COPYING]
### escaping links and wiki page names
--- input
== EscapingLinksand!WikiPageNames ==
--- expected
### comment link test 1
--- input
comment:ticket:1:8
--- expected
comment:ticket:1:8
libtext-trac-perl-0.15/t/08-regression.t 0000644 0001750 0001750 00000000517 10761015565 017011 0 ustar nacho nacho use strict;
use t::TestTextTrac;
run_tests;
__DATA__
### regression test 1
--- input
[http://shibuya.pm.org/blosxom/techtalks/200610.html Shibuya.pm テクニカルトーク #7]
--- expected
Shibuya.pm テクニカルトーク #7
libtext-trac-perl-0.15/t/boilerplate.t 0000644 0001750 0001750 00000002320 10761015565 016700 0 ustar nacho nacho #!perl -T
use strict;
use warnings;
use Test::More tests => 3;
sub not_in_file_ok {
my ($filename, %regex) = @_;
open my $fh, "<", $filename
or die "couldn't open $filename for reading: $!";
my %violated;
while (my $line = <$fh>) {
while (my ($desc, $regex) = each %regex) {
if ($line =~ $regex) {
push @{$violated{$desc}||=[]}, $.;
}
}
}
if (%violated) {
fail("$filename contains boilerplate text");
diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
} else {
pass("$filename contains no boilerplate text");
}
}
not_in_file_ok(README =>
"The README is used..." => qr/The README is used/,
"'version information here'" => qr/to provide version information/,
);
not_in_file_ok(Changes =>
"placeholder date/time" => qr(Date/time)
);
sub module_boilerplate_ok {
my ($module) = @_;
not_in_file_ok($module =>
'the great new $MODULENAME' => qr/ - The great new /,
'boilerplate description' => qr/Quick summary of what the module/,
'stub function definition' => qr/function[12]/,
);
}
module_boilerplate_ok('lib/Text/Trac.pm');
libtext-trac-perl-0.15/t/TestTextTrac.pm 0000755 0001750 0001750 00000000647 10761015565 017162 0 ustar nacho nacho package t::TestTextTrac;
use Test::Base -Base;
use Text::Trac;
our @EXPORT = qw( run_tests );
sub run_tests {
delimiters('###');
filters { input => 'parse', expected => 'chomp' };
run_is 'input' => 'expected';
}
package t::TestTextTrac::Filter;
use Test::Base::Filter -Base;
my $p = Text::Trac->new( trac_url => 'http://trac.mizzy.org/public/' );
sub parse {
$p->parse(@_);
return $p->html;
}
1;
libtext-trac-perl-0.15/t/00-load.t 0000644 0001750 0001750 00000000214 10761015565 015532 0 ustar nacho nacho #!perl -T
use Test::More tests => 1;
BEGIN {
use_ok( 'Text::Trac' );
}
diag( "Testing Text::Trac $Text::Trac::VERSION, Perl $], $^X" );
libtext-trac-perl-0.15/t/06-enable_links.t 0000644 0001750 0001750 00000001160 10761015565 017250 0 ustar nacho nacho #!perl -T
use strict;
use Test::Base;
use Text::Trac;
delimiters('###');
plan tests => 1 * blocks;
my $p = Text::Trac->new( enable_links => [ qw( log milestone ) ] );
sub parse {
local $_ = shift;
$p->parse($_);
$p->html;
}
filters { input => 'parse', expected => 'chomp' };
run_is 'input' => 'expected';
__DATA__
### log
--- input
r1:3
--- expected
r1:3
### milestone
--- input
milestone:1.0
--- expected
milestone:1.0
### ticket
--- input
ticket:1
--- expected
ticket:1
libtext-trac-perl-0.15/t/02-macros.t 0000755 0001750 0001750 00000001250 10761015565 016105 0 ustar nacho nacho use strict;
use t::TestTextTrac;
run_tests;
__DATA__
### macro with no arguments
--- input
[[HelloWorld]]
--- expected
Hello World, args =
### macro with quoted arguments
--- input
[[HelloWorld( "one, one", "two, two", 'three, three' )]]
--- expected
Hello World, args = one, one, two, two, three, three
### macro with embedded terminators
--- input
[[HelloWorld( func(arg), ]] )]]
--- expected
Hello World, args = func(arg), ]]
### macros with extra ws aren't valid
--- input
[[ HelloWorld(foo) ]]
--- expected
[[ HelloWorld(foo) ]]
### unknown macro doesn't die
--- input
[[TheUnknownMacro]]
--- expected
[[TheUnknownMacro]]
libtext-trac-perl-0.15/t/pod-coverage.t 0000644 0001750 0001750 00000000330 10761015565 016750 0 ustar nacho nacho #!perl -T
use Test::More;
eval "use Test::Pod::Coverage 1.04 tests=>1";
plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
pod_coverage_ok( "Text::Trac", "Text::Trac is covered" );
libtext-trac-perl-0.15/inc/ 0000755 0001750 0001750 00000000000 11154653351 014520 5 ustar nacho nacho libtext-trac-perl-0.15/inc/Module/ 0000755 0001750 0001750 00000000000 11154653351 015745 5 ustar nacho nacho libtext-trac-perl-0.15/inc/Module/Install/ 0000755 0001750 0001750 00000000000 11154653351 017353 5 ustar nacho nacho libtext-trac-perl-0.15/inc/Module/Install/Can.pm 0000644 0001750 0001750 00000003422 11154653260 020412 0 ustar nacho nacho #line 1
package Module::Install::Can;
use strict;
use Module::Install::Base;
use Config ();
### This adds a 5.005 Perl version dependency.
### This is a bug and will be fixed.
use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
# check if we can load some module
### Upgrade this to not have to load the module if possible
sub can_use {
my ($self, $mod, $ver) = @_;
$mod =~ s{::|\\}{/}g;
$mod .= '.pm' unless $mod =~ /\.pm$/i;
my $pkg = $mod;
$pkg =~ s{/}{::}g;
$pkg =~ s{\.pm$}{}i;
local $@;
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
# check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
my $_cmd = $cmd;
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
my $abs = File::Spec->catfile($dir, $_[1]);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
# can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
# $Config{cc} may contain args; try to find out the program part
while (@chunks) {
return $self->can_run("@chunks") || (pop(@chunks), next);
}
return;
}
# Fix Cygwin bug on maybe_command();
if ( $^O eq 'cygwin' ) {
require ExtUtils::MM_Cygwin;
require ExtUtils::MM_Win32;
if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
*ExtUtils::MM_Cygwin::maybe_command = sub {
my ($self, $file) = @_;
if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
ExtUtils::MM_Win32->maybe_command($file);
} else {
ExtUtils::MM_Unix->maybe_command($file);
}
}
}
}
1;
__END__
#line 158
libtext-trac-perl-0.15/inc/Module/Install/Base.pm 0000644 0001750 0001750 00000002050 11154653260 020557 0 ustar nacho nacho #line 1
package Module::Install::Base;
$VERSION = '0.79';
# Suspend handler for "redefined" warnings
BEGIN {
my $w = $SIG{__WARN__};
$SIG{__WARN__} = sub { $w };
}
### This is the ONLY module that shouldn't have strict on
# use strict;
#line 41
sub new {
my ($class, %args) = @_;
foreach my $method ( qw(call load) ) {
*{"$class\::$method"} = sub {
shift()->_top->$method(@_);
} unless defined &{"$class\::$method"};
}
bless( \%args, $class );
}
#line 61
sub AUTOLOAD {
my $self = shift;
local $@;
my $autoload = eval { $self->_top->autoload } or return;
goto &$autoload;
}
#line 76
sub _top { $_[0]->{_top} }
#line 89
sub admin {
$_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
}
#line 101
sub is_admin {
$_[0]->admin->VERSION;
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
my $Fake;
sub new { $Fake ||= bless(\@_, $_[0]) }
sub AUTOLOAD {}
sub DESTROY {}
# Restore warning handler
BEGIN {
$SIG{__WARN__} = $SIG{__WARN__}->();
}
1;
#line 146
libtext-trac-perl-0.15/inc/Module/Install/Win32.pm 0000644 0001750 0001750 00000003402 11154653260 020611 0 ustar nacho nacho #line 1
package Module::Install::Win32;
use strict;
use Module::Install::Base;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '0.79';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
# determine if the user needs nmake, and download it if needed
sub check_nmake {
my $self = shift;
$self->load('can_run');
$self->load('get_file');
require Config;
return unless (
$^O eq 'MSWin32' and
$Config::Config{make} and
$Config::Config{make} =~ /^nmake\b/i and
! $self->can_run('nmake')
);
print "The required 'nmake' executable not found, fetching it...\n";
require File::Basename;
my $rv = $self->get_file(
url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
local_dir => File::Basename::dirname($^X),
size => 51928,
run => 'Nmake15.exe /o > nul',
check_for => 'Nmake.exe',
remove => 1,
);
die <<'END_MESSAGE' unless $rv;
-------------------------------------------------------------------------------
Since you are using Microsoft Windows, you will need the 'nmake' utility
before installation. It's available at:
http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
or
ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
Please download the file manually, save it to a directory in %PATH% (e.g.
C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
that directory, and run "Nmake15.exe" from there; that will create the
'nmake.exe' file needed by this module.
You may then resume the installation process described in README.
-------------------------------------------------------------------------------
END_MESSAGE
}
1;
libtext-trac-perl-0.15/inc/Module/Install/WriteAll.pm 0000644 0001750 0001750 00000001321 11154653260 021430 0 ustar nacho nacho #line 1
package Module::Install::WriteAll;
use strict;
use Module::Install::Base;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
$VERSION = '0.79';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
sub WriteAll {
my $self = shift;
my %args = (
meta => 1,
sign => 0,
inline => 0,
check_nmake => 1,
@_,
);
$self->sign(1) if $args{sign};
$self->Meta->write if $args{meta};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
$self->makemaker_args( PL_FILES => {} );
}
if ( $args{inline} ) {
$self->Inline->write;
} else {
$self->Makefile->write;
}
}
1;
libtext-trac-perl-0.15/inc/Module/Install/AutoInstall.pm 0000644 0001750 0001750 00000002272 11154653260 022152 0 ustar nacho nacho #line 1
package Module::Install::AutoInstall;
use strict;
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub AutoInstall { $_[0] }
sub run {
my $self = shift;
$self->auto_install_now(@_);
}
sub write {
my $self = shift;
$self->auto_install(@_);
}
sub auto_install {
my $self = shift;
return if $self->{done}++;
# Flatten array of arrays into a single array
my @core = map @$_, map @$_, grep ref,
$self->build_requires, $self->requires;
my @config = @_;
# We'll need Module::AutoInstall
$self->include('Module::AutoInstall');
require Module::AutoInstall;
Module::AutoInstall->import(
(@config ? (-config => \@config) : ()),
(@core ? (-core => \@core) : ()),
$self->features,
);
$self->makemaker_args( Module::AutoInstall::_make_args() );
my $class = ref($self);
$self->postamble(
"# --- $class section:\n" .
Module::AutoInstall::postamble()
);
}
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
Module::AutoInstall::do_install();
}
1;
libtext-trac-perl-0.15/inc/Module/Install/Makefile.pm 0000644 0001750 0001750 00000014542 11154653260 021433 0 ustar nacho nacho #line 1
package Module::Install::Makefile;
use strict 'vars';
use Module::Install::Base;
use ExtUtils::MakeMaker ();
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
my %seen = ();
sub prompt {
shift;
# Infinite loop protection
my @c = caller();
if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
# In automated testing, always use defaults
if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
goto &ExtUtils::MakeMaker::prompt;
}
}
sub makemaker_args {
my $self = shift;
my $args = ( $self->{makemaker_args} ||= {} );
%$args = ( %$args, @_ );
return $args;
}
# For mm args that take multiple space-seperated args,
# append an argument to the current list.
sub makemaker_append {
my $self = sShift;
my $name = shift;
my $args = $self->makemaker_args;
$args->{name} = defined $args->{$name}
? join( ' ', $args->{name}, @_ )
: join( ' ', @_ );
}
sub build_subdirs {
my $self = shift;
my $subdirs = $self->makemaker_args->{DIR} ||= [];
for my $subdir (@_) {
push @$subdirs, $subdir;
}
}
sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
%$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
%$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
sub libs {
my $self = shift;
my $libs = ref $_[0] ? shift : [ shift ];
$self->makemaker_args( LIBS => $libs );
}
sub inc {
my $self = shift;
$self->makemaker_args( INC => shift );
}
my %test_dir = ();
sub _wanted_t {
/\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
if ( $self->tests ) {
die "tests_recursive will not work if tests are already defined";
}
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
%test_dir = ();
require File::Find;
File::Find::find( \&_wanted_t, $dir );
$self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
# Make sure we have a new enough
require ExtUtils::MakeMaker;
# MakeMaker can complain about module versions that include
# an underscore, even though its own version may contain one!
# Hence the funny regexp to get rid of it. See RT #35800
# for details.
$self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
# Generate the
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
$args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
if ( $self->tests ) {
$args->{test} = { TESTS => $self->tests };
}
if ($] >= 5.005) {
$args->{ABSTRACT} = $self->abstract;
$args->{AUTHOR} = $self->author;
}
if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
$args->{NO_META} = 1;
}
if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
# merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
map { @$_ }
map { @$_ }
grep $_,
($self->configure_requires, $self->build_requires, $self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
# merge both kinds of requires into prereq_pm
my $subdirs = ($args->{DIR} ||= []);
if ($self->bundles) {
foreach my $bundle (@{ $self->bundles }) {
my ($file, $dir) = @$bundle;
push @$subdirs, $dir if -d $dir;
delete $prereq->{$file};
}
}
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
}
$args->{INSTALLDIRS} = $self->installdirs;
my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
if (my $preop = $self->admin->preop($user_preop)) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
}
my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
$self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
}
sub fix_up_makefile {
my $self = shift;
my $makefile_name = shift;
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
my $postamble = "# Postamble by $top_class $top_version\n"
. ($self->postamble || '');
local *MAKEFILE;
open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
my $makefile = do { local $/; };
close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
$makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
$makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
$makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
# Module::Install will never be used to build the Core Perl
# Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
# PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
$makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
#$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
# Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
$makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
1;
}
sub preamble {
my ($self, $text) = @_;
$self->{preamble} = $text . $self->{preamble} if defined $text;
$self->{preamble};
}
sub postamble {
my ($self, $text) = @_;
$self->{postamble} ||= $self->admin->postamble;
$self->{postamble} .= $text if defined $text;
$self->{postamble}
}
1;
__END__
#line 379
libtext-trac-perl-0.15/inc/Module/Install/Fetch.pm 0000644 0001750 0001750 00000004626 11154653260 020751 0 ustar nacho nacho #line 1
package Module::Install::Fetch;
use strict;
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub get_file {
my ($self, %args) = @_;
my ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
$args{url} = $args{ftp_url}
or (warn("LWP support unavailable!\n"), return);
($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
$|++;
print "Fetching '$file' from $host... ";
unless (eval { require Socket; Socket::inet_aton($host) }) {
warn "'$host' resolve failed!\n";
return;
}
return unless $scheme eq 'ftp' or $scheme eq 'http';
require Cwd;
my $dir = Cwd::getcwd();
chdir $args{local_dir} or return if exists $args{local_dir};
if (eval { require LWP::Simple; 1 }) {
LWP::Simple::mirror($args{url}, $file);
}
elsif (eval { require Net::FTP; 1 }) { eval {
# use Net::FTP to get past firewall
my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
$ftp->login("anonymous", 'anonymous@example.com');
$ftp->cwd($path);
$ftp->binary;
$ftp->get($file) or (warn("$!\n"), return);
$ftp->quit;
} }
elsif (my $ftp = $self->can_run('ftp')) { eval {
# no Net::FTP, fallback to ftp.exe
require FileHandle;
my $fh = FileHandle->new;
local $SIG{CHLD} = 'IGNORE';
unless ($fh->open("|$ftp -n")) {
warn "Couldn't open ftp: $!\n";
chdir $dir; return;
}
my @dialog = split(/\n/, <<"END_FTP");
open $host
user anonymous anonymous\@example.com
cd $path
binary
get $file $file
quit
END_FTP
foreach (@dialog) { $fh->print("$_\n") }
$fh->close;
} }
else {
warn "No working 'ftp' program available!\n";
chdir $dir; return;
}
unless (-f $file) {
warn "Fetching failed: $@\n";
chdir $dir; return;
}
return if exists $args{size} and -s $file != $args{size};
system($args{run}) if exists $args{run};
unlink($file) if $args{remove};
print(((!exists $args{check_for} or -e $args{check_for})
? "done!" : "failed! ($!)"), "\n");
chdir $dir; return !$?;
}
1;
libtext-trac-perl-0.15/inc/Module/Install/Include.pm 0000644 0001750 0001750 00000001014 11154653260 021267 0 ustar nacho nacho #line 1
package Module::Install::Include;
use strict;
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
sub include {
shift()->admin->include(@_);
}
sub include_deps {
shift()->admin->include_deps(@_);
}
sub auto_include {
shift()->admin->auto_include(@_);
}
sub auto_include_deps {
shift()->admin->auto_include_deps(@_);
}
sub auto_include_dependent_dists {
shift()->admin->auto_include_dependent_dists(@_);
}
1;
libtext-trac-perl-0.15/inc/Module/Install/Metadata.pm 0000644 0001750 0001750 00000031065 11154653260 021435 0 ustar nacho nacho #line 1
package Module::Install::Metadata;
use strict 'vars';
use Module::Install::Base;
use vars qw{$VERSION $ISCORE @ISA};
BEGIN {
$VERSION = '0.79';
$ISCORE = 1;
@ISA = qw{Module::Install::Base};
}
my @scalar_keys = qw{
name
module_name
abstract
author
version
distribution_type
tests
installdirs
};
my @tuple_keys = qw{
configure_requires
build_requires
requires
recommends
bundles
resources
};
my @resource_keys = qw{
homepage
bugtracker
repository
};
sub Meta { shift }
sub Meta_ScalarKeys { @scalar_keys }
sub Meta_TupleKeys { @tuple_keys }
sub Meta_ResourceKeys { @resource_keys }
foreach my $key ( @scalar_keys ) {
*$key = sub {
my $self = shift;
return $self->{values}{$key} if defined wantarray and !@_;
$self->{values}{$key} = shift;
return $self;
};
}
foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
return () unless $self->{values}{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
@{ $self->{values}{resources} };
}
return $self->{values}{resources}{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
$self->resources( $key => $uri );
return 1;
};
}
sub requires {
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{requires} }, [ $module, $version ];
}
$self->{values}{requires};
}
sub build_requires {
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{build_requires} }, [ $module, $version ];
}
$self->{values}{build_requires};
}
sub configure_requires {
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{configure_requires} }, [ $module, $version ];
}
$self->{values}{configure_requires};
}
sub recommends {
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{recommends} }, [ $module, $version ];
}
$self->{values}{recommends};
}
sub bundles {
my $self = shift;
while ( @_ ) {
my $module = shift or last;
my $version = shift || 0;
push @{ $self->{values}{bundles} }, [ $module, $version ];
}
$self->{values}{bundles};
}
# Resource handling
my %lc_resource = map { $_ => 1 } qw{
homepage
license
bugtracker
repository
};
sub resources {
my $self = shift;
while ( @_ ) {
my $name = shift or last;
my $value = shift or next;
if ( $name eq lc $name and ! $lc_resource{$name} ) {
die("Unsupported reserved lowercase resource '$name'");
}
$self->{values}{resources} ||= [];
push @{ $self->{values}{resources} }, [ $name, $value ];
}
$self->{values}{resources};
}
# Aliases for build_requires that will have alternative
# meanings in some future version of META.yml.
sub test_requires { shift->build_requires(@_) }
sub install_requires { shift->build_requires(@_) }
# Aliases for installdirs options
sub install_as_core { $_[0]->installdirs('perl') }
sub install_as_cpan { $_[0]->installdirs('site') }
sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub sign {
my $self = shift;
return $self->{values}{sign} if defined wantarray and ! @_;
$self->{values}{sign} = ( @_ ? $_[0] : 1 );
return $self;
}
sub dynamic_config {
my $self = shift;
unless ( @_ ) {
warn "You MUST provide an explicit true/false value to dynamic_config\n";
return $self;
}
$self->{values}{dynamic_config} = $_[0] ? 1 : 0;
return 1;
}
sub perl_version {
my $self = shift;
return $self->{values}{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
# Normalize the version
$version = $self->_perl_version($version);
# We don't support the reall old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
$self->{values}{perl_version} = $version;
}
sub license {
my $self = shift;
return $self->{values}{license} unless @_;
my $license = shift or die(
'Did not provide a value to license()'
);
$self->{values}{license} = $license;
# Automatically fill in license URLs
if ( $license eq 'perl' ) {
$self->resources( license => 'http://dev.perl.org/licenses/' );
}
return 1;
}
sub all_from {
my ( $self, $file ) = @_;
unless ( defined($file) ) {
my $name = $self->name or die(
"all_from called with no args without setting name() first"
);
$file = join('/', 'lib', split(/-/, $name)) . '.pm';
$file =~ s{.*/}{} unless -e $file;
unless ( -e $file ) {
die("all_from cannot find $file from $name");
}
}
unless ( -f $file ) {
die("The path '$file' does not exist, or is not a file");
}
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
my $pod = $file;
$pod =~ s/\.pm$/.pod/i;
$pod = $file unless -e $pod;
# Pull the different values
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
$self->author_from($pod) unless $self->author;
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
return 1;
}
sub provides {
my $self = shift;
my $provides = ( $self->{values}{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
sub auto_provides {
my $self = shift;
return $self unless $self->is_admin;
unless (-e 'MANIFEST') {
warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
return $self;
}
# Avoid spurious warnings as we are not checking manifest here.
local $SIG{__WARN__} = sub {1};
require ExtUtils::Manifest;
local *ExtUtils::Manifest::manicheck = sub { return };
require Module::Build;
my $build = Module::Build->new(
dist_name => $self->name,
dist_version => $self->version,
license => $self->license,
);
$self->provides( %{ $build->find_dist_packages || {} } );
}
sub feature {
my $self = shift;
my $name = shift;
my $features = ( $self->{values}{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
# The user used ->feature like ->features by passing in the second
# argument as a reference. Accomodate for that.
$mods = $_[0];
} else {
$mods = \@_;
}
my $count = 0;
push @$features, (
$name => [
map {
ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
} @$mods
]
);
return @$features;
}
sub features {
my $self = shift;
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
return $self->{values}{features}
? @{ $self->{values}{features} }
: ();
}
sub no_index {
my $self = shift;
my $type = shift;
push @{ $self->{values}{no_index}{$type} }, @_ if $type;
return $self->{values}{no_index};
}
sub read {
my $self = shift;
$self->include_deps( 'YAML::Tiny', 0 );
require YAML::Tiny;
my $data = YAML::Tiny::LoadFile('META.yml');
# Call methods explicitly in case user has already set some values.
while ( my ( $key, $value ) = each %$data ) {
next unless $self->can($key);
if ( ref $value eq 'HASH' ) {
while ( my ( $module, $version ) = each %$value ) {
$self->can($key)->($self, $module => $version );
}
} else {
$self->can($key)->($self, $value);
}
}
return $self;
}
sub write {
my $self = shift;
return $self unless $self->is_admin;
$self->admin->write_meta;
return $self;
}
sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
}
sub abstract_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->abstract(
bless(
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
);
}
# Add both distribution and module name
sub name_from {
my ($self, $file) = @_;
if (
Module::Install::_read($file) =~ m/
^ \s*
package \s*
([\w:]+)
\s* ;
/ixms
) {
my ($name, $module_name) = ($1, $1);
$name =~ s{::}{-}g;
$self->name($name);
unless ( $self->module_name ) {
$self->module_name($module_name);
}
} else {
die("Cannot determine name from $file\n");
}
}
sub perl_version_from {
my $self = shift;
if (
Module::Install::_read($_[0]) =~ m/
^
(?:use|require) \s*
v?
([\d_\.]+)
\s* ;
/ixms
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
return;
}
}
sub author_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
if ($content =~ m/
=head \d \s+ (?:authors?)\b \s*
([^\n]*)
|
=head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
.*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
([^\n]*)
/ixms) {
my $author = $1 || $2;
$author =~ s{E}{<}g;
$author =~ s{E}{>}g;
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
sub license_from {
my $self = shift;
if (
Module::Install::_read($_[0]) =~ m/
(
=head \d \s+
(?:licen[cs]e|licensing|copyright|legal)\b
.*?
)
(=head\\d.*|=cut.*|)
\z
/ixms ) {
my $license_text = $1;
my @phrases = (
'under the same (?:terms|license) as perl itself' => 'perl', 1,
'GNU general public license' => 'gpl', 1,
'GNU public license' => 'gpl', 1,
'GNU lesser general public license' => 'lgpl', 1,
'GNU lesser public license' => 'lgpl', 1,
'GNU library general public license' => 'lgpl', 1,
'GNU library public license' => 'lgpl', 1,
'BSD license' => 'bsd', 1,
'Artistic license' => 'artistic', 1,
'GPL' => 'gpl', 1,
'LGPL' => 'lgpl', 1,
'BSD' => 'bsd', 1,
'Artistic' => 'artistic', 1,
'MIT' => 'mit', 1,
'proprietary' => 'proprietary', 0,
);
while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
$pattern =~ s{\s+}{\\s+}g;
if ( $license_text =~ /\b$pattern\b/i ) {
$self->license($license);
return 1;
}
}
}
warn "Cannot determine license info from $_[0]\n";
return 'unknown';
}
sub bugtracker_from {
my $self = shift;
my $content = Module::Install::_read($_[0]);
my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g;
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
warn "Found more than on rt.cpan.org link in $_[0]\n";
return 0;
}
# Set the bugtracker
bugtracker( $links[0] );
return 1;
}
# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
# numbers (eg, 5.006001 or 5.008009).
# Also, convert double-part versions (eg, 5.8)
sub _perl_version {
my $v = $_[-1];
$v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
$v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
$v =~ s/(\.\d\d\d)000$/$1/;
$v =~ s/_.+$//;
if ( ref($v) ) {
$v = $v + 0; # Numify
}
return $v;
}
######################################################################
# MYMETA.yml Support
sub WriteMyMeta {
$_[0]->write_mymeta;
}
sub write_mymeta {
my $self = shift;
# If there's no existing META.yml there is nothing we can do
return unless -f 'META.yml';
# Merge the perl version into the dependencies
my $val = $self->Meta->{values};
my $perl = delete $val->{perl_version};
if ( $perl ) {
$val->{requires} ||= [];
my $requires = $val->{requires};
# Canonize to three-dot version after Perl 5.6
if ( $perl >= 5.006 ) {
$perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
}
unshift @$requires, [ perl => $perl ];
}
# Load the advisory META.yml file
require YAML::Tiny;
my @yaml = YAML::Tiny::LoadFile('META.yml');
my $meta = $yaml[0];
# Overwrite the non-configure dependency hashs
delete $meta->{requires};
delete $meta->{build_requires};
delete $meta->{recommends};
if ( exists $val->{requires} ) {
$meta->{requires} = { map { @$_ } @{ $val->{requires} } };
}
if ( exists $val->{build_requires} ) {
$meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
}
# Save as the MYMETA.yml file
YAML::Tiny::DumpFile('MYMETA.yml', $meta);
}
1;
libtext-trac-perl-0.15/inc/Module/Install.pm 0000644 0001750 0001750 00000021205 11154653257 017716 0 ustar nacho nacho #line 1
package Module::Install;
# For any maintainers:
# The load order for Module::Install is a bit magic.
# It goes something like this...
#
# IF ( host has Module::Install installed, creating author mode ) {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
# 3. The installed version of inc::Module::Install loads
# 4. inc::Module::Install calls "require Module::Install"
# 5. The ./inc/ version of Module::Install loads
# } ELSE {
# 1. Makefile.PL calls "use inc::Module::Install"
# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
# 3. The ./inc/ version of Module::Install loads
# }
BEGIN {
require 5.004;
}
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
# All Module::Install core packages now require synchronised versions.
# This will be used to ensure we don't accidentally load old or
# different versions of modules.
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
$VERSION = '0.79';
*inc::Module::Install::VERSION = *VERSION;
@inc::Module::Install::ISA = __PACKAGE__;
}
# Whether or not inc::Module::Install is actually loaded, the
# $INC{inc/Module/Install.pm} is what will still get set as long as
# the caller loaded module this in the documented manner.
# If not set, the caller may NOT have loaded the bundled version, and thus
# they may not have a MI version that works with the Makefile.PL. This would
# result in false errors or unexpected behaviour. And we don't want that.
my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
use inc::${\__PACKAGE__};
not:
use ${\__PACKAGE__};
END_DIE
# If the script that is loading Module::Install is from the future,
# then make will detect this and cause it to re-run over and over
# again. This is bad. Rather than taking action to touch it (which
# is unreliable on some platforms and requires write permissions)
# for now we should catch this and refuse to run.
if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future.
This is known to create infinite loops in make.
Please correct this, then run $0 again.
END_DIE
# Build.PL was formerly supported, but no longer is due to excessive
# difficulty in implementing every single feature twice.
if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" }
Module::Install no longer supports Build.PL.
It was impossible to maintain duel backends, and has been deprecated.
Please remove all Build.PL files and only use the Makefile.PL installer.
END_DIE
# To save some more typing in Module::Install installers, every...
# use inc::Module::Install
# ...also acts as an implicit use strict.
$^H |= strict::bits(qw(refs subs vars));
use Cwd ();
use File::Find ();
use File::Path ();
use FindBin;
sub autoload {
my $self = shift;
my $who = $self->_caller;
my $cwd = Cwd::cwd();
my $sym = "${who}::AUTOLOAD";
$sym->{$cwd} = sub {
my $pwd = Cwd::cwd();
if ( my $code = $sym->{$pwd} ) {
# delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
$$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
unless ( uc($1) eq $1 ) {
unshift @_, ( $self, $1 );
goto &{$self->can('call')};
}
};
}
sub import {
my $class = shift;
my $self = $class->new(@_);
my $who = $self->_caller;
unless ( -f $self->{file} ) {
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
$self->{admin}->init;
@_ = ($class, _self => $self);
goto &{"$self->{name}::import"};
}
*{"${who}::AUTOLOAD"} = $self->autoload;
$self->preload;
# Unregister loader and worker packages so subdirs can use them again
delete $INC{"$self->{file}"};
delete $INC{"$self->{path}.pm"};
return 1;
}
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
);
}
my @exts = @{$self->{extensions}};
unless ( @exts ) {
my $admin = $self->{admin};
@exts = $admin->load_all_extensions;
}
my %seen;
foreach my $obj ( @exts ) {
while (my ($method, $glob) = each %{ref($obj) . '::'}) {
next unless $obj->can($method);
next if $method =~ /^_/;
next if $method eq uc($method);
$seen{$method}++;
}
}
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
};
}
}
sub new {
my ($class, %args) = @_;
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
delete $args{prefix};
}
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
$args{prefix} ||= 'inc';
$args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
$args{bundle} ||= 'inc/BUNDLES';
$args{base} ||= $base_path;
$class =~ s/^\Q$args{prefix}\E:://;
$args{name} ||= $class;
$args{version} ||= $class->VERSION;
unless ( $args{path} ) {
$args{path} = $args{name};
$args{path} =~ s!::!/!g;
}
$args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
$args{wrote} = 0;
bless( \%args, $class );
}
sub call {
my ($self, $method) = @_;
my $obj = $self->load($method) or return;
splice(@_, 0, 2, $obj);
goto &{$obj->can($method)};
}
sub load {
my ($self, $method) = @_;
$self->load_extensions(
"$self->{prefix}/$self->{path}", $self
) unless $self->{extensions};
foreach my $obj (@{$self->{extensions}}) {
return $obj if $obj->can($method);
}
my $admin = $self->{admin} or die <<"END_DIE";
The '$method' method does not exist in the '$self->{prefix}' path!
Please remove the '$self->{prefix}' directory and run $0 again to load it.
END_DIE
my $obj = $admin->load($method, 1);
push @{$self->{extensions}}, $obj;
$obj;
}
sub load_extensions {
my ($self, $path, $top) = @_;
unless ( grep { !ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
}
foreach my $rv ( $self->find_extensions($path) ) {
my ($file, $pkg) = @{$rv};
next if $self->{pathnames}{$pkg};
local $@;
my $new = eval { require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
$self->{pathnames}{$pkg} = delete $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
$self->{extensions} ||= [];
}
sub find_extensions {
my ($self, $path) = @_;
my @found;
File::Find::find( sub {
my $file = $File::Find::name;
return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
my $subpath = $1;
return if lc($subpath) eq lc($self->{dispatch});
$file = "$self->{path}/$subpath.pm";
my $pkg = "$self->{name}::$subpath";
$pkg =~ s!/!::!g;
# If we have a mixed-case package name, assume case has been preserved
# correctly. Otherwise, root through the file to locate the case-preserved
# version of the package name.
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
foreach ( split //, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
next if /^\s*#/; # and comments
if ( m/^\s*package\s+($pkg)\s*;/i ) {
$pkg = $1;
last;
}
}
}
push @found, [ $file, $pkg ];
}, $path ) if -d $path;
@found;
}
#####################################################################
# Utility Functions
sub _caller {
my $depth = 0;
my $call = caller($depth);
while ( $call eq __PACKAGE__ ) {
$depth++;
$call = caller($depth);
}
return $call;
}
sub _read {
local *FH;
open FH, "< $_[0]" or die "open($_[0]): $!";
my $str = do { local $/; };
close FH or die "close($_[0]): $!";
return $str;
}
sub _write {
local *FH;
open FH, "> $_[0]" or die "open($_[0]): $!";
foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" }
close FH or die "close($_[0]): $!";
}
# _version is for processing module versions (eg, 1.03_05) not
# Perl versions (eg, 5.8.1).
sub _version ($) {
my $s = shift || 0;
$s =~ s/^(\d+)\.?//;
my $l = $1 || 0;
my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g;
$l = $l . '.' . join '', @v if @v;
return $l + 0;
}
# Cloned from Params::Util::_CLASS
sub _CLASS ($) {
(
defined $_[0]
and
! ref $_[0]
and
$_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
) ? $_[0] : undef;
}
1;
# Copyright 2008 - 2009 Adam Kennedy.
libtext-trac-perl-0.15/inc/Module/AutoInstall.pm 0000644 0001750 0001750 00000050772 11154653260 020554 0 ustar nacho nacho #line 1
package Module::AutoInstall;
use strict;
use Cwd ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
$VERSION = '1.03';
}
# special map on pre-defined feature sets
my %FeatureMap = (
'' => 'Core Features', # XXX: deprecated
'-core' => 'Core Features',
);
# various lexical flags
my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly );
my ( $PostambleActions, $PostambleUsed );
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
_init();
sub _accept_default {
$AcceptDefault = shift;
}
sub missing_modules {
return @Missing;
}
sub do_install {
__PACKAGE__->install(
[
$Config
? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
: ()
],
@Missing,
);
}
# initialize various flags, and/or perform install
sub _init {
foreach my $arg (
@ARGV,
split(
/[\s\t]+/,
$ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || ''
)
)
{
if ( $arg =~ /^--config=(.*)$/ ) {
$Config = [ split( ',', $1 ) ];
}
elsif ( $arg =~ /^--installdeps=(.*)$/ ) {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
elsif ( $arg =~ /^--check(?:deps)?$/ ) {
$CheckOnly = 1;
}
elsif ( $arg =~ /^--skip(?:deps)?$/ ) {
$SkipInstall = 1;
}
elsif ( $arg =~ /^--test(?:only)?$/ ) {
$TestOnly = 1;
}
}
}
# overrides MakeMaker's prompt() to automatically accept the default choice
sub _prompt {
goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault;
my ( $prompt, $default ) = @_;
my $y = ( $default =~ /^[Yy]/ );
print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] ';
print "$default\n";
return $default;
}
# the workhorse
sub import {
my $class = shift;
my @args = @_ or return;
my $core_all;
print "*** $class version " . $class->VERSION . "\n";
print "*** Checking for Perl dependencies...\n";
my $cwd = Cwd::cwd();
$Config = [];
my $maxlen = length(
(
sort { length($b) <=> length($a) }
grep { /^[^\-]/ }
map {
ref($_)
? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} )
: ''
}
map { +{@args}->{$_} }
grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} }
)[0]
);
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
my $default = 1;
my $conflict = 0;
if ( $feature =~ m/^-(\w+)$/ ) {
my $option = lc($1);
# check for a newer version of myself
_update_to( $modules, @_ ) and return if $option eq 'version';
# sets CPAN configuration options
$Config = $modules if $option eq 'config';
# promote every features to core status
$core_all = ( $modules =~ /^all$/i ) and next
if $option eq 'core';
next unless $option eq 'core';
}
print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n";
$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
unshift @$modules, -default => &{ shift(@$modules) }
if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
if ( $mod =~ m/^-(\w+)$/ ) {
my $option = lc($1);
$default = $arg if ( $option eq 'default' );
$conflict = $arg if ( $option eq 'conflict' );
@tests = @{$arg} if ( $option eq 'tests' );
@skiptests = @{$arg} if ( $option eq 'skiptests' );
next;
}
printf( "- %-${maxlen}s ...", $mod );
if ( $arg and $arg =~ /^\D/ ) {
unshift @$modules, $arg;
$arg = 0;
}
# XXX: check for conflicts and uninstalls(!) them.
if (
defined( my $cur = _version_check( _load($mod), $arg ||= 0 ) ) )
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
push @Existing, $mod => $arg;
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n";
push @required, $mod => $arg;
}
}
next unless @required;
my $mandatory = ( $feature eq '-core' or $core_all );
if (
!$SkipInstall
and (
$CheckOnly
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
. ( $mandatory ? ' mandatory' : ' optional' )
. qq{ module(s) from CPAN?},
$default ? 'y' : 'n',
) =~ /^[Yy]/
)
)
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
elsif ( !$SkipInstall
and $default
and $mandatory
and
_prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', )
=~ /^[Nn]/ )
{
push( @Missing, @required );
$DisabledTests{$_} = 1 for map { glob($_) } @skiptests;
}
else {
$DisabledTests{$_} = 1 for map { glob($_) } @tests;
}
}
$UnderCPAN = _check_lock(); # check for $UnderCPAN
if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
require Config;
print
"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
if eval '$>';
}
print "*** $class configuration finished.\n";
chdir $cwd;
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
}
# Check to see if we are currently running under CPAN.pm and/or CPANPLUS;
# if we are, then we simply let it taking care of our dependencies
sub _check_lock {
return unless @Missing;
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
print <<'END_MESSAGE';
*** Since we're running under CPANPLUS, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
_load_cpan();
# Find the CPAN lock-file
my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" );
return unless -f $lock;
# Check the lock
local *LOCK;
return unless open(LOCK, $lock);
if (
( $^O eq 'MSWin32' ? _under_cpan() : == getppid() )
and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore'
) {
print <<'END_MESSAGE';
*** Since we're running under CPAN, I'll just let it take care
of the dependency's installation later.
END_MESSAGE
return 1;
}
close LOCK;
return;
}
sub install {
my $class = shift;
my $i; # used below to strip leading '-' from config keys
my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
my ( @modules, @installed );
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
if ( defined( _version_check( _load($pkg), $ver ) ) ) {
push @installed, $pkg;
}
else {
push @modules, $pkg, $ver;
}
}
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
print "*** Installing dependencies...\n";
return unless _connected_to('cpan.org');
my %args = @config;
my %failed;
local *FAILED;
if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) {
while () { chomp; $failed{$_}++ }
close FAILED;
my @newmod;
while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) {
push @newmod, ( $k => $v ) unless $failed{$k};
}
@modules = @newmod;
}
if ( _has_cpanplus() ) {
_install_cpanplus( \@modules, \@config );
} else {
_install_cpan( \@modules, \@config );
}
print "*** $class installation finished.\n";
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
if ( defined( _version_check( _load($pkg), $ver ) ) ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
print FAILED "$pkg\n";
}
}
close FAILED if $args{do_once};
return @installed;
}
sub _install_cpanplus {
my @modules = @{ +shift };
my @config = _cpanplus_config( @{ +shift } );
my $installed = 0;
require CPANPLUS::Backend;
my $cp = CPANPLUS::Backend->new;
my $conf = $cp->configure_object;
return unless $conf->can('conf') # 0.05x+ with "sudo" support
or _can_write($conf->_get_build('base')); # 0.04x
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $conf->get_conf('makeflags') || '';
if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) {
# 0.03+ uses a hashref here
$makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST};
} else {
# 0.02 and below uses a scalar
$makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
}
$conf->set_conf( makeflags => $makeflags );
$conf->set_conf( prereqs => 1 );
while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) {
$conf->set_conf( $key, $val );
}
my $modtree = $cp->module_tree;
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
print "*** Installing $pkg...\n";
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
my $success;
my $obj = $modtree->{$pkg};
if ( $obj and defined( _version_check( $obj->{version}, $ver ) ) ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $cp->install( modules => [ $obj->{module} ] );
if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) {
print "*** $pkg successfully installed.\n";
$success = 1;
} else {
print "*** $pkg installation cancelled.\n";
$success = 0;
}
$installed += $success;
} else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _cpanplus_config {
my @config = ();
while ( @_ ) {
my ($key, $value) = (shift(), shift());
if ( $key eq 'prerequisites_policy' ) {
if ( $value eq 'follow' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_INSTALL();
} elsif ( $value eq 'ask' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_ASK();
} elsif ( $value eq 'ignore' ) {
$value = CPANPLUS::Internals::Constants::PREREQ_IGNORE();
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
}
return @config;
}
sub _install_cpan {
my @modules = @{ +shift };
my @config = @{ +shift };
my $installed = 0;
my %args;
_load_cpan();
require Config;
if (CPAN->VERSION < 1.80) {
# no "sudo" support, probe for writableness
return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) )
and _can_write( $Config::Config{sitelib} );
}
# if we're root, set UNINST=1 to avoid trouble unless user asked for it.
my $makeflags = $CPAN::Config->{make_install_arg} || '';
$CPAN::Config->{make_install_arg} =
join( ' ', split( ' ', $makeflags ), 'UNINST=1' )
if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } );
# don't show start-up info
$CPAN::Config->{inhibit_startup_message} = 1;
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
if $opt =~ /^force$/; # pseudo-option
$CPAN::Config->{$opt} = $arg;
}
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall;
print "*** Installing $pkg...\n";
my $obj = CPAN::Shell->expand( Module => $pkg );
my $success = 0;
if ( $obj and defined( _version_check( $obj->cpan_version, $ver ) ) ) {
my $pathname = $pkg;
$pathname =~ s/::/\\W/;
foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) {
delete $INC{$inc};
}
my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
: CPAN::Shell->install($pkg);
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
if $CPAN::META;
};
if ( $rv eq 'YES' ) {
print "*** $pkg successfully installed.\n";
$success = 1;
}
else {
print "*** $pkg installation failed.\n";
$success = 0;
}
$installed += $success;
}
else {
print << ".";
*** Could not find a version $ver or above for $pkg; skipping.
.
}
MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall;
}
return $installed;
}
sub _has_cpanplus {
return (
$HasCPANPLUS = (
$INC{'CPANPLUS/Config.pm'}
or _load('CPANPLUS::Shell::Default')
)
);
}
# make guesses on whether we're under the CPAN installation directory
sub _under_cpan {
require Cwd;
require File::Spec;
my $cwd = File::Spec->canonpath( Cwd::cwd() );
my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
return ( index( $cwd, $cpan ) > -1 );
}
sub _update_to {
my $class = __PACKAGE__;
my $ver = shift;
return
if defined( _version_check( _load($class), $ver ) ); # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
'y' ) =~ /^[Nn]/
)
{
die "*** Please install $class $ver manually.\n";
}
print << ".";
*** Trying to fetch it from CPAN...
.
# install ourselves
_load($class) and return $class->import(@_)
if $class->install( [], $class, $ver );
print << '.'; exit 1;
*** Cannot bootstrap myself. :-( Installation terminated.
.
}
# check if we're connected to some host, using inet_aton
sub _connected_to {
my $site = shift;
return (
( _load('Socket') and Socket::inet_aton($site) ) or _prompt(
qq(
*** Your host cannot resolve the domain name '$site', which
probably means the Internet connections are unavailable.
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/
);
}
# check if a directory is writable; may create it on demand
sub _can_write {
my $path = shift;
mkdir( $path, 0755 ) unless -e $path;
return 1 if -w $path;
print << ".";
*** You are not allowed to write to the directory '$path';
the installation may fail due to insufficient permissions.
.
if (
eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt(
qq(
==> Should we try to re-execute the autoinstall process with 'sudo'?),
((-t STDIN) ? 'y' : 'n')
) =~ /^[Yy]/
)
{
# try to bootstrap ourselves from sudo
print << ".";
*** Trying to re-execute the autoinstall process with 'sudo'...
.
my $missing = join( ',', @Missing );
my $config = join( ',',
UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
return
unless system( 'sudo', $^X, $0, "--config=$config",
"--installdeps=$missing" );
print << ".";
*** The 'sudo' command exited with error! Resuming...
.
}
return _prompt(
qq(
==> Should we try to install the required module(s) anyway?), 'n'
) =~ /^[Yy]/;
}
# load a module and return the version it reports
sub _load {
my $mod = pop; # class/instance doesn't matter
my $file = $mod;
$file =~ s|::|/|g;
$file .= '.pm';
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION;
require CPAN;
if ( $CPAN::HandleConfig::VERSION ) {
# Newer versions of CPAN have a HandleConfig module
CPAN::HandleConfig->load;
} else {
# Older versions had the load method in Config directly
CPAN::Config->load;
}
}
# compare two versions, either use Sort::Versions or plain comparison
sub _version_check {
my ( $cur, $min ) = @_;
return unless defined $cur;
$cur =~ s/\s+$//;
# check for version numbers that are not in decimal format
if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) {
if ( ( $version::VERSION or defined( _load('version') )) and
version->can('new')
) {
# use version.pm if it is installed.
return (
( version->new($cur) >= version->new($min) ) ? $cur : undef );
}
elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) )
{
# use Sort::Versions as the sorting algorithm for a.b.c versions
return ( ( Sort::Versions::versioncmp( $cur, $min ) != -1 )
? $cur
: undef );
}
warn "Cannot reliably compare non-decimal formatted versions.\n"
. "Please install version.pm or Sort::Versions.\n";
}
# plain comparison
local $^W = 0; # shuts off 'not numeric' bugs
return ( $cur >= $min ? $cur : undef );
}
# nothing; this usage is deprecated.
sub main::PREREQ_PM { return {}; }
sub _make_args {
my %args = @_;
$args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing }
if $UnderCPAN or $TestOnly;
if ( $args{EXE_FILES} and -e 'MANIFEST' ) {
require ExtUtils::Manifest;
my $manifest = ExtUtils::Manifest::maniread('MANIFEST');
$args{EXE_FILES} =
[ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ];
}
$args{test}{TESTS} ||= 't/*.t';
$args{test}{TESTS} = join( ' ',
grep { !exists( $DisabledTests{$_} ) }
map { glob($_) } split( /\s+/, $args{test}{TESTS} ) );
my $missing = join( ',', @Missing );
my $config =
join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} )
if $Config;
$PostambleActions = (
$missing
? "\$(PERL) $0 --config=$config --installdeps=$missing"
: "\$(NOECHO) \$(NOOP)"
);
return %args;
}
# a wrapper to ExtUtils::MakeMaker::WriteMakefile
sub Write {
require Carp;
Carp::croak "WriteMakefile: Need even number of args" if @_ % 2;
if ($CheckOnly) {
print << ".";
*** Makefile not written in check-only mode.
.
return;
}
my %args = _make_args(@_);
no strict 'refs';
$PostambleUsed = 0;
local *MY::postamble = \&postamble unless defined &MY::postamble;
ExtUtils::MakeMaker::WriteMakefile(%args);
print << "." unless $PostambleUsed;
*** WARNING: Makefile written with customized MY::postamble() without
including contents from Module::AutoInstall::postamble() --
auto installation features disabled. Please contact the author.
.
return 1;
}
sub postamble {
$PostambleUsed = 1;
return << ".";
config :: installdeps
\t\$(NOECHO) \$(NOOP)
checkdeps ::
\t\$(PERL) $0 --checkdeps
installdeps ::
\t$PostambleActions
.
}
1;
__END__
#line 1003
libtext-trac-perl-0.15/lib/ 0000755 0001750 0001750 00000000000 11154653351 014515 5 ustar nacho nacho libtext-trac-perl-0.15/lib/Text/ 0000755 0001750 0001750 00000000000 11154653351 015441 5 ustar nacho nacho libtext-trac-perl-0.15/lib/Text/Trac/ 0000755 0001750 0001750 00000000000 11154653351 016332 5 ustar nacho nacho libtext-trac-perl-0.15/lib/Text/Trac/P.pm 0000755 0001750 0001750 00000004257 10763001334 017073 0 ustar nacho nacho package Text::Trac::P;
use strict;
use base qw(Text::Trac::BlockNode);
use Text::Trac::Text;
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
if( !@{$c->in_block_of} or $c->in_block_of->[-1] ne 'p' ){
$c->htmllines('');
push @{$c->in_block_of}, 'p';
}
# define block parsers called.
$self->block_nodes( [ qw( blockquote hr ) ]);
$self->block_parsers( $self->_get_parsers('block') );
my $cite_depth = 0;
$c->unshiftline;
while( $c->hasnext ){
last if $c->nextline =~ /^$/;
$l = $c->shiftline;
last if $l =~ /^\s+$/;
my $blockquote_depth = 0;
for ( @{$c->in_block_of} ) {
$blockquote_depth++ if $_ eq 'blockquote';
}
if ( $l =~ /^(>+)/ ) {
$cite_depth = length $1;
if ( $blockquote_depth != $cite_depth ) {
$c->unshiftline;
last;
}
else {
$l =~ s/^>+//;
}
}
elsif ( $l !~ /^(?:>|\s+)/ and $blockquote_depth ) {
$c->htmllines('
');
pop @{$c->in_block_of};
for ( 1.. $blockquote_depth ) {
$c->htmllines('');
pop @{$c->in_block_of};
}
$c->unshiftline;
last;
}
# parse other block nodes
my $parsers = $self->_get_matched_parsers('block', $l);
if( grep { ref($_) ne 'Text::Trac::P' } @{$parsers} ){
$c->htmllines('');
pop @{$c->in_block_of};
$c->unshiftline;
last;
}
# parse inline nodes
$l = $self->replace($l);
$c->htmllines($l);
}
if( @{$c->in_block_of} and $c->in_block_of->[-1] eq 'p' ){
$c->htmllines('');
pop @{$c->in_block_of};
my $blockquote_depth = 0;
for ( @{$c->in_block_of} ) {
$blockquote_depth++ if $_ eq 'blockquote';
}
if ( $cite_depth ) {
for ( $blockquote_depth .. length $1 ) {
$c->htmllines('');
pop @{$c->in_block_of};
}
}
}
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/ 0000755 0001750 0001750 00000000000 11154653351 020751 5 ustar nacho nacho libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Attachment.pm 0000755 0001750 0001750 00000001102 10761015565 023376 0 ustar nacho nacho package Text::Trac::LinkResolver::Attachment;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $type, $name, $file ) = ( $match =~ m/attachment:([^:]+):([^:]+):([^:\]\s]+)/ );
my $url = $c->{trac_attachment_url} || $c->trac_url . "attachment/";
$url .= "$type/$name/$file";
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Log.pm 0000644 0001750 0001750 00000001101 10761015565 022023 0 ustar nacho nacho package Text::Trac::LinkResolver::Log;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?\[\d+:\d+\]|(?:\b|!)r\d+:\d+\b';
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $from, $to ) = ( $match =~ m/(\d+):(\d+)/ );
my $url = $c->{trac_log_url} || $c->trac_url . "log/";
return sprintf '%s', $url, $to, $from, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Wiki.pm 0000755 0001750 0001750 00000001330 10763001334 022203 0 ustar nacho nacho package Text::Trac::LinkResolver::Wiki;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?(?_is_disabled;
my $c = $self->{context};
$label ||= $match;
$target ||= $match;
if ( $label =~ /\[wiki:(\S+)\s+(.+)\]/ ) {
$target = $1;
$label = $2;
}
my $url = $c->{trac_wiki_url} || $c->trac_url . "wiki/";
$url .= $target;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Source.pm 0000644 0001750 0001750 00000001053 10761015565 022550 0 ustar nacho nacho package Text::Trac::LinkResolver::Source;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $file, $rev ) = ( $target =~ m/([^#]+)(?:#(\d+))?/ );
my $url = $c->{trac_source_url} || $c->trac_url . "browser/";
$url .= $file;
$url .= "?rev=$rev" if $rev;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Milestone.pm 0000755 0001750 0001750 00000001016 10761015565 023251 0 ustar nacho nacho package Text::Trac::LinkResolver::Milestone;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $from, $to ) = ( $match =~ m/(\d+):(\d+)/ );
my $url = $c->{trac_milestone_url} || $c->trac_url . "milestone/";
$url .= $target;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Changeset.pm 0000755 0001750 0001750 00000001070 10761015565 023213 0 ustar nacho nacho package Text::Trac::LinkResolver::Changeset;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?\[\d+\]|(?:\b|!)r\d+\b(?!:\d)';
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $rev ) = ( $match =~ m/(\d+)/ );
my $url = $c->{trac_changeset_url} || $c->trac_url . "changeset/";
$url .= $rev;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Ticket.pm 0000755 0001750 0001750 00000001032 10761015565 022533 0 ustar nacho nacho package Text::Trac::LinkResolver::Ticket;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?(?_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $rev ) = ( $match =~ m/(\d+)/ );
my $url = $c->{trac_ticket_url} || $c->trac_url . 'ticket/';
$url .= $rev;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Comment.pm 0000644 0001750 0001750 00000001140 11001130622 022663 0 ustar nacho nacho package Text::Trac::LinkResolver::Comment;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?(?_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $rev,$commentId ) = ( $match =~ m/(\d+):(\d+)/ );
my $url = $c->{trac_ticket_url} || $c->trac_url . 'ticket/';
$url .= $rev;
$url .= "#comment:$commentId";
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver/Report.pm 0000755 0001750 0001750 00000001030 10761015565 022561 0 ustar nacho nacho package Text::Trac::LinkResolver::Report;
use strict;
use base qw( Text::Trac::LinkResolver );
sub init {
my $self = shift;
$self->{pattern} = '!?\{\d+\}';
}
sub format_link {
my ( $self, $match, $target, $label ) = @_;
return $match if $self->_is_disabled;
my $c = $self->{context};
$label ||= $match;
my ( $rev ) = ( $match =~ m/(\d+)/ );
my $url = $c->{trac_report_url} || $c->trac_url . "report/";
$url .= $rev;
return sprintf '%s', $url, $label;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Dl.pm 0000755 0001750 0001750 00000002267 10761015565 017243 0 ustar nacho nacho package Text::Trac::Dl;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/^\s+(.*)::$/xms);
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
if( !@{$c->in_block_of} or $c->in_block_of->[-1] ne 'dl' ){
$c->htmllines('');
push @{$c->in_block_of}, 'dl';
}
$c->unshiftline;
while($c->hasnext){
last if( $c->nextline =~ /^$/ );
my $l = $c->shiftline;
if( $l =~ /$pattern/ ){
if ( $c->in_block_of->[-1] eq 'dd' ){
$l = "\n- $1
";
pop @{$c->in_block_of};
}
else {
$l = "- $1
";
}
}
else {
$l =~ s/^\s+//g;
if( $c->in_block_of->[-1] ne 'dd' ){
$l = "- \n$l";
push @{$c->in_block_of}, 'dd';
}
}
$c->htmllines($l);
}
if ( $c->in_block_of->[-1] eq 'dd' ){
$c->htmllines('
');
pop @{$c->in_block_of};
}
pop @{$c->in_block_of};
$c->htmllines('
');
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Hr.pm 0000755 0001750 0001750 00000000552 10761016534 017245 0 ustar nacho nacho package Text::Trac::Hr;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/^----$/xms);
return $self;
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->context;
my $pattern = $self->pattern;
$l =~ $pattern or return;
$l =~ s{ $pattern }{
}xmsg;
$c->htmllines($l);
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Macro/ 0000755 0001750 0001750 00000000000 11154653351 017373 5 ustar nacho nacho libtext-trac-perl-0.15/lib/Text/Trac/Macro/Timestamp.pm 0000755 0001750 0001750 00000000232 10761015565 021676 0 ustar nacho nacho package Text::Trac::Macro::Timestamp;
use strict;
use warnings;
sub process {
my $class = shift;
return '' . localtime(time) . '';
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Macro/HelloWorld.pm 0000755 0001750 0001750 00000000260 10761015565 022007 0 ustar nacho nacho package Text::Trac::Macro::HelloWorld;
use strict;
use warnings;
sub process {
my ( $class, $c, @args ) = @_;
return "Hello World, args = " . join ', ', @args;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Ol.pm 0000755 0001750 0001750 00000003257 10763544362 017262 0 ustar nacho nacho package Text::Trac::Ol;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/(\s+) ([\daiAI])\. \s+ (.*)$/xms);
return $self;
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
$l =~ $pattern or return $l;
my $type = $2;
my $space = length($1);
my $level = $c->ol->{level} || 0;
$c->ol->{space} ||= 0;
my $start_tag;
if ($type =~ /(\d)/){
$start_tag = $type == 1 ? '' : qq{};
}
elsif ($type eq 'a'){
$start_tag = qq{};
}
elsif ($type eq 'A'){
$start_tag = qq{};
}
elsif ($type eq 'i'){
$start_tag = qq{};
}
elsif ($type eq 'I'){
$start_tag = qq{};
}
if ( $space > $c->ol->{space} ){
for ( 1 .. ( $space + 1 ) / 2 - $level ) {
$l = $start_tag . $l;
$level++;
}
}
elsif ( $space < $c->ol->{space} ){
for ( 1 .. ( $c->ol->{space} - $space ) / 2 ) {
$l = '
' . $l;
$level--;
}
$l =~ s!(?<=)(?= )!!;
}
else {
$l = "$l";
}
$c->ol({level => $level, space => $space });
# parse inline nodes
$l =~ s{ $pattern }{'- ' . $self->replace($3)}xmsge;
if ($c->hasnext and $c->nextline =~ $pattern){
$self->parse($l);
}
else {
for ( 1 .. $c->ol->{level} ){
$l .= '
';
}
$c->ol->{level} = 0;
$c->ol->{space} = 0;
}
$c->htmllines($l);
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Ul.pm 0000755 0001750 0001750 00000002343 10763001334 017246 0 ustar nacho nacho package Text::Trac::Ul;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/(\s+) \* \s+ (.*)$/xms);
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
$l =~ $pattern or return $l;
my $space = length($1);
my $level = $c->ul->{level} || 0;
$c->ul->{space} ||= 0;
if ( $space > $c->ul->{space} ) {
for ( 1 .. ( $space + 1 ) / 2 - $level ) {
$l = '' . $l;
$level++;
}
}
elsif ( $space < $c->ul->{space} ) {
for ( 1 .. ( $c->ul->{space} - $space ) / 2 ) {
$l = '
' . $l;
$level--;
}
$l =~ s!(?<=)(?= )!!;
}
else {
$l = "$l";
}
$c->ul({ level => $level, space => $space });
# parse inline nodes
$l =~ s{ $pattern }{"- " . $self->replace($2)}xmsge;
if ( $c->hasnext and $c->nextline =~ /$pattern/ ){
$self->parse($l);
}
else {
for ( 1 .. $c->ul->{level} ){
$l .= '
';
}
$c->ul->{level} = 0;
$c->ul->{space} = 0;
}
# parse inline nodes
$c->htmllines($l);
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/LinkResolver.pm 0000755 0001750 0001750 00000001221 11001131165 021267 0 ustar nacho nacho package Text::Trac::LinkResolver;
use strict;
use warnings;
use List::MoreUtils qw( any );
our @handlers = qw( changeset wiki report log ticket milestone source attachment comment );
sub new {
my $class = shift;
my $self = { context => shift };
bless $self, $class;
$self->init;
return $self;
}
sub _is_disabled {
my ( $self, $resolver ) = @_;
( my $formatter = ref $self ) =~ s/.*:://;
if ( @{ $self->{context}->{enable_links} } ) {
return !any { lcfirst($formatter) eq $_ } @{ $self->{context}->{enable_links} };
}
return any { lcfirst($formatter) eq $_ } @{ $self->{context}->{disable_links} };
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Pre.pm 0000755 0001750 0001750 00000001207 10761015565 017423 0 ustar nacho nacho package Text::Trac::Pre;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/^{{{$/xms);
return $self;
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
$l =~ /$pattern/ or return $l;
my $match = $1;
if ( $l =~ /^{{{$/ ){
$c->htmllines('');
}
while($c->hasnext){
my $l = $c->shiftline;
if ( $l =~ /^}}}$/) {
$c->htmllines('');
last;
}
else {
$c->htmllines($self->escape($l));
}
}
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Table.pm 0000755 0001750 0001750 00000001475 10761015565 017733 0 ustar nacho nacho package Text::Trac::Table;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/^\|\|([^\|]*\|\|(?:[^\|]*\|\|)+)$/xms);
return $self;
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
$l =~ $pattern or return $l;
$c->htmllines('');
$c->unshiftline;
while( $c->hasnext and ($c->nextline =~ $pattern ) ){
my $l = $c->shiftline;
$l =~ s{ $self->{pattern} }{$1}xmsg;
$l = "| " . join( " | ",
map {
$self->replace($_) # parse inline nodes
} split(/\|\|/, $l) ) . " |
";
$c->htmllines($l);
}
$c->htmllines('
');
return;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/InlineNode.pm 0000644 0001750 0001750 00000020015 11150517307 020706 0 ustar nacho nacho package Text::Trac::InlineNode;
use strict;
use Tie::IxHash;
use Text::Trac::Macro;
use UNIVERSAL::require;
use Text::Trac::LinkResolver;
use HTML::Entities qw();
tie my %token_table, 'Tie::IxHash';
#my $handler = $token_table{'!?\\[\\d+\\]|(?:\\b|!)r\\d+\\b(?!:\\d)'};
#$handler->format_link('test');
my $link_scheme = '[\w.+-]+';
my $quoted_string = q{'[^']+'|"[^"]+"};
my $shref_target_first = '[\w/?!#@]';
my $shref_target_middle = '(?:\|(?=[^|\s])|[^|<>\s])';
my $shref_target_last = '[a-zA-Z0-9/=]';
my $shref = "!?$link_scheme:
(?:
$quoted_string
|$shref_target_first(?:$shref_target_middle*$shref_target_last)?
)
";
my $macro = '\[\[[\w/+-]+(?:\(.*\))?\]\]';
my $lhref_relative_target = '[/.][^\s[\]]*';
my $lhref = "!?\\[
(?:
$link_scheme:
(?:$quoted_string|[^\\[\\]\\s]*)
|(?:$lhref_relative_target|[^\\[\\]\\s])
)
(?:
\\s+
$quoted_string
|[^\\]]+
)?
\\]
";
my $rules = join '|', ( map { "($_)" } ( keys %token_table ) );
$rules = qr/$rules/x;
map { $_ =~ s/^\!\?// } ( values %token_table );
map { $_ =~ s/^\\// } ( values %token_table );
sub new {
my ( $class, $c ) = @_;
# external link resolvers
my %external_handler;
for ( @Text::Trac::LinkResolver::handlers ) {
my $class = 'Text::Trac::LinkResolver::' . ucfirst($_);
$class->require;
my $handler = $class->new($c);
$token_table{ $handler->{pattern} } = $handler if defined $handler->{pattern};
$external_handler{$_} = $handler;
}
%token_table = (
q{'''''} => 'bolditalic',
q{'''} => 'bold',
q{''} => 'italic',
'!?__' => 'underline',
'!?~~' => 'strike',
'!?,,' => 'subscript',
'!?\^' => 'superscript',
'`|{{{|}}}' => 'inline',
$macro => 'macro',
%token_table,
$lhref => 'lhref',
$shref => 'shref',
);
my $rules = join '|', ( map { "($_)" } ( keys %token_table ) );
$rules = qr/$rules/x;
map { $_ =~ s/^\!\?// } ( values %token_table );
map { $_ =~ s/^\\// } ( values %token_table );
my $self = {
context => $c,
open_tags => [],
rules => $rules,
external_handler => \%external_handler,
};
bless $self, $class;
return $self;
}
sub parse {
my ( $self, $rest ) = @_;
my $html = '';
while ($rest =~ /$self->{rules}/xms) {
$html .= $self->escape($`) . $self->_replace($&, $`, $');
$rest = $';
}
return $html . $self->escape($rest);
}
sub escape {
my ( $self, $s ) = @_;
return HTML::Entities::encode($s, '<>&"');
}
sub _replace {
my ( $self, $match, $pre_match, $post_match ) = @_;
if ( $match =~ s/^!// ) {
return $match;
}
else {
TOKEN:
for my $token ( keys %token_table ) {
if ( $match =~ /$token/x ) {
my $formatter = $token_table{$token};
if ( ref $formatter ) {
for ( qw/ log source attachment http / ) {
next TOKEN if $match =~ /^\[?$_/;
}
return $formatter->format_link($match);
}
else {
my $method = "_${formatter}_formatter";
return $self->$method($match, $pre_match, $post_match);
}
}
}
}
}
sub _simple_tag_handler {
my ( $self, $open_tag, $close_tag ) = @_;
if ( $self->_is_open($open_tag) ) {
$self->_close_tag($open_tag);
return $close_tag;
}
else {
$self->_open_tag($open_tag);
return $open_tag;
}
}
sub _is_open {
my ( $self, $tag ) = @_;
return grep { $tag eq $_ } @{ $self->{open_tags} };
}
sub _open_tag {
my ( $self, $tag ) = @_;
push @{ $self->{open_tags} }, $tag;
}
sub _close_tag {
my ( $self, $tag ) = @_;
my $index = 0;
for ( @{ $self->{open_tags} } ) {
last if $tag eq $_;
$index++;
}
splice @{ $self->{open_tags} }, $index;
}
sub _bolditalic_formatter {
my $self = shift;
my $is_open = $self->_is_open('');
my $tmp;
if ( $is_open ) {
$tmp .= '';
$self->_close_tag('');
}
$tmp .= $self->_bold_formatter;
unless ( $is_open ) {
$tmp .= '';
$self->_open_tag('');
}
return $tmp;
}
sub _bold_formatter {
my $self = shift;
return $self->_simple_tag_handler('', '');
}
sub _italic_formatter {
my $self = shift;
return $self->_simple_tag_handler('', '');
}
sub _underline_formatter {
my ( $self, $match, $pre_match, $post_match ) = @_;
return $self->_simple_tag_handler('', '')
}
sub _strike_formatter {
my ( $self, $match, $pre_match, $post_match ) = @_;
return $self->_simple_tag_handler('', '')
}
sub _superscript_formatter {
my ( $self, $match, $pre_match, $post_match ) = @_;
return $self->_simple_tag_handler('', '')
}
sub _subscript_formatter {
my ( $self, $match, $pre_match, $post_match ) = @_;
return $self->_simple_tag_handler('', '')
}
sub _inline_formatter {
my ( $self, $match, $pre_match, $post_match ) = @_;
return $self->_simple_tag_handler('', '')
}
sub _shref_formatter {
my ( $self, $match ) = @_;
my ( $ns, $target ) = ( $match =~ m/($link_scheme):
(
$quoted_string
|$shref_target_first
(?:
$shref_target_middle*
$shref_target_last
)?
)
/x );
return $self->_make_link($ns, $target, $match, $match);
}
sub _lhref_formatter {
my ( $self, $match ) = @_;
my ( $ns, $target, $label ) =
( $match =~ m/\[
($link_scheme):
(
(?:$quoted_string|[^\]\s]*)
|(?:$lhref_relative_target|[^\]\s])
)
(?:
\s+
($quoted_string|[^\]]+)
)?
\]
/x );
if ( !$label ) { # e.g. `[http://target]` or `[wiki:target]`
if ( $target ) {
if ( $target =~ m!^//! ) {
$label = $ns . ':' . $target;
}
else {
$label = $target;
}
}
else { # e.g. `[search:]`
$label = $ns;
}
}
return $self->_make_link($ns, $target, $match, $label);
}
sub _make_link {
my ( $self, $ns, $target, $match, $label ) = @_;
if ( $target =~ m!^//! or $target eq 'mailto' ) {
return $self->_make_ext_link($ns . ':' . $target, $label);
}
else {
my $handler = $self->{external_handler}->{$ns};
return $handler ? $handler->format_link($match, $target, $label) : $match;
}
}
sub _make_ext_link {
my ( $self, $url, $text, $title ) = @_;
my $title_attr = $title ? qq{title="$title"} : '';
$title ||= $text;
my $local = $self->{context}->{local} || '';
if ( $url !~ /^$local/ or !$local ) {
return qq{$text};
}
}
sub _macro_formatter {
my ( $self, $match ) = @_;
my ( $name, $args ) = ( $match =~ m!\[\[ ([\w/+-]+) (?:\( (.*) \))? \]\]!x );
if ( $name =~ /br/i ) {
return '
';
}
else {
return Text::Trac::Macro->new->parse($name, $args, $match);
}
}
package Text::Trac::InlineNode::Initializer;
1;
libtext-trac-perl-0.15/lib/Text/Trac/Blockquote.pm 0000755 0001750 0001750 00000003665 11001130266 020777 0 ustar nacho nacho package Text::Trac::Blockquote;
use strict;
use base qw( Text::Trac::BlockNode );
sub init {
my $self = shift;
$self->pattern(qr/^(?:>|\s+(?![*\s]|[\daiAI]\.\ +).+$)/);
$self->block_nodes([ qw( heading p ul ol ) ]);
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->{context};
my $pattern = $self->pattern;
return if $l =~ /::$/;
if ( $l =~ /^(>+).+/ ) {
my $depth = length $1;
my $blockquote_depth = 0;
for ( @{$c->in_block_of} ) {
$blockquote_depth++ if $_ eq 'blockquote';
}
if ( $depth > $blockquote_depth ) {
for ( 1 .. $depth ) {
$c->htmllines('');
push @{$c->in_block_of}, 'blockquote';
}
}
}
else {
$c->htmllines('');
push @{$c->in_block_of}, 'blockquote';
}
$c->unshiftline;
while( $c->hasnext ){
last if( $c->nextline =~ /^\s*$/ );
my $l = $c->shiftline;
if ( $l =~ /^(>+).+/ ) {
my $depth = length $1;
my $blockquote_depth = 0;
for ( @{$c->in_block_of} ) {
$blockquote_depth++ if $_ eq 'blockquote';
}
if ( $depth < $blockquote_depth ) {
$c->unshiftline;
last;
}
}
# parse other block nodes
my $block_parsers = $self->_get_matched_parsers('block', $l);
for my $parser ( @{$block_parsers} ){
$l = $parser->parse($l);
}
# parse inline nodes
my $inline_parsers = $self->_get_matched_parsers('inline', $l) if $l;
for my $parser ( @{$inline_parsers} ){
$l = $parser->parse($l);
}
$c->htmllines($l);
}
if ( @{$c->in_block_of} and $c->in_block_of->[-1] eq 'blockquote' ) {
pop @{$c->in_block_of};
$c->htmllines('
');
}
return $l;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Context.pm 0000755 0001750 0001750 00000002732 10761015565 020325 0 ustar nacho nacho package Text::Trac::Context;
use strict;
use base qw (Class::Accessor::Fast);
__PACKAGE__->mk_accessors( qw( ul ol min_heading_level permalink in_block_of trac_url ) );
my %Defaults = (
text => '',
html => '',
htmllines => [],
ul => {},
ol => {},
shift_count => 0,
in_block_of => [],
disable_links => [],
enable_links => [],
);
sub new {
my ( $class, $args ) = @_;
my $self = {
%Defaults,
%$args,
};
bless $self, $class;
$self->init;
return $self;
}
sub init {
my $self = shift;
$self->{text} =~ s/\r//g;
@{$self->{lines}} = split('\n', $self->{text});
$self->{index} = -1;
$self->{htmllines} = [];
}
sub hasnext {
my $self = shift;
defined ($self->{lines}->[$self->{index} + 1]);
}
sub nextline {
my $self = shift;
$self->{lines}->[$self->{index} + 1];
}
sub shiftline {
my $self = shift;
$self->{lines}->[++$self->{index}];
}
sub unshiftline {
my $self = shift;
$self->{lines}->[--$self->{index}];
}
sub currentline {
my $self = shift;
$self->{lines}->[$self->{index}];
}
sub html {
my $self = shift;
join ("\n", @{$self->{htmllines}});
}
sub htmllines {
my $self = shift;
push @{$self->{htmllines}}, $_[0] if defined $_[0];
$self->{htmllines};
}
sub lasthtmlline { $_[0]->{htmllines}->[-1]; }
sub list_level {
my $self = shift;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/BlockNode.pm 0000755 0001750 0001750 00000005047 11043511657 020540 0 ustar nacho nacho package Text::Trac::BlockNode;
use strict;
use base qw( Class::Accessor::Fast Class::Data::Inheritable );
use UNIVERSAL::require;
use Text::Trac::InlineNode;
__PACKAGE__->mk_classdata(
block_nodes => [ qw( heading hr p ul ol blockquote pre table dl ) ]
);
#__PACKAGE__->mk_classdata(
# inline_nodes => [ qw( bold_italic bold italic underline monospace strike sup sub br
# auto_link_http macro trac_links ) ]
#);
__PACKAGE__->mk_classdata(
block_parsers => []
);
__PACKAGE__->mk_classdata(
inline_parsers => []
);
__PACKAGE__->mk_accessors( qw( context pattern inline_parser ) );
sub new {
my ( $class, $params ) = @_;
my $self = {
%$params,
};
bless $self, $class;
$self->init;
$self->inline_parser( Text::Trac::InlineNode->new($self->context));
return $self;
}
sub init {
my $self = shift;
return $self;
}
sub parse {
my $self = shift;
my $c = $self->context;
$self->block_parsers( $self->_get_parsers('block') );
#$self->inline_parsers( $self->_get_parsers('inline') );
while ( defined ( my $l = $c->shiftline ) ) {
next if $l =~ /^$/;
for my $parser ( @{ $self->_get_matched_parsers('block', $l) } ){
$parser->parse($l);
}
}
}
sub escape {
my ( $self, $l ) = @_;
return $self->inline_parser->escape($l);
}
sub replace {
my ( $self, $l ) = @_;
return $self->inline_parser->parse($l);
}
sub _get_parsers {
my ( $self, $type ) = @_;
$type .= '_nodes';
my @parsers;
for ( @{ $self->$type } ){
my $class = 'Text::Trac::' . $self->_camelize($_);
$class->require;
push @parsers, $class->new({ context => $self->context });
}
return \@parsers;
}
sub _get_matched_parsers {
my ( $self, $type, $l ) = @_;
my $c = $self->context;
$type .= '_parsers';
my @matched_parsers;
for my $parser ( @{ $self->$type } ){
next if ( grep { ref($parser) eq 'Text::Trac::'. $self->_camelize($_) } @{$c->in_block_of}
and $type =~ /^block/ );
my $pattern = $parser->pattern or next;
if ($l =~ /$pattern/) {
push @matched_parsers, $parser;
}
}
push @matched_parsers, Text::Trac::P->new({ context => $self->context })
if( !@matched_parsers and $type =~ /^block/ );
return \@matched_parsers;
}
sub _camelize {
my ( $self, $word ) = @_;
my $camelized_word;
for ( split '_', $word ){
chomp($_);
$camelized_word .= ucfirst($_);
}
return $camelized_word;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Text.pm 0000755 0001750 0001750 00000000535 10761015565 017624 0 ustar nacho nacho package Text::Trac::Text;
use strict;
sub new {
my $class = shift;
my %args = @_;
my $self = {
context => $args{context},
html => '',
};
bless $self,$class;
}
sub parse {
my $self = shift;
$self->{html} = '';
my $text = shift or return;
$self->{html} = $text;
}
sub html { $_[0]->{html}; }
1;
libtext-trac-perl-0.15/lib/Text/Trac/Heading.pm 0000755 0001750 0001750 00000001046 10763545530 020237 0 ustar nacho nacho package Text::Trac::Heading;
use strict;
use base qw(Text::Trac::BlockNode);
sub init {
my $self = shift;
$self->pattern(qr/^(=+) \s (.*) \s (=+)$/xms);
}
sub parse {
my ( $self, $l ) = @_;
my $c = $self->context;
$l =~ $self->pattern or return;
my $level = length($1) + $c->min_heading_level -1;
my $id = $self->_strip( $2 );
$l = qq() . $self->replace($2) . qq();
$c->htmllines($l);
}
sub _strip {
my ( $self, $word ) = @_;
$word =~ s/[\s,_`'{}!]//g;
return $word;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Node.pm 0000755 0001750 0001750 00000000506 10761015565 017563 0 ustar nacho nacho package Text::Trac::Node;
use strict;
use base qw( Class::Accessor::Fast );
sub init {
my $self = shift;
$self->{pattern} = '';
}
sub parse { die; }
sub html { $_[0]->{html}; }
sub pattern { $_[0]->{pattern}; }
sub context {
my $self = shift;
$self->{context} = $_[0] if $_[0];
$self->{context};
}
1;
libtext-trac-perl-0.15/lib/Text/Trac/Macro.pm 0000755 0001750 0001750 00000001261 10761015565 017736 0 ustar nacho nacho package Text::Trac::Macro;
use strict;
use base qw(Text::Trac::InlineNode Class::Accessor::Fast);
use UNIVERSAL::require;
use Text::ParseWords qw(quotewords);
__PACKAGE__->mk_accessors( 'pattern' );
sub new {
my $class = shift;
my $self = {};
bless $self, $class;
return $self;
}
sub parse {
my ( $self, $name, $args, $match ) = @_;
my $c = $self->{context};
my @args = quotewords( ',\s*', 0, $args ) if $args;
map { s/^\s+|\s+$//g } @args;
foreach my $class ("Text::Trac::Macro::$name", $name) {
if ( $class->require ) {
$match = $class->process( $c, @args ) || '';
last;
}
}
return $match;
}
1;
libtext-trac-perl-0.15/lib/Text/Trac.pm 0000755 0001750 0001750 00000007065 11154652724 016706 0 ustar nacho nacho package Text::Trac;
use strict;
use Text::Trac::Context;
use Text::Trac::BlockNode;
our $VERSION = '0.15';
my %Defaults = (
html => '',
permalink => '',
min_heading_level => 1,
);
sub new {
my ( $class, %args ) = @_;
my $self = {
%Defaults,
%args,
};
bless $self, $class;
}
sub parse {
my $self = shift;
my $text = shift or return;
$self->{trac_url} = '/' unless defined $self->{trac_url};
for ( keys %$self ) {
if ( $_ =~ /^trac.+url$/ ) {
$self->{$_} .= '/' if $self->{$_} !~ m!/$!;
}
}
my $c = Text::Trac::Context->new({
%$self,
text => $text,
});
my $node = Text::Trac::BlockNode->new({
context => $c,
});
$node->parse;
$self->{html} = $c->html;
}
sub html { $_[0]->{html}; }
*process = \&parse;
1;
__END__
=head1 NAME
Text::Trac - Perl extension for formatting text with Trac Wiki Style.
=head1 VERSION
Version 0.12
=head1 SYNOPSIS
use Text::Trac;
my $parser = Text::Trac->new(
trac_url => 'http://trac.mizzy.org/public/',
disable_links => [ qw( changeset ticket ) ],
);
$parser->parse($text);
print $parser->html;
=head1 DESCRIPTION
Text::Trac parses text with Trac WikiFormatting and convert it to html format.
=head1 METHODS
=head2 new
Constructs Text::Trac object.
Available arguments are:
=head3 trac_url
Base URL for TracLinks.Default is /. You can specify each type of URL individually.
Available URLs are:
=over
=item trac_attachment_url
=item trac_changeset_url
=item trac_log_url
=item trac_milestone_url
=item trac_report_url
=item trac_source_url
=item trac_ticket_url
=item trac_wiki_url
=back
=head3 disable_links
Specify TracLink types you want to disable.
All types are enabled if you don't specify this option.
my $parser = Text::Trac->new(
disable_links => [ qw( changeset ticket ) ],
);
=head3 enable_links
Specify TracLink types you want to enable.Other types are disabled.
You cannot use both disable_links and enable_links at once.
my $parser = Text::Trac->new(
enable_links => [ qw( changeset ticket ) ],
);
=head2 parse
Parses text and converts it to html format.
=head2 process
An alias of parse method.
=head2 html
Return converted html string.
=head1 SEE ALSO
=over 3
=item L
=item Trac L
=item Trac WikiFormatting L
=back
=head1 AUTHORS
Gosuke Miyashita, C<< >>
Hideaki Tanaka, C<< >>
=head1 BUGS
Please report any bugs or feature requests to
C, or through the web interface at
L.
I will be notified, and then you'll automatically be notified of progress on
your bug as I make changes.
=head1 SUPPORT
You can find documentation for this module with the perldoc command.
perldoc Text::Trac
You can also look for information at:
=over 4
=item * AnnoCPAN: Annotated CPAN documentation
L
=item * CPAN Ratings
L
=item * RT: CPAN's request tracker
L
=item * Search CPAN
L
=back
=head1 COPYRIGHT & LICENSE
Copyright 2006 Gosuke Miyashita, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
=cut
libtext-trac-perl-0.15/README 0000644 0001750 0001750 00000001430 10761015566 014630 0 ustar nacho nacho Text-Trac
INSTALLATION
To install this module, run the following commands:
perl Makefile.PL
make
make test
make install
SUPPORT AND DOCUMENTATION
After installing, you can find documentation for this module with the perldoc command.
perldoc Text::Trac
You can also look for information at:
Search CPAN
http://search.cpan.org/dist/Text-Trac
CPAN Request Tracker:
http://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-Trac
AnnoCPAN, annotated CPAN documentation:
http://annocpan.org/dist/Text-Trac
CPAN Ratings:
http://cpanratings.perl.org/d/Text-Trac
COPYRIGHT AND LICENCE
Copyright (C) 2006 Gosuke Miyashita
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
libtext-trac-perl-0.15/Changes 0000644 0001750 0001750 00000003422 11154653057 015246 0 ustar nacho nacho Revision history for Text-Trac
0.15 Sun Mar 8
Fix for RT#43894.Updated Module::Install in this module.
Thanks for ANDK!
0.14 Mon Feb 23
Fix for RT#43337.Image URLs are not converted into
embedded images anymore.Thanks for cmcosse!
0.13 Tue Jul 29
Revert inline_parsers in Text::Trac::BlockNode.
Thanks for yappo!
0.12 Tue Apr 15
Support comment link.
See http://rt.cpan.org/Ticket/Display.html?id=34805.
Thanks for CLSUNG!
0.11 Thu Mar 6
Fix for http://rt.cpan.org/Ticket/Display.html?id=33670#txn-430322
Thanks for David Wheeler!
0.10 Fri Feb 29
Fix for http://rt.cpan.org/Ticket/Display.html?id=33670
Thanks for David Wheeler!
0.09 Thu Feb 28
Fix for http://rt.cpan.org/Ticket/Display.html?id=33575
and http://rt.cpan.org/Ticket/Display.html?id=33576.
Thanks for David Wheeler!
0.08 Tue Nov 20
Apply a patch of https://rt.cpan.org/Ticket/Display.html?id=30816.
Thanks to Kazuyoshi KATO!
0.07 Sun Mar 25
Tiny fix for Ul.pm and Ol.pm
0.06 Wed Nov 9
Fix list handling(Ul.pm and Ol.pm).
Refactor inline node parsers wholly.
Add supports for TracLinks and WikiMacros.
0.05 Fri Oct 27
Using Test::Base instead of Test::More in 01-text-trac.t.
Fix the bug reported on rt.cpan.org ticket #21431.
http://rt.cpan.org/Ticket/Display.html?id=21431
Thanks to Andrew Sterling Hanenkamp and Graham TerMarsch.
0.04 Wed Jul 19
Fix autolink handling, again.
0.03 Wed Jul 19
Fix autolink handling.
0.02 Tue Jun 20
Fix the link pattern of AutoLinkHttp.pm.
0.01 Tue Jun 20
First version, released on an unsuspecting world.
libtext-trac-perl-0.15/Makefile.PL 0000644 0001750 0001750 00000000555 10761015565 015730 0 ustar nacho nacho use inc::Module::Install;
name('Text-Trac');
all_from('lib/Text/Trac.pm');
requires('Test::Base');
requires('UNIVERSAL::require');
requires('Class::Accessor::Fast');
requires('Class::Data::Inheritable');
requires('Tie::IxHash');
requires('List::MoreUtils');
requires('HTML::Entities');
no_index( package => 'TestMacro' );
auto_include;
auto_install;
WriteAll;
libtext-trac-perl-0.15/META.yml 0000644 0001750 0001750 00000001164 11154653260 015221 0 ustar nacho nacho ---
abstract: 'Perl extension for formatting text with Trac Wiki Style.'
author:
- 'Gosuke Miyashita, C<< >>'
distribution_type: module
generated_by: 'Module::Install version 0.79'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: Text-Trac
no_index:
directory:
- inc
- t
package:
- TestMacro
requires:
Class::Accessor::Fast: 0
Class::Data::Inheritable: 0
HTML::Entities: 0
List::MoreUtils: 0
Test::Base: 0
Tie::IxHash: 0
UNIVERSAL::require: 0
resources:
license: http://dev.perl.org/licenses/
version: 0.15
libtext-trac-perl-0.15/MANIFEST 0000644 0001750 0001750 00000002551 11001133455 015070 0 ustar nacho nacho Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/Text/Trac.pm
lib/Text/Trac/BlockNode.pm
lib/Text/Trac/Blockquote.pm
lib/Text/Trac/Context.pm
lib/Text/Trac/Dl.pm
lib/Text/Trac/Heading.pm
lib/Text/Trac/Hr.pm
lib/Text/Trac/InlineNode.pm
lib/Text/Trac/LinkResolver.pm
lib/Text/Trac/LinkResolver/Attachment.pm
lib/Text/Trac/LinkResolver/Changeset.pm
lib/Text/Trac/LinkResolver/Comment.pm
lib/Text/Trac/LinkResolver/Log.pm
lib/Text/Trac/LinkResolver/Milestone.pm
lib/Text/Trac/LinkResolver/Report.pm
lib/Text/Trac/LinkResolver/Source.pm
lib/Text/Trac/LinkResolver/Ticket.pm
lib/Text/Trac/LinkResolver/Wiki.pm
lib/Text/Trac/Macro.pm
lib/Text/Trac/Macro/HelloWorld.pm
lib/Text/Trac/Macro/Timestamp.pm
lib/Text/Trac/Node.pm
lib/Text/Trac/Ol.pm
lib/Text/Trac/P.pm
lib/Text/Trac/Pre.pm
lib/Text/Trac/Table.pm
lib/Text/Trac/Text.pm
lib/Text/Trac/Ul.pm
Makefile.PL
MANIFEST This list of files
META.yml
README
t/00-load.t
t/01-text-trac.t
t/02-macros.t
t/03-trac-links.t
t/04-list.t
t/05-disable_links.t
t/06-enable_links.t
t/07-custom_url.t
t/08-regression.t
t/boilerplate.t
t/pod-coverage.t
t/pod.t
t/TestTextTrac.pm
