[Bps-public-commit] HTML-Quoted branch, master, updated. c342e560551f4a857dc827df2bd2ab86fecdad31
Ruslan Zakirov
ruz at bestpractical.com
Sat Jan 8 23:56:36 EST 2011
The branch, master has been updated
via c342e560551f4a857dc827df2bd2ab86fecdad31 (commit)
via 7a93c55d124d66eed3645601f93571af9175d0ba (commit)
via 8c42d0232807f3a0c8358a4a1384460970fb5e09 (commit)
via 82de6833e735e01f45396e19a2aa1ede35236148 (commit)
via 9c4206de99138a876d23c94008d24d9102cf1447 (commit)
via affa6e77696b1c20f0a86399ff3d5459b29662f1 (commit)
via 6ac48d3d789a2c1011b175f8d0a13cfb4142aeba (commit)
via a29361e99813f2a5d2c39de59538d9a7c6b52d02 (commit)
via 2b938d63cb3ecffb525c23cce58eadcf1547c1ed (commit)
via a818712b63ce6b5dde5925ed288f519594f6de69 (commit)
via 3664de54c13cae0d8f98ef022f1d98506c5d7a24 (commit)
from edec1939d5d91ed48a86793502904f2b1d5b2cb5 (commit)
Summary of changes:
Changes | 7 +
MANIFEST | 1 +
META.yml | 2 +-
README | 51 ++++++++-
inc/Module/Install.pm | 183 ++++++++++++++++------------
inc/Module/Install/Base.pm | 11 ++-
inc/Module/Install/Can.pm | 2 +-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Makefile.pm | 179 ++++++++++++++++++++++-----
inc/Module/Install/Metadata.pm | 232 ++++++++++++++++++++++------------
inc/Module/Install/ReadmeFromPod.pm | 34 ++++--
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 7 +-
lib/HTML/Quoted.pm | 103 +++++++++++++---
t/blockquote.t | 68 ++++++++++
15 files changed, 651 insertions(+), 233 deletions(-)
create mode 100644 t/blockquote.t
- Log -----------------------------------------------------------------
commit 3664de54c13cae0d8f98ef022f1d98506c5d7a24
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 05:01:53 2011 +0300
<p> treated as inline, however, </p> should end line
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index e8cd18c..ef17119 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -194,6 +194,9 @@ sub handle_end {
$meta->{'in'}{'br'} = 0;
push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
}
+ elsif ( $tag eq 'p' ) {
+ push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
+ }
elsif ( !$INLINE_TAG{ $tag } ) {
$meta->{'in'}{'block'}[-1]--;
push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
commit a818712b63ce6b5dde5925ed288f519594f6de69
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 05:21:38 2011 +0300
minor refactoring
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index ef17119..59c9dea 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -130,20 +130,22 @@ sub handle_start {
my ($self, $tag, $attr, $attrseq, $text) = @_;
my $meta = $self->{'html_quoted_parser'};
+ my $stack = $meta->{'stack'};
+
if ( $meta->{'in'}{'br'} ) {
$meta->{'in'}{'br'} = 0;
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {};
+ push @{ $stack->[-1] }, $meta->{'current'} = {};
}
if ( $tag eq 'blockquote' ) {
my $new = [{ quote => 1, block => 1 }];
- push @{ $meta->{'stack'}[-1] }, $new;
- push @{ $meta->{'stack'} }, $new;
+ push @{ $stack->[-1] }, $new;
+ push @$stack, $new;
$meta->{'current'} = $new->[0];
$meta->{'in'}{'quote'}++;
push @{ $meta->{'in'}{'block'} }, 0;
$meta->{'current'}{'raw'} .= $text;
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {};
+ push @{ $stack->[-1] }, $meta->{'current'} = {};
}
elsif ( $tag eq 'br' && !$meta->{'in'}{'block'}[-1] ) {
$meta->{'current'}{'raw'} .= $text;
@@ -159,7 +161,7 @@ sub handle_start {
elsif ( !$INLINE_TAG{ $tag } ) {
if ( !$meta->{'in'}{'block'}[-1] ) {
if ( keys %{ $meta->{'current'} } ) {
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'}
+ push @{ $stack->[-1] }, $meta->{'current'}
= { block => 1, raw => '' };
} else {
$meta->{'current'}{'block'} = 1;
@@ -177,29 +179,30 @@ sub handle_end {
my ($self, $tag, $text) = @_;
my $meta = $self->{'html_quoted_parser'};
+ my $stack = $meta->{'stack'};
if ( $meta->{'in'}{'br'} && $tag ne 'br' ) {
$meta->{'in'}{'br'} = 0;
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
+ push @{ $stack->[-1] }, $meta->{'current'} = {}
}
$meta->{'current'}{'raw'} .= $text;
if ( $tag eq 'blockquote' ) {
- pop @{ $meta->{'stack'} };
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = { quote => 1 };
+ pop @$stack;
+ push @{ $stack->[-1] }, $meta->{'current'} = { quote => 1 };
$meta->{'in'}{'quote'}--;
}
elsif ( $tag eq 'br' ) {
$meta->{'in'}{'br'} = 0;
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
+ push @{ $stack->[-1] }, $meta->{'current'} = {}
}
elsif ( $tag eq 'p' ) {
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
+ push @{ $stack->[-1] }, $meta->{'current'} = {}
}
elsif ( !$INLINE_TAG{ $tag } ) {
$meta->{'in'}{'block'}[-1]--;
- push @{ $meta->{'stack'}[-1] }, $meta->{'current'} = {}
+ push @{ $stack->[-1] }, $meta->{'current'} = {}
unless $meta->{'in'}{'block'}[-1];
}
}
commit 2b938d63cb3ecffb525c23cce58eadcf1547c1ed
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 05:21:55 2011 +0300
update M::I
diff --git a/META.yml b/META.yml
index 0786294..b6c0b08 100644
--- a/META.yml
+++ b/META.yml
@@ -7,7 +7,7 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.92'
+generated_by: 'Module::Install version 1.00'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index aceb4de..8ee839d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -19,6 +19,9 @@ package Module::Install;
use 5.005;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
use vars qw{$VERSION $MAIN};
BEGIN {
@@ -28,7 +31,7 @@ BEGIN {
# 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.92';
+ $VERSION = '1.00';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -38,18 +41,25 @@ BEGIN {
}
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
-
-
-
-# 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" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # 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:
@@ -61,26 +71,28 @@ not:
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 ) {
- my $s = (stat($0))[9];
-
- # If the modification time is only slightly in the future,
- # sleep briefly to remove the problem.
- my $a = $s - time;
- if ( $a > 0 and $a < 5 ) { sleep 5 }
-
- # Too far in the future, throw an error.
- my $t = time;
- if ( $s > $t ) { die <<"END_DIE" }
+ # This reportedly fixes a rare Win32 UTC file time issue, but
+ # as this is a non-cross-platform XS module not in the core,
+ # we shouldn't really depend on it. See RT #24194 for detail.
+ # (Also, this module only supports Perl 5.6 and above).
+ eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006;
+
+ # 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 ) {
+ my $s = (stat($0))[9];
+
+ # If the modification time is only slightly in the future,
+ # sleep briefly to remove the problem.
+ my $a = $s - time;
+ if ( $a > 0 and $a < 5 ) { sleep 5 }
+
+ # Too far in the future, throw an error.
+ my $t = time;
+ if ( $s > $t ) { die <<"END_DIE" }
Your installer $0 has a modification time in the future ($s > $t).
@@ -89,15 +101,12 @@ 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" }
+ # 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.
@@ -107,23 +116,42 @@ 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));
+ #-------------------------------------------------------------
+ unless ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
+ }
-# 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));
-
+ local $^W;
+ 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"};
+ }
+ local $^W;
+ *{"${who}::AUTOLOAD"} = $self->autoload;
+ $self->preload;
+ # Unregister loader and worker packages so subdirs can use them again
+ delete $INC{'inc/Module/Install.pm'};
+ delete $INC{'Module/Install.pm'};
+ # Save to the singleton
+ $MAIN = $self;
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
+ return 1;
+}
sub autoload {
my $self = shift;
@@ -136,7 +164,21 @@ sub autoload {
# Delegate back to parent dirs
goto &$code unless $cwd eq $pwd;
}
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
my $method = $1;
if ( uc($method) eq $method ) {
# Do nothing
@@ -152,33 +194,6 @@ sub autoload {
};
}
-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"};
-
- # Save to the singleton
- $MAIN = $self;
-
- return 1;
-}
-
sub preload {
my $self = shift;
unless ( $self->{extensions} ) {
@@ -204,6 +219,7 @@ sub preload {
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
+ local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
@@ -214,12 +230,18 @@ sub preload {
sub new {
my ($class, %args) = @_;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
# 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';
@@ -272,8 +294,10 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
+ my $should_reload = 0;
unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) {
unshift @INC, $self->{prefix};
+ $should_reload = 1;
}
foreach my $rv ( $self->find_extensions($path) ) {
@@ -281,12 +305,13 @@ sub load_extensions {
next if $self->{pathnames}{$pkg};
local $@;
- my $new = eval { require $file; $pkg->can('new') };
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
- $self->{pathnames}{$pkg} = delete $INC{$file};
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 618bf57..b55bda3 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
}
# Suspend handler for "redefined" warnings
@@ -51,13 +51,18 @@ sub admin {
#line 106
sub is_admin {
- $_[0]->admin->VERSION;
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
my $fake;
sub new {
@@ -75,4 +80,4 @@ BEGIN {
1;
-#line 154
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 75b8a27..71ccc27 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -9,7 +9,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index e3d6800..ec1f106 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index acf10ef..5dfd0e9 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -4,10 +4,11 @@ package Module::Install::Makefile;
use strict 'vars';
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -25,8 +26,8 @@ sub prompt {
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} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -45,10 +46,90 @@ sub makemaker {
( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
}
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
@@ -58,8 +139,8 @@ sub makemaker_append {
my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -100,25 +181,22 @@ sub inc {
$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 = ();
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
- File::Find::find( \&_wanted_t, $dir );
- $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
}
sub write {
@@ -155,17 +233,36 @@ sub write {
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ $DB::single = 1;
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
}
if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
if ( $self->makemaker(6.10) ) {
- $args->{NO_META} = 1;
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
}
if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
@@ -173,6 +270,9 @@ sub write {
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
@@ -197,13 +297,22 @@ sub write {
# Remove any reference to perl, BUILD_REQUIRES doesn't support it
delete $args->{BUILD_REQUIRES}->{perl};
- # Delete bundled dists from prereq_pm
- my $subdirs = ($args->{DIR} ||= []);
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
+ my %processed;
foreach my $bundle (@{ $self->bundles }) {
- my ($file, $dir) = @$bundle;
- push @$subdirs, $dir if -d $dir;
- delete $build_prereq->{$file}; #Delete from build prereqs only
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
}
}
@@ -222,12 +331,17 @@ sub write {
}
}
- $args->{INSTALLDIRS} = $self->installdirs;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
+ if ( my $preop = $self->admin->preop($user_preop) ) {
foreach my $key ( keys %$preop ) {
$args{dist}->{$key} = $preop->{$key};
}
@@ -251,9 +365,9 @@ sub fix_up_makefile {
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -273,7 +387,8 @@ sub fix_up_makefile {
# 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: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -297,4 +412,4 @@ sub postamble {
__END__
-#line 426
+#line 541
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index b00e6b1..cfe45b3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -19,7 +19,6 @@ my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -43,8 +42,11 @@ my @resource_keys = qw{
my @array_keys = qw{
keywords
+ author
};
+*authors = \&author;
+
sub Meta { shift }
sub Meta_BooleanKeys { @boolean_keys }
sub Meta_ScalarKeys { @scalar_keys }
@@ -176,43 +178,6 @@ sub perl_version {
$self->{values}->{perl_version} = $version;
}
-#Stolen from M::B
-my %license_urls = (
- perl => 'http://dev.perl.org/licenses/',
- apache => 'http://apache.org/licenses/LICENSE-2.0',
- artistic => 'http://opensource.org/licenses/artistic-license.php',
- artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
- lgpl => 'http://opensource.org/licenses/lgpl-license.php',
- lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
- lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
- bsd => 'http://opensource.org/licenses/bsd-license.php',
- gpl => 'http://opensource.org/licenses/gpl-license.php',
- gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
- gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
- mit => 'http://opensource.org/licenses/mit-license.php',
- mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
- open_source => undef,
- unrestricted => undef,
- restrictive => undef,
- unknown => undef,
-);
-
-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_urls{$license} ) {
- $self->resources( license => $license_urls{$license} );
- }
-
- return 1;
-}
-
sub all_from {
my ( $self, $file ) = @_;
@@ -230,7 +195,7 @@ sub all_from {
die("The path '$file' does not exist, or is not a file");
}
- $self->{values}{all_from} = $file;
+ $self->{values}{all_from} = $file;
# Some methods pull from POD instead of code.
# If there is a matching .pod, use that instead
@@ -242,7 +207,7 @@ sub all_from {
$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->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -352,6 +317,9 @@ sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
@@ -362,7 +330,7 @@ sub abstract_from {
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
- );
+ );
}
# Add both distribution and module name
@@ -428,53 +396,146 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
sub _extract_license {
- if (
- $_[0] =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyrights?|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as (?:perl|the perl programming language)' => 'perl', 1,
- 'under the terms of (?:perl|the perl programming language) 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+#gs;
- if ( $license_text =~ /\b$pattern\b/i ) {
- return $license;
- }
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => '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,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
}
- } else {
- return;
}
+ return '';
}
sub license_from {
@@ -555,8 +616,15 @@ sub _perl_version {
return $v;
}
-
-
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
######################################################################
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index 41222fa..348531e 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -1,36 +1,48 @@
#line 1
package Module::Install::ReadmeFromPod;
+use 5.006;
use strict;
use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.06';
+$VERSION = '0.12';
sub readme_from {
my $self = shift;
- return unless $Module::Install::AUTHOR;
- my $file = shift || return;
+ return unless $self->is_admin;
+
+ my $file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
my $clean = shift;
+
+ print "Writing README from $file\n";
+
require Pod::Text;
my $parser = Pod::Text->new();
open README, '> README' or die "$!\n";
$parser->output_fh( *README );
$parser->parse_file( $file );
- return 1 unless $clean;
- $self->postamble(<<"END");
-distclean :: license_clean
-
-license_clean:
-\t\$(RM_F) README
-END
+ if ($clean) {
+ $self->clean_files('README');
+ }
return 1;
}
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
+}
+
'Readme!';
__END__
-#line 89
+#line 112
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 89f16f0..edc18b4 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index af3ea05..d0f6599 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.92';;
+ $VERSION = '1.00';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -26,7 +26,10 @@ sub WriteAll {
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
# Until ExtUtils::MakeMaker support MYMETA.yml, make sure
commit a29361e99813f2a5d2c39de59538d9a7c6b52d02
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:01:30 2011 +0300
comment tricky code
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index 59c9dea..967b504 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -140,7 +140,7 @@ sub handle_start {
if ( $tag eq 'blockquote' ) {
my $new = [{ quote => 1, block => 1 }];
push @{ $stack->[-1] }, $new;
- push @$stack, $new;
+ push @$stack, $new; # HACK: everything pushed into this
$meta->{'current'} = $new->[0];
$meta->{'in'}{'quote'}++;
push @{ $meta->{'in'}{'block'} }, 0;
commit 6ac48d3d789a2c1011b175f8d0a13cfb4142aeba
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:02:11 2011 +0300
mark current as block in any case, as we open a block
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index 967b504..dc22d6d 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -159,16 +159,13 @@ sub handle_start {
$meta->{'in'}{'br'} = 1;
}
elsif ( !$INLINE_TAG{ $tag } ) {
- if ( !$meta->{'in'}{'block'}[-1] ) {
- if ( keys %{ $meta->{'current'} } ) {
- push @{ $stack->[-1] }, $meta->{'current'}
- = { block => 1, raw => '' };
- } else {
- $meta->{'current'}{'block'} = 1;
- }
+ if ( !$meta->{'in'}{'block'}[-1] && keys %{ $meta->{'current'} } ) {
+ push @{ $stack->[-1] }, $meta->{'current'} = { raw => '' };
}
- $meta->{'in'}{'block'}[-1]++;
+ $meta->{'current'}{'block'} = 1;
$meta->{'current'}{'raw'} .= $text;
+
+ $meta->{'in'}{'block'}[-1]++;
}
else {
$meta->{'current'}{'raw'} .= $text;
commit affa6e77696b1c20f0a86399ff3d5459b29662f1
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:03:00 2011 +0300
we are not in quote when blockquote closes
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index dc22d6d..a2a784b 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -187,7 +187,7 @@ sub handle_end {
if ( $tag eq 'blockquote' ) {
pop @$stack;
- push @{ $stack->[-1] }, $meta->{'current'} = { quote => 1 };
+ push @{ $stack->[-1] }, $meta->{'current'} = {};
$meta->{'in'}{'quote'}--;
}
elsif ( $tag eq 'br' ) {
commit 9c4206de99138a876d23c94008d24d9102cf1447
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:03:42 2011 +0300
when block is closed mark part we close as block
it's possible that block is not set here, for example:
<div>
<blockquote>...<blockquote/>
<xxx></xxx>
</div>
The last part goes in one stanza and should be marked
as block.
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index a2a784b..117229c 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -199,8 +199,11 @@ sub handle_end {
}
elsif ( !$INLINE_TAG{ $tag } ) {
$meta->{'in'}{'block'}[-1]--;
- push @{ $stack->[-1] }, $meta->{'current'} = {}
- unless $meta->{'in'}{'block'}[-1];
+ if ( $meta->{'in'}{'block'}[-1] ) {
+ $meta->{'current'}{'block'} = 1;
+ } else {
+ push @{ $stack->[-1] }, $meta->{'current'} = {};
+ }
}
}
commit 82de6833e735e01f45396e19a2aa1ede35236148
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:08:05 2011 +0300
blockquote should control block counters
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index 117229c..5f04aa9 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -187,6 +187,7 @@ sub handle_end {
if ( $tag eq 'blockquote' ) {
pop @$stack;
+ pop @{ $meta->{'in'}{'block'} };
push @{ $stack->[-1] }, $meta->{'current'} = {};
$meta->{'in'}{'quote'}--;
}
commit 8c42d0232807f3a0c8358a4a1384460970fb5e09
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:52:49 2011 +0300
add documentation
diff --git a/README b/README
index ce1cd06..a371b7c 100644
--- a/README
+++ b/README
@@ -1,8 +1,57 @@
NAME
HTML::Quoted - extract structure of quoted HTML mail message
+SYNOPSIS
+ use HTML::Quoted;
+ my $html = '...';
+ my $struct = HTML::Quoted->extract( $html );
+
DESCRIPTION
- No description, yet. Very experimental. See also Text::Quoted.
+ Parses and extracts quotation structure out of a HTML message. Purpose
+ and returned structures are very similar to Text::Quoted.
+
+SUPPORTED FORMATS
+ Variouse MUAs use quite different approaches for quoting in mails.
+
+ Some use *blockquote* tag and it's quite easy to parse.
+
+ Some wrap text into *p* tags and add '>' in the beginning of the
+ paragraphs.
+
+ Things gettign messier when it's an HTML reply on plain text mail
+ thread.
+
+ If you found format that is not supported then file a bug report via
+ rt.cpan.org with as short as possible example. Test file is even better.
+ Test file with patch is the best. Not obviouse patches without tests
+ suck.
+
+METHODS
+ extract
+ my $struct = HTML::Quoted->extract( $html );
+
+ Takes a string with HTML and returns array reference. Each element in
+ the array either array or hash. For example:
+
+ [
+ { 'raw' => 'Hi,' },
+ { 'raw' => '<div><br><div>On date X wrote:<br>' },
+ [
+ { 'raw' => '<blockquote>' },
+ { 'raw' => 'Hello,' },
+ { 'raw' => '<div>How are you?</div>' },
+ { 'raw' => '</blockquote>' }
+ ],
+ ...
+ ]
+
+ Hashes represent a part of the html. The following keys are meaningful
+ at the moment:
+
+ * raw - raw HTML
+
+ * quoter_raw, quoter - raw and decoded (entities are converted) quoter
+ if block is prefixed with quoting characters
AUTHOR
Ruslan.Zakirov <ruz at bestpractical.com>
diff --git a/lib/HTML/Quoted.pm b/lib/HTML/Quoted.pm
index 5f04aa9..09b248c 100644
--- a/lib/HTML/Quoted.pm
+++ b/lib/HTML/Quoted.pm
@@ -10,9 +10,67 @@ our $VERSION = '0.02';
HTML::Quoted - extract structure of quoted HTML mail message
+=head1 SYNOPSIS
+
+ use HTML::Quoted;
+ my $html = '...';
+ my $struct = HTML::Quoted->extract( $html );
+
=head1 DESCRIPTION
-No description, yet. Very experimental. See also L<Text::Quoted>.
+Parses and extracts quotation structure out of a HTML message.
+Purpose and returned structures are very similar to
+L<Text::Quoted>.
+
+=head1 SUPPORTED FORMATS
+
+Variouse MUAs use quite different approaches for quoting in mails.
+
+Some use I<blockquote> tag and it's quite easy to parse.
+
+Some wrap text into I<p> tags and add '>' in the beginning of the
+paragraphs.
+
+Things gettign messier when it's an HTML reply on plain text mail
+thread.
+
+If B<you found format> that is not supported then file a bug report
+via rt.cpan.org with as short as possible example. B<Test file>
+is even better. Test file with patch is the best. Not obviouse patches
+without tests suck.
+
+=head1 METHODS
+
+=head2 extract
+
+ my $struct = HTML::Quoted->extract( $html );
+
+Takes a string with HTML and returns array reference. Each element
+in the array either array or hash. For example:
+
+
+ [
+ { 'raw' => 'Hi,' },
+ { 'raw' => '<div><br><div>On date X wrote:<br>' },
+ [
+ { 'raw' => '<blockquote>' },
+ { 'raw' => 'Hello,' },
+ { 'raw' => '<div>How are you?</div>' },
+ { 'raw' => '</blockquote>' }
+ ],
+ ...
+ ]
+
+Hashes represent a part of the html. The following keys are
+meaningful at the moment:
+
+=over 4
+
+=item * raw - raw HTML
+
+=item * quoter_raw, quoter - raw and decoded (entities are converted) quoter if block is prefixed with quoting characters
+
+=back
=cut
commit 7a93c55d124d66eed3645601f93571af9175d0ba
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:53:07 2011 +0300
test quoting with blockquotes
diff --git a/MANIFEST b/MANIFEST
index 59e45d1..0ec4ec0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -13,5 +13,6 @@ Makefile.PL
MANIFEST This list of files
META.yml
README
+t/blockquote.t
t/blocks.t
t/lines.t
diff --git a/t/blockquote.t b/t/blockquote.t
new file mode 100644
index 0000000..d38c8f8
--- /dev/null
+++ b/t/blockquote.t
@@ -0,0 +1,68 @@
+use strict;
+use warnings;
+
+use Test::More tests => 1;
+use HTML::Quoted;
+use Data::Dumper;
+
+sub check {
+ my ($html, $expected) = @_;
+ my $res = HTML::Quoted->extract($html);
+ is_deeply( $res, $expected, 'correct parsing')
+ or diag Dumper($res);
+}
+
+{
+ my $text = q{Hi,<div><br><div>On date X wrote:<br><blockquote>Hello,<div>How are you?</div></blockquote><div>I'm fine.</div><blockquote><div>Where have you been?</div></blockquote><div>Around.</div></div></div>};
+
+ my $res = [
+ {
+ 'raw' => 'Hi,'
+ },
+ {
+ 'block' => 1,
+ 'raw' => '<div><br><div>On date X wrote:<br>'
+ },
+ [
+ {
+ 'quote' => 1,
+ 'block' => 1,
+ 'raw' => '<blockquote>'
+ },
+ {
+ 'raw' => 'Hello,'
+ },
+ {
+ 'block' => 1,
+ 'raw' => '<div>How are you?</div>'
+ },
+ {
+ 'raw' => '</blockquote>'
+ }
+ ],
+ {
+ 'block' => 1,
+ 'raw' => '<div>I'm fine.</div>'
+ },
+ [
+ {
+ 'quote' => 1,
+ 'block' => 1,
+ 'raw' => '<blockquote>'
+ },
+ {
+ 'block' => 1,
+ 'raw' => '<div>Where have you been?</div>'
+ },
+ {
+ 'raw' => '</blockquote>'
+ }
+ ],
+ {
+ 'block' => 1,
+ 'raw' => '<div>Around.</div></div></div>'
+ }
+ ];
+
+ check( $text, $res );
+}
commit c342e560551f4a857dc827df2bd2ab86fecdad31
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Sun Jan 9 07:56:06 2011 +0300
update changelog
diff --git a/Changes b/Changes
index a324000..444b80d 100644
--- a/Changes
+++ b/Changes
@@ -1,3 +1,10 @@
+0.03 2011-01-09
+
+ * much more user friendlier documentation
+ * get rid of empty {} in the results
+ * fix mixed plain text quoting and blockquotes
+ * properly handle </p>
+
0.02 2010-02-27
* treat P tag as inline, for now
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list