Script 'mail_helper' called by obssrc
Hello community,
here is the log from the commit of package perl-PPIx-QuoteLike for
openSUSE:Factory checked in at 2021-02-15 23:14:41
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/perl-PPIx-QuoteLike (Old)
and /work/SRC/openSUSE:Factory/.perl-PPIx-QuoteLike.new.28504 (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-PPIx-QuoteLike"
Mon Feb 15 23:14:41 2021 rev:10 rq:871186 version:0.015
Changes:
--------
--- /work/SRC/openSUSE:Factory/perl-PPIx-QuoteLike/perl-PPIx-QuoteLike.changes
2021-01-20 18:29:13.795617030 +0100
+++
/work/SRC/openSUSE:Factory/.perl-PPIx-QuoteLike.new.28504/perl-PPIx-QuoteLike.changes
2021-02-15 23:16:53.811449267 +0100
@@ -1,0 +2,13 @@
+Sat Feb 6 03:07:26 UTC 2021 - Tina M??ller <timueller+p...@suse.de>
+
+- updated to 0.015
+ see /usr/share/doc/packages/perl-PPIx-QuoteLike/Changes
+
+ 0.015 2021-02-05 T. R. Wyant
+ Handle <<\EOD and <<~\EOD, which are equivalent to <<'EOD' and
+ <<~'EOD', respectively.
+
+ Recognize indented here documents. Thanks to Olaf Alders (oalders)
+ for alerting me to this omission.
+
+-------------------------------------------------------------------
Old:
----
PPIx-QuoteLike-0.014.tar.gz
New:
----
PPIx-QuoteLike-0.015.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ perl-PPIx-QuoteLike.spec ++++++
--- /var/tmp/diff_new_pack.CZ3iyn/_old 2021-02-15 23:16:54.435450199 +0100
+++ /var/tmp/diff_new_pack.CZ3iyn/_new 2021-02-15 23:16:54.439450205 +0100
@@ -18,7 +18,7 @@
%define cpan_name PPIx-QuoteLike
Name: perl-PPIx-QuoteLike
-Version: 0.014
+Version: 0.015
Release: 0
Summary: Parse Perl string literals and string-literal-like things
License: Artistic-1.0 OR GPL-1.0-or-later
@@ -43,6 +43,12 @@
like string literals. Its real reason for being is to find interpolated
variables for Perl::Critic policies and similar code.
+The parse is fairly straightforward, and a little poking around with
+_eg/pqldump_ should show how it normally goes.
+
+But there is at least one quote-like thing that probably needs some
+explanation.
+
%prep
%autosetup -n %{cpan_name}-%{version}
find . -type f ! -path "*/t/*" ! -name "*.pl" ! -path "*/bin/*" ! -path
"*/script/*" ! -name "configure" -print0 | xargs -0 chmod 644
++++++ PPIx-QuoteLike-0.014.tar.gz -> PPIx-QuoteLike-0.015.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/Changes
new/PPIx-QuoteLike-0.015/Changes
--- old/PPIx-QuoteLike-0.014/Changes 2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/Changes 2021-02-05 15:22:31.000000000 +0100
@@ -1,3 +1,10 @@
+0.015 2021-02-05 T. R. Wyant
+ Handle <<\EOD and <<~\EOD, which are equivalent to <<'EOD' and
+ <<~'EOD', respectively.
+
+ Recognize indented here documents. Thanks to Olaf Alders (oalders)
+ for alerting me to this omission.
+
0.014 2021-01-14 T. R. Wyant
Add Travis CI testing.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/META.json
new/PPIx-QuoteLike-0.015/META.json
--- old/PPIx-QuoteLike-0.014/META.json 2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/META.json 2021-02-05 15:22:31.000000000 +0100
@@ -48,51 +48,51 @@
"provides" : {
"PPIx::QuoteLike" : {
"file" : "lib/PPIx/QuoteLike.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Constant" : {
"file" : "lib/PPIx/QuoteLike/Constant.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Dumper" : {
"file" : "lib/PPIx/QuoteLike/Dumper.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token" : {
"file" : "lib/PPIx/QuoteLike/Token.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Control" : {
"file" : "lib/PPIx/QuoteLike/Token/Control.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Delimiter" : {
"file" : "lib/PPIx/QuoteLike/Token/Delimiter.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Interpolation" : {
"file" : "lib/PPIx/QuoteLike/Token/Interpolation.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::String" : {
"file" : "lib/PPIx/QuoteLike/Token/String.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Structure" : {
"file" : "lib/PPIx/QuoteLike/Token/Structure.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Unknown" : {
"file" : "lib/PPIx/QuoteLike/Token/Unknown.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Token::Whitespace" : {
"file" : "lib/PPIx/QuoteLike/Token/Whitespace.pm",
- "version" : "0.014"
+ "version" : "0.015"
},
"PPIx::QuoteLike::Utils" : {
"file" : "lib/PPIx/QuoteLike/Utils.pm",
- "version" : "0.014"
+ "version" : "0.015"
}
},
"release_status" : "stable",
@@ -110,6 +110,6 @@
"web" : "https://github.com/trwyant/perl-PPIx-QuoteLike";
}
},
- "version" : "0.014",
- "x_serialization_backend" : "JSON::PP version 4.05"
+ "version" : "0.015",
+ "x_serialization_backend" : "JSON::PP version 4.06"
}
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/META.yml
new/PPIx-QuoteLike-0.015/META.yml
--- old/PPIx-QuoteLike-0.014/META.yml 2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/META.yml 2021-02-05 15:22:31.000000000 +0100
@@ -19,40 +19,40 @@
provides:
PPIx::QuoteLike:
file: lib/PPIx/QuoteLike.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Constant:
file: lib/PPIx/QuoteLike/Constant.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Dumper:
file: lib/PPIx/QuoteLike/Dumper.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token:
file: lib/PPIx/QuoteLike/Token.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Control:
file: lib/PPIx/QuoteLike/Token/Control.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Delimiter:
file: lib/PPIx/QuoteLike/Token/Delimiter.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Interpolation:
file: lib/PPIx/QuoteLike/Token/Interpolation.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::String:
file: lib/PPIx/QuoteLike/Token/String.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Structure:
file: lib/PPIx/QuoteLike/Token/Structure.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Unknown:
file: lib/PPIx/QuoteLike/Token/Unknown.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Token::Whitespace:
file: lib/PPIx/QuoteLike/Token/Whitespace.pm
- version: '0.014'
+ version: '0.015'
PPIx::QuoteLike::Utils:
file: lib/PPIx/QuoteLike/Utils.pm
- version: '0.014'
+ version: '0.015'
requires:
Carp: '0'
Encode: '0'
@@ -72,5 +72,5 @@
bugtracker: https://github.com/trwyant/perl-PPIx-QuoteLike/issues
license: http://dev.perl.org/licenses/
repository: git://github.com/trwyant/perl-PPIx-QuoteLike.git
-version: '0.014'
+version: '0.015'
x_serialization_backend: 'CPAN::Meta::YAML version 0.018'
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/eg/pqldump
new/PPIx-QuoteLike-0.015/eg/pqldump
--- old/PPIx-QuoteLike-0.014/eg/pqldump 2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/eg/pqldump 2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use Pod::Usage;
use PPIx::QuoteLike::Dumper;
-our $VERSION = '0.014';
+our $VERSION = '0.015';
my %opt;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/eg/variables
new/PPIx-QuoteLike-0.015/eg/variables
--- old/PPIx-QuoteLike-0.014/eg/variables 2021-01-14 06:23:37.000000000
+0100
+++ new/PPIx-QuoteLike-0.015/eg/variables 2021-02-05 15:22:31.000000000
+0100
@@ -10,7 +10,7 @@
use PPI::Document;
use PPIx::QuoteLike::Utils qw{ __variables };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
my %opt;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/inc/My/Module/Recommend/Any.pm
new/PPIx-QuoteLike-0.015/inc/My/Module/Recommend/Any.pm
--- old/PPIx-QuoteLike-0.014/inc/My/Module/Recommend/Any.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/inc/My/Module/Recommend/Any.pm 2021-02-05
15:22:31.000000000 +0100
@@ -12,7 +12,7 @@
BEGIN {
*import = \&Exporter::import;
}
-our $VERSION = '0.014';
+our $VERSION = '0.015';
our @EXPORT_OK = qw{ __any };
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Constant.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Constant.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Constant.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Constant.pm 2021-02-05
15:22:31.000000000 +0100
@@ -8,7 +8,7 @@
use Carp;
use base qw{ Exporter };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
our @CARP_NOT = qw{
PPIx::QuoteLike
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Dumper.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Dumper.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Dumper.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Dumper.pm 2021-02-05
15:22:31.000000000 +0100
@@ -12,7 +12,7 @@
use PPIx::QuoteLike::Utils qw{ __instance };
use Scalar::Util ();
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use constant SCALAR_REF => ref \0;
@@ -100,7 +100,8 @@
qw{ type start finish };
push @rslt,
join "\t", $self->_class_name( $obj ), $string,
- _format_attr( $obj, qw{ encoding failures interpolates } ),
+ _format_attr( $obj, qw{ encoding failures interpolates
+ indentation } ),
$self->_perl_version( $obj ),
$self->_variables( $obj ),
;
@@ -205,10 +206,11 @@
sub _format_content {
my ( $obj, $method, @arg ) = @_;
- my $val = $obj->$method( @arg );
- ref $val
- and $val = $val->content();
- return defined $val ? $val : '?';
+ my @val = map { $_->content() }
+ grep { $_->significant() }
+ $obj->$method( @arg )
+ or return '?';
+ return join '', @val;
}
sub _isa {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Control.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Control.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Control.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Control.pm
2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
{
# TODO make this a state variable when we can require Perl 5.10.
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Delimiter.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Delimiter.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Delimiter.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Delimiter.pm
2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ MINIMUM_PERL @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
# Perl 5.29.0 disallows unassigned code points and combining code points
# as delimiters. Unfortunately for me non-characters and illegal
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Interpolation.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Interpolation.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Interpolation.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Interpolation.pm
2021-02-05 15:22:31.000000000 +0100
@@ -20,7 +20,7 @@
use base qw{ PPIx::QuoteLike::Token };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
sub ppi {
my ( $self ) = @_;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/String.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/String.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/String.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/String.pm 2021-02-05
15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Structure.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Structure.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Structure.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Structure.pm
2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Unknown.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Unknown.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Unknown.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Unknown.pm
2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore'
old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Whitespace.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Whitespace.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token/Whitespace.pm
2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token/Whitespace.pm
2021-02-05 15:22:31.000000000 +0100
@@ -9,7 +9,7 @@
use PPIx::QuoteLike::Constant qw{ @CARP_NOT };
-our $VERSION = '0.014';
+our $VERSION = '0.015';
sub significant {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Token.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Token.pm 2021-02-05
15:22:31.000000000 +0100
@@ -16,7 +16,7 @@
visual_column_number
};
-our $VERSION = '0.014';
+our $VERSION = '0.015';
# Private to this package.
sub __new {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Utils.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Utils.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike/Utils.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike/Utils.pm 2021-02-05
15:22:31.000000000 +0100
@@ -39,7 +39,7 @@
__variables
};
-our $VERSION = '0.014';
+our $VERSION = '0.015';
# Readonly::Scalar my $BRACED_RE => __match_enclosed( LEFT_CURLY );
Readonly::Scalar my $BRACKETED_RE => __match_enclosed( '[' ); # ]
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike.pm
new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike.pm
--- old/PPIx-QuoteLike-0.014/lib/PPIx/QuoteLike.pm 2021-01-14
06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/lib/PPIx/QuoteLike.pm 2021-02-05
15:22:31.000000000 +0100
@@ -40,7 +40,7 @@
use Scalar::Util ();
use Text::Tabs ();
-our $VERSION = '0.014';
+our $VERSION = '0.015';
use constant CLASS_CONTROL => 'PPIx::QuoteLike::Token::Control';
use constant CLASS_DELIMITER => 'PPIx::QuoteLike::Token::Delimiter';
@@ -56,6 +56,8 @@
'Tokenizer found illegal first characters';
use constant MISMATCHED_DELIM =>
'Tokenizer found mismatched delimiters';
+use constant NO_INDENTATION =>
+ 'No indentation string found';
{
my $match_sq = __match_enclosed( qw< ' > );
@@ -102,7 +104,7 @@
defined( my $string = $self->_stringify_source( $source ) )
or return;
- my ( $type, $gap, $content, $end_delim, $start_delim );
+ my ( $type, $gap, $gap2, $content, $end_delim, $indented, $start_delim
);
$arg{trace}
and warn "Initial match of $string\n";
@@ -130,15 +132,28 @@
# Note that the regexp used here is slightly wrong in that white
# space between the '<<' and the termination string is not
# allowed if the termination string is not quoted in some way.
- } elsif ( $string =~ m/ \A \s* ( << ) ( \s* )
- ( \w+ | $match_sq | $match_dq | $match_bt ) \n /smxgc ) {
- ( $type, $gap, $start_delim ) = ( $1, $2, $3 );
+ } elsif ( $string =~ m/ \A \s* ( << ) ( \s* ) ( ~? ) ( \s* )
+ ( [\\]? \w+ | $match_sq | $match_dq | $match_bt ) \n /smxgc ) {
+ ( $type, $gap, $indented, $gap2, $start_delim ) = (
+ $1, $2, $3, $4, $5 );
$arg{trace}
- and warn "Initial match '$type$start_delim$gap'\n";
- $self->{interpolates} = $start_delim !~ m/ \A ' /smx;
+ and warn "Initial match '$type$start_delim$gap$indented'\n";
+ $self->{interpolates} = $start_delim !~ m/ \A [\\'] /smx;
$content = substr $string, ( pos $string || 0 );
$end_delim = _unquote( $start_delim );
- if ( $content =~ s/ ^ \Q$end_delim\E \n? \z //smx ) {
+ # NOTE that the indentation is specifically space or tab
+ # only.
+ if ( $content =~ s/ ^ ( [ \t]* ) \Q$end_delim\E \n? \z //smx ) {
+ # NOTE PPI::Token::HereDoc does not preserve the
+ # indentation of an indented here document, so the
+ # indentation will appear to be '' if we came from PPI.
+ if ( $indented ) {
+ # Version per perldelta.pod for that release.
+ $self->{perl_version_introduced} = '5.025007';
+ $self->{indentation} = "$1";
+ $self->{_indentation_re} = qr/
+ ^ \Q$self->{indentation}\E /smx;
+ }
} else {
$end_delim = '';
}
@@ -182,6 +197,12 @@
length $gap ?
$self->_make_token( CLASS_WHITESPACE, $gap ) :
(),
+ length $indented ?
+ $self->_make_token( CLASS_STRUCTURE, $indented ) :
+ (),
+ length $gap2 ?
+ $self->_make_token( CLASS_WHITESPACE, $gap2 ) :
+ (),
];
$self->{start} ||= [
$self->_make_token( CLASS_DELIMITER, $start_delim ),
@@ -198,7 +219,9 @@
if ( $content =~ m/ \G ( \\ [ULulQEF] ) /smxgc ) {
push @children, [ CLASS_CONTROL, "$1" ];
- } elsif ( $content =~ m/ \G ( \\ N [{] ( [^}]+ ) [}] ) /smxgc )
{
+ } elsif (
+ $content =~ m/ \G ( \\ N [{] ( [^}]+ ) [}] ) /smxgc
+ ) {
# Handle \N{...} separately because it can not
# contain an interpolation even inside of an
# otherwise-interpolating string. That is to say,
@@ -220,19 +243,16 @@
} elsif ( $content =~ m/ \G ( [\$\@] \#? \$* ) /smxgc ) {
push @children, $self->_interpolation( "$1", $content );
} elsif ( $content =~ m/ \G ( \\ . | [^\\\$\@]+ ) /smxgc ) {
- push @children, [ CLASS_STRING, "$1" ];
+ push @children, $self->_remove_here_doc_indentation(
+ "$1",
+ sibling => \@children,
+ );
} else {
last;
}
- } continue {
- # We might have consecutive strings for various reasons.
- # Merge these.
- if ( CLASS_STRING eq $children[-1][0] &&
- CLASS_STRING eq $children[-2][0] ) {
- my $merge = pop @children;
- $children[-1][1] .= $merge->[1];
- }
}
+
+ @children = _merge_strings( @children );
shift @children; # remove the priming
# Make the tokens, at long last.
@@ -243,11 +263,18 @@
} else {
length $content
- and push @children, $self->_make_token(
- CLASS_STRING, $content );
+ and push @children, map { $self->_make_token( @{ $_ } ) }
+ _merge_strings(
+ $self->_remove_here_doc_indentation( $content )
+ );
}
+ # Add the indentation before the end marker, if needed
+ $self->{indentation}
+ and push @children, $self->_make_token(
+ CLASS_WHITESPACE, $self->{indentation} );
+
if ( $self->{finish} ) {
# If we already have something here it is data, not objects.
foreach ( @{ $self->{finish} } ) {
@@ -386,6 +413,11 @@
return $self->_stringify_source( $string, test => 1 );
}
+sub indentation {
+ my ( $self ) = @_;
+ return $self->{indentation};
+}
+
sub interpolates {
my ( $self ) = @_;
return $self->{interpolates};
@@ -753,6 +785,89 @@
}
}
+# For various reasons we may get consecutive literals -- typically
+# strings. We want to merge these. The arguments are array refs, with
+# the class name of the token in [0] and the content in [1]. I know of
+# no way we can generate consecutive white space tokens, but if I did I
+# would want them merged.
+#
+# NOTE that merger loses all attributes of the second token, so we MUST
+# NOT merge CLASS_UNKNOWN tokens, or any class that might have
+# attributes other than content.
+{
+ my %can_merge = map { $_ => 1 } CLASS_STRING, CLASS_WHITESPACE;
+
+ sub _merge_strings {
+ my @arg = @_;
+ my @rslt;
+ foreach my $elem ( @arg ) {
+ if ( @rslt && $can_merge{$elem->[0]}
+ && $elem->[0] eq $rslt[-1][0]
+ ) {
+ $rslt[-1][1] .= $elem->[1];
+ } else {
+ push @rslt, $elem;
+ }
+ }
+ return @rslt;
+ }
+}
+
+# If we're processing an indented here document, strings must be split
+# on new lines and un-indented. We return array refs rather than
+# objects because we may be called before we're ready to build the
+# objects.
+sub _remove_here_doc_indentation {
+ my ( $self, $string, %arg ) = @_;
+
+ # NOTE that we rely on the fact that both undef (not indented) and
+ # '' (indented by zero characters) evaluate false.
+ $self->{indentation}
+ or return [ CLASS_STRING, $string ];
+
+ my $ignore_first;
+ if ( $arg{sibling} ) {
+ # Because the calling code primes the pump, @sibling will never
+ # be empty, even when processing the first token. So:
+ # * The pump-priming specifies class '', so if that is what we
+ # see we must process the first line; otherwise
+ # * If the previous token is a string ending in "\n", we must
+ # process the first line.
+ $ignore_first = '' ne $arg{sibling}[-1][0] && (
+ CLASS_STRING ne $arg{sibling}[-1][0] ||
+ $arg{sibling}[-1][1] !~ m/ \n \z /smx );
+ } else {
+ # Without @sibling, we unconditionally process the first line.
+ $ignore_first = 0;
+ }
+
+ my @rslt;
+
+ foreach ( split qr/ (?<= \n ) /smx, $string ) {
+ if ( $ignore_first ) {
+ push @rslt, [ CLASS_STRING, "$_" ];
+ $ignore_first = 0;
+ } else {
+ if ( "\n" eq $_ ) {
+ push @rslt,
+ [ CLASS_STRING, "$_" ],
+ ;
+ } elsif ( s/ ( $self->{_indentation_re} ) //smx ) {
+ push @rslt,
+ [ CLASS_WHITESPACE, "$1" ],
+ [ CLASS_STRING, "$_" ],
+ ;
+ } else {
+ push @rslt,
+ [ CLASS_UNKNOWN, "$_", error => NO_INDENTATION ],
+ ;
+ }
+ }
+ }
+
+ return @rslt;
+}
+
sub _stringify_source {
my ( $self, $string, %opt ) = @_;
@@ -836,6 +951,46 @@
interpolated variables for L<Perl::Critic|Perl::Critic> policies and
similar code.
+The parse is fairly straightforward, and a little poking around with
+F<eg/pqldump> should show how it normally goes.
+
+But there is at least one quote-like thing that probably needs some
+explanation.
+
+=head2 Indented Here Documents
+
+These were introduced in Perl 5.25.7 (November 2016) but not recognized
+by this module until its version 0.015 (February 2021). The indentation
+is parsed as
+L<PPIx::QuoteLike::Token::Whitespace|PPIx::Regexp::Token::Whitespace>
+objects, provided it is at least one character wide, otherwise it is not
+represented in the parse. That is to say,
+
+ <<~EOD
+ How doth the little crocodile
+ Improve his shining tail
+ EOD
+
+will have the three indentations represented by whitespace objects and
+each line of the literal represented by its own string object, but
+
+ <<~EOD
+ How doth the little crocodile
+ Improve his shining tail
+ EOD
+
+will parse the same as the non-indented version, except for the addition
+of the token representing the C<'~'>.
+
+L<PPI|PPI> is ahead of this module, and recognized indented here
+documents as of its version 1.246 (May 2019). Unfortunately, as of
+version 1.270 the indent gets lost in the parse, so a C<PPIx::QuoteLike>
+object initialized from such a
+L<PPI::Token::HereDoc|PPI::Token::HereDoc> will be seen as having an
+indentation of C<''> regardless of the actual indentation in the source.
+I believe this restriction will go away when
+L<https://github.com/adamkennedy/PPI/issues/251> is resolved.
+
=head1 DEPRECATION NOTICE
The L<postderef|/postderef> argument to L<new()|/new> is being put
@@ -870,7 +1025,8 @@
this method will return nothing. The scalar representation of a here
document is a multi-line string whose first line consists of the leading
C< << > and the start delimiter, and whose subsequent lines consist of
-the content of the here document and the end delimiter.
+the content of the here document and the end delimiter. Indented here
+documents were not supported by this class until version C<0.015>.
C<PPI> classes that can be handled are
L<PPI::Token::Quote|PPI::Token::Quote>,
@@ -1031,6 +1187,15 @@
be expected to handle the content of C<$string> (be it scalar or
object), and a false value otherwise.
+=head2 indentation
+
+This method returns the indentation string if the object represents an
+indented here document, or C<undef> if it represents anything else,
+including an unindented here document.
+
+B<Note> that if indented syntax is used but the here document is not in
+fact indented, this will return C<''>, which evaluates to false.
+
=head2 interpolates
say $str->interpolates() ?
@@ -1217,6 +1382,12 @@
thing would change based on what is interpolated, but neither can I rule
it out. I<Caveat user>.
+=head2 PPI Restrictions
+
+As of version 0.015 of this module, the only known instance of this is
+the handling of indented here documents, as discussed above under
+L<Indented Here Documents|/Indented Here Documents>.
+
=head2 Non-Standard Syntax
There are modules out there that alter the syntax of Perl. If the syntax
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/t/parse.t
new/PPIx-QuoteLike-0.015/t/parse.t
--- old/PPIx-QuoteLike-0.014/t/parse.t 2021-01-14 06:23:37.000000000 +0100
+++ new/PPIx-QuoteLike-0.015/t/parse.t 2021-02-05 15:22:31.000000000 +0100
@@ -598,6 +598,7 @@
if ( ok $obj, q{Able to parse HERE_DOCUMENT} ) {
cmp_ok $obj->failures(), '==', 0, q{Failures parsing HERE_DOCUMENT};
cmp_ok $obj->interpolates(), '==', 1, q{Does HERE_DOCUMENT interpolate};
+ is $obj->indentation(), undef, 'HERE_DOCUMENT indentation';
is $obj->content(), $here_doc, q{Can recover HERE_DOCUMENT};
is $obj->__get_value( 'type' ), '<<', q{Type of HERE_DOCUMENT};
is $obj->delimiters(), q{"EOD"EOD}, q{Delimiters of HERE_DOCUMENT};
@@ -1221,6 +1222,191 @@
}
+{
+ my $here_doc = <<'__END_OF_HERE_DOCUMENT';
+<< ~'EOD'
+ The $1,000,000 Bank-Note
+ EOD
+__END_OF_HERE_DOCUMENT
+
+ $obj = PPIx::QuoteLike->new( $here_doc );
+ if ( ok $obj, q{Able to parse HERE_DOCUMENT} ) {
+ cmp_ok $obj->failures(), '==', 0, q{Failures parsing HERE_DOCUMENT};
+ cmp_ok $obj->interpolates(), '==', 0, q{Does HERE_DOCUMENT interpolate};
+ is $obj->indentation(), ' ' x 4, 'HERE_DOCUMENT indentation';
+ is $obj->content(), $here_doc, q{Can recover HERE_DOCUMENT};
+ is $obj->__get_value( 'type' ), '<<', q{Type of HERE_DOCUMENT};
+ is $obj->delimiters(), q{'EOD'EOD}, q{Delimiters of HERE_DOCUMENT};
+ is $obj->__get_value( 'start' ), q{'EOD'},
+ q{Start delimiter of HERE_DOCUMENT};
+ is $obj->__get_value( 'finish' ), q{EOD},
+ q{Finish delimiter of HERE_DOCUMENT};
+ is $obj->encoding(), undef, q{Encoding of HERE_DOCUMENT};
+ is_deeply [ sort $obj->variables() ],
+ [ ],
+ q{HERE_DOCUMENT interpolated variables};
+
+ cmp_ok scalar $obj->elements(), '==', 10,
+ q{Number of elements of HERE_DOCUMENT};
+ cmp_ok scalar $obj->children(), '==', 3,
+ q{Number of children of HERE_DOCUMENT};
+
+ if ( my $kid = $obj->child( 0 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::Whitespace' ),
+ q{HERE_DOCUMENT child 0 class};
+ is $kid->content(), ' ' x 4,
+ q{HERE_DOCUMENT child 0 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 0 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 0 parent};
+ cmp_ok $kid->previous_sibling() || 0, '==', $obj->__kid( 0 - 1 ),
+ q{HERE_DOCUMENT child 0 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 0 + 1 ),
+ q{HERE_DOCUMENT child 0 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 1 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::String' ),
+ q{HERE_DOCUMENT child 1 class};
+ is $kid->content(), "The \$1,000,000 Bank-Note\n",
+ q{HERE_DOCUMENT child 1 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 1 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 1 parent};
+ cmp_ok $kid->previous_sibling() || 0, '==', $obj->__kid( 1 - 1 ),
+ q{HERE_DOCUMENT child 1 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 1 + 1 ),
+ q{HERE_DOCUMENT child 1 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 2 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::Whitespace' ),
+ q{HERE_DOCUMENT child 2 class};
+ is $kid->content(), ' ' x 4,
+ q{HERE_DOCUMENT child 2 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 2 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 2 parent};
+ cmp_ok $kid->previous_sibling() || 2, '==', $obj->__kid( 2 - 1 ),
+ q{HERE_DOCUMENT child 2 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 2 + 1 ),
+ q{HERE_DOCUMENT child 2 next sibling};
+ }
+
+ }
+}
+
+{
+ my $here_doc = <<'__END_OF_HERE_DOCUMENT';
+<< ~"EOD"
+ The $1,000,000 Bank-Note
+
+ EOD
+__END_OF_HERE_DOCUMENT
+
+ $obj = PPIx::QuoteLike->new( $here_doc );
+ if ( ok $obj, q{Able to parse HERE_DOCUMENT} ) {
+ cmp_ok $obj->failures(), '==', 0, q{Failures parsing HERE_DOCUMENT};
+ cmp_ok $obj->interpolates(), '==', 1, q{Does HERE_DOCUMENT interpolate};
+ is $obj->indentation(), ' ' x 4, 'HERE_DOCUMENT indentation';
+ is $obj->content(), $here_doc, q{Can recover HERE_DOCUMENT};
+ is $obj->__get_value( 'type' ), '<<', q{Type of HERE_DOCUMENT};
+ is $obj->delimiters(), q{"EOD"EOD}, q{Delimiters of HERE_DOCUMENT};
+ is $obj->__get_value( 'start' ), q{"EOD"},
+ q{Start delimiter of HERE_DOCUMENT};
+ is $obj->__get_value( 'finish' ), q{EOD},
+ q{Finish delimiter of HERE_DOCUMENT};
+ is $obj->encoding(), undef, q{Encoding of HERE_DOCUMENT};
+ is_deeply [ sort $obj->variables() ],
+ [ qw{ $1 } ],
+ q{HERE_DOCUMENT interpolated variables};
+
+ cmp_ok scalar $obj->elements(), '==', 12,
+ q{Number of elements of HERE_DOCUMENT};
+ cmp_ok scalar $obj->children(), '==', 5,
+ q{Number of children of HERE_DOCUMENT};
+
+ if ( my $kid = $obj->child( 0 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::Whitespace' ),
+ q{HERE_DOCUMENT child 0 class};
+ is $kid->content(), ' ' x 4,
+ q{HERE_DOCUMENT child 0 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 0 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 0 parent};
+ cmp_ok $kid->previous_sibling() || 0, '==', $obj->__kid( 0 - 1 ),
+ q{HERE_DOCUMENT child 0 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 0 + 1 ),
+ q{HERE_DOCUMENT child 0 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 1 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::String' ),
+ q{HERE_DOCUMENT child 1 class};
+ is $kid->content(), 'The ',
+ q{HERE_DOCUMENT child 1 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 1 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 1 parent};
+ cmp_ok $kid->previous_sibling() || 0, '==', $obj->__kid( 1 - 1 ),
+ q{HERE_DOCUMENT child 1 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 1 + 1 ),
+ q{HERE_DOCUMENT child 1 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 2 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::Interpolation' ),
+ q{HERE_DOCUMENT child 2 class};
+ is $kid->content(), '$1',
+ q{HERE_DOCUMENT child 2 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 2 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 2 parent};
+ cmp_ok $kid->previous_sibling() || 2, '==', $obj->__kid( 2 - 1 ),
+ q{HERE_DOCUMENT child 2 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 2 + 1 ),
+ q{HERE_DOCUMENT child 2 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 3 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::String' ),
+ q{HERE_DOCUMENT child 3 class};
+ is $kid->content(), ",000,000 Bank-Note\n\n",
+ q{HERE_DOCUMENT child 3 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 3 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 3 parent};
+ cmp_ok $kid->previous_sibling() || 3, '==', $obj->__kid( 3 - 1 ),
+ q{HERE_DOCUMENT child 3 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 3 + 1 ),
+ q{HERE_DOCUMENT child 3 next sibling};
+ }
+
+ if ( my $kid = $obj->child( 4 ) ) {
+ ok $kid->isa( 'PPIx::QuoteLike::Token::Whitespace' ),
+ q{HERE_DOCUMENT child 4 class};
+ is $kid->content(), ' ' x 4,
+ q{HERE_DOCUMENT child 4 content};
+ is $kid->error(), undef,
+ q{HERE_DOCUMENT child 4 error};
+ cmp_ok $kid->parent(), '==', $obj,
+ q{HERE_DOCUMENT child 4 parent};
+ cmp_ok $kid->previous_sibling() || 4, '==', $obj->__kid( 4 - 1 ),
+ q{HERE_DOCUMENT child 4 previous sibling};
+ cmp_ok $kid->next_sibling() || 0, '==', $obj->__kid( 4 + 1 ),
+ q{HERE_DOCUMENT child 4 next sibling};
+ }
+
+ }
+}
+
done_testing;
sub PPIx::QuoteLike::__get_value {
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/t/unit-adhoc.t
new/PPIx-QuoteLike-0.015/t/unit-adhoc.t
--- old/PPIx-QuoteLike-0.014/t/unit-adhoc.t 2021-01-14 06:23:37.000000000
+0100
+++ new/PPIx-QuoteLike-0.015/t/unit-adhoc.t 2021-02-05 15:22:31.000000000
+0100
@@ -30,6 +30,36 @@
}
+{
+ my $code = <<'END_OF_DOCUMENT';
+<<\EOD
+$foo
+EOD
+END_OF_DOCUMENT
+
+ my $pql = PPIx::QuoteLike->new( $code );
+
+ cmp_ok $pql->failures(), '==', 0, '<<\\EOD here doc parses';
+
+ ok ! $pql->interpolates(), '<<\\EOD here doc does not interpolate';
+
+}
+
+{
+ my $code = <<'END_OF_DOCUMENT';
+<<~\EOD
+ $foo
+ EOD
+END_OF_DOCUMENT
+
+ my $pql = PPIx::QuoteLike->new( $code );
+
+ cmp_ok $pql->failures(), '==', 0, '<<~\\EOD here doc parses';
+
+ ok ! $pql->interpolates(), '<<~\\EOD here doc does not interpolate';
+
+}
+
done_testing;
1;
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/PPIx-QuoteLike-0.014/t/version.t
new/PPIx-QuoteLike-0.015/t/version.t
--- old/PPIx-QuoteLike-0.014/t/version.t 2021-01-14 06:23:37.000000000
+0100
+++ new/PPIx-QuoteLike-0.015/t/version.t 2021-02-05 15:22:31.000000000
+0100
@@ -106,6 +106,16 @@
'Case-folded string was introduced in 5.15.8';
is $obj->perl_version_removed(), undef, 'Case-folded string is still here';
+$obj = PPIx::QuoteLike->new( <<HERE_DOC );
+<<~'EOD'
+ How doth the little crocodile
+ Improve its shining tail
+ EOD
+HERE_DOC
+is $obj->perl_version_introduced(), '5.025007',
+ 'Indented here-doc was introduced in 5.25.7';
+is $obj->perl_version_removed(), undef, 'Indented here-doc is still here';
+
done_testing;
1;
