PPI-1.270000755000000000000 013511127601 12477 5ustar00unknownunknown000000000000README100644000000000000 56613511127601 13427 0ustar00unknownunknown000000000000PPI-1.270This archive contains the distribution PPI, version 1.270: Parse, Analyze and Manipulate Perl (without perl) This software is copyright (c) 2002 by Adam Kennedy. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. This README file was generated by Dist::Zilla::Plugin::Readme v6.012. Changes100644000000000000 15266313511127601 14130 0ustar00unknownunknown000000000000PPI-1.270Revision history for Perl extension PPI 1.270 2019-07-09 15:14:57Z Summary: - attempt to handle new blead binary/hexadecimal parsing behavior in tests 1.269 2019-05-17 18:36:46Z Summary: - many small documentation improvements 1.268 2019-05-16 10:00:39Z Summary: - fix a broken link in the pod 1.267 2019-05-16 09:22:34Z Summary: - make PPI::Test::Run more OS-agnostic 1.266 2019-05-15 16:17:49Z Summary: - keep heredoc terminator detection from triggering regex errors - small cleanups Details: - make the output of PPI::Test::Run more useful - remove a superfluous import 1.265 2019-05-14 12:39:51Z Summary: - simplified a code construct 1.264 2019-04-28 14:56:28Z Summary: - keep vstring processing from swallowing underscores 1.262 2019-04-28 11:41:54Z Summary: - convert newlines in some raw test files from win32 to unix 1.260 2019-04-28 11:10:02Z Summary: - allow underscores in vstrings 1.258 2019-04-27 17:05:33Z Summary: - remove accidentally included Test::InDistDir 1.256 2019-04-26 16:40:01Z Summary: - allow all PPI::Document instances to have a filename attribute 1.254 2019-04-26 16:23:21Z Summary: - recognize `for (;<$foo>;) {}` as containing a readline operator 1.252 2019-04-26 14:21:36Z Summary: - add support for the double diamond (<<>>) input operator - adjust position of a todo marker to not catch a passing test 1.250 2019-04-25 16:43:32Z Summary: - various smaller releng changes Details: - removed dependency on File::Remove - add some tests including a TODO test for misparse bug on '(1)-1' - allow tests to run without pre-determined module versions - add travis-perl helper to be run before install - update versions of Perl Travis tests on 1.248 2019-04-25 16:08:08Z Summary: - parse list-embedded curlies as hash constructors 1.246 2019-04-25 15:33:48Z Summary: - support indented here-docs - fixed some typos 1.244 2019-04-25 15:21:51Z Summary: - support key-value and index-value slices in PPI::Token::Symbol symbol method 1.242 2019-04-25 14:33:56Z Summary: - keep exponents of 2 or more zeroes from trapping PPI in an endless loop 1.240 2019-04-25 14:09:24Z Summary: - add support for lexical subroutines from perl-5.26 1.238 2019-04-25 12:03:37Z Summary: - only release engineering, moved to Dist::Zilla, straightened out dependencies and fixed some formatting in Changes 1.237_001 Wed 15 Nov 2017 Summary: - support postfix dereference - remove dependencies on vars, base and List::MoreUtils - reduce globals and cross-package variables - make xt/api.t skip/run properly Details: - convert many cross-package var accesses to var imports - convert several unnecessary globals to local variables 1.236 Thu 22 June 2017 Summary: - prevent Node->child from proceeding without a valid argument - make test pragma warning code enable -w to match warnings policy 1.234 Wed 21 June 2017 Summary: - Prevent sub names like v10 from being version strings (GitHub #65) (MOREGAN) 1.232 Wed 21 June 2017 Summary: - add Changes entries forgotten in 1.230 1.230 Wed 21 June 2017 Summary: - remove temporary fix introduced in 1.226 - prevent possible regex on undefined scalar in __current_token_is_forced_word 1.228 Tue 20 June 2017 Summary: - keep PPI::Dumper from breaking Perl::Critic under cperl 5.27 (RURBAN) 1.226 Tue 20 June 2017 Summary: - Fix test reliance on '.' in @INC (KENTNL) - temporary fix to keep an untested combination from blocking Perl::Critic (https://github.com/chriscapaci) 1.224 Sun 14 May 2017 Summary: - updating an out-of-date meta.yml caused by Module::Install 1.222 Sun 14 May 2017 Summary: - unit tests for many parts, both passing and TODO - many documentation fixes - add ->version method to PPI::Statement::Package (WOLFSAGE) - remove unused PPI::Document->new timeout feature - do not expect '.' in @INC (PLICEASE) - many parsing fixes - various fixes to the behaviors of methods - removal of problematic dependencies Details: - Remove undocumented, non-working 'timeout' attribute to Document->new, including HAVE_ALARM and PPI::Exception::ParserTimeout. (GitHub #140) (MOREGAN) - first cut of a travis configuration - do hex number matching with [[:xdigit:]] - some readability improvements on the code of HereDoc.pm - recognize heredoc even if they have no newline at the end (AUBERTG) - parse left side of => as bareword even if it looks like a keyword or op (MOREGAN) - remove source code escapes in the output of QuoteLike::Words->literal (MOREGAN) - removal of Test::NoWarnings - less uses of List::MoreUtils in favor of List::Util - expand $'x to $::main::x in Symbol->canonical as with $::x (MOREGAN) - fixed parsing of large numbers in Number::Exp on Solaris 80 (JMASLAK) - make remove_child actually return undef on failure to find child to remove - higher accuracy when deciding whether certain characters are operators or variable type casts (*&% etc.) (MOREGAN) - parse x as the first element of code as a word, not an operator (MOREGAN) - recognize the implied end of a package statement that includes a block (MOREGAN) - parse package names that look like operators as strings, not ops (MOREGAN) - parse package names that look like v10 as strings, not versions (MOREGAN) - parse things like v49use as a single bareword, not v-string + keyword (MOREGAN) - parse x64 as a word, not x operator + number (MOREGAN) - parse 1.eq 1 as float + op, not concatenation - parse subroutine attributes correctly (MOREGAN) 1.220 Tue 11 Nov 2014 Summary: - incompatible behavior fixes on PPI::Statement::Sub->prototype - improved parsing of various syntax elements - code quality improvements - various small documentation fixes Details: - {} is now recognized as anonymous hash constructor instead of a code block after these operators: &&= //= || && // ? : (GitHub #36) (MOREGAN) - regex capture variables greater than $9 are now parsed completely, instead of being parsed as single digit captures with numbers after them (GitHub #38) (MOREGAN) - DESTROY and AUTOLOAD subs are now parsed even without the sub keyword (GitHub #39) (MOREGAN) - PPI::Statement::Sub->prototype behavior now matches its documentation, instead of returning the prototype string unchanged and still including the parens (GitHub #56) (MOREGAN) - PPI::Statement::Sub->prototype now returns undef on subs without a prototype, instead of returning an empty string (GitHub #56) (MOREGAN) - list of keywords which are not parsed as packages when followed by the Perl4 package separator ' has been increased (GitHub #77) (MOREGAN) - application of a number of Perl::Critic policies and documentation fixes (GitHub #53) (MOREGAN, MITHALDU) - automation of README.md generation for git (GitHub #86) (COWENS) - various small documentation fixes (Github #96) (MOREGAN) 1.218 Sat 16 Aug 2014 Summary: - Fixes for various parsing and documentation bugs - 1MB limit on input document size removed - Moved repository to GitHub: https://github.com/adamkennedy/PPI Details: - Stop directing bugs to rt.cpan.org (GitHub #40) (MOREGAN) - Fix documentation reference to List::Util (RT #75308) (RWSTAUNER) - Improve scalability of parsing long lines, and remove the size limit on documents PPI will parse (GitHub #5) (MITHALDU) - Speed up adding an element to an unlabeled statement. Allow inlining of some methods. (WOLFSAGE) - Expanded test coverage (DOLMEN, MOREGAN) - Convert inline tests to standalone tests (GitHub #12) (MOREGAN) - Fix for '1=>x' being parsed as x operator (GitHub #46) (MOREGAN) - Recognize that '1 x3' is the x operator followed by a 3 (RT #37892, GitHub #27) (MOREGAN) - Support all augmented assignment operators (<<=, ||=, etc.) (RT #68176, 71705) (MOREGAN) - Stop upper-case "=CUT" from terminating POD (RT #75039) (JAE) - Support upper-case digits in hex and binary numbers, including in the leading '0X' and '0B'. (RT #36540) (KRYDE, MOREGAN) - Fix float argument to range operator misparsed as version string (RT #45014) (MOREGAN) - Fix POD markup in PPI::Find (RT #51693) (FWIE) - Fix spelling of "Tom Christiansen" (RT #67264) (TADMC) - Fix a large raft of spelling and grammar errors (RT #85049) (David Steinbrunner, DOLMEN, MOREGAN) - Fix errors in documentation of the PPI::Element class hierarchy (RT #30863, 69026) (SJQUINNEY) - Prevent PPI::XSAccessor packages from hiding corresponding PPI packages in CPAN (RT #90792) (MITHALDU) - Recognize the formfeed character as whitespace (RT #67517) (WYANT) - Recognize regex match following 'return' (RT #27475) (ADAMK) - Fix missing dereference, length called on reference (RT #40103) (ADAMK) 1.215 Sat 26 Feb 2011 Summary: - No changes Details: - Confirmed new Perl::Critic works with 1.214_02, so we can release a new PPI now. 1.214_02 Mon 31 Jan 2011 Summary: - More minor fixes, preparing for production release Details: - Updated copyright year to 2011 (ADAMK) - Fixed RT #64247 bless {} probably contains a hash constructor (WYANT) - Backed out glob fix (WYANT) - Fixed RT #65199 Cast can trump braces in PPI::Token::Symbol->symbol (WYANT) 1.214_01 Thu 16 Dec 2010 Summary: - General fix release Details: - index_locations on an empty document no longer warns (WYANT) - Corrected a bug in line-spanning attribute support (WYANT) - Regression test for line-spanning attribute support (ADAMK) - Fixed #61305 return { foo => 1 } should parse curlys as hash constructor, not block (WYANT) - Fixed #63943 map and regexp confuse PPI? (ADAMK) 1.213 Tue 6 Jul 2010 Summary: - Targetted bug fix, no changes to parsing or normal usage Details: - Updated to Module::Install 1.00 - Updated module depednencies in xt author tests - Fixed extremely broken PPI::Token::Pod::merge and added test case 1.212 Sun 9 May 2010 Summary: - Minor bug fixes and development support Details: - Fixed #48819: Bug in ForLoop back-compatilbilty warning - Added support for $ENV{X_TOKENIZER} --> $PPI::Lexer::X_TOKENIZER 1.211_01 Sun 21 Feb 2010 Summary: - Experimentation support and bug fixes Details: - Upgraded to Module::Install 0.93 - Added support for $PPI::Lexer::X_TOKENIZER, so that alternate experimentatal tokenizers can be swapped in for testing. - Added an extra 14_charsets.t case to validate we handle byte order marks properly. - Moved author tests from t to xt to reduce spurious test failures in CPAN Testers, when the testing modules change across versions - Fixed #26082: scalar { %x } is misparsed - Fixed #26591: VMS patch for PPI 1.118 - Fixed #44862: PPI cannot parse "package Foo::100;" correctly - Fixed #54208: PPI::Token::Quote::Literal::literal is missing due to case-sensitivity error 1.210 Mon 15 Feb 2010 Summary: - Packaging fixes Details: - No functional changes - Upgrading to Module::Install 0.93 - Added missing test_requires dependency for Class::Inspector 1.209 Sat 6 Feb 2010 Summary: - Small optimisation release Details: - No functional changes - Upgrading to Module::Install 0.92 - Moved the Test::ClassAPI test to only run during RELEASE_TESTING to reduce the dependency load (and occasionally Test::ClassAPI seems to FAIL on CPAN Testers. 1.208 Thu 14 Jan 2010 Summary: - THIS IS THE 100TH RELEASE OF PPI! - Fixes some tiny issues, otherwise unchanged from 1.207_01 Details: - Don't assign '' to $^W, it generates a warning on Gentoo - Added missing PPI::Token::Regexp fix to Changes file - Updating Copyright to the new year (yet again) 1.207_01 Thu 10 Dec 2009 Summary: - This is a general bug fix and accuracy release Details: - Fixed #50309: literal() wrong result on "qw (a b c)" - PPI::Dumper no longer causes Elements to flush location data. Also it no longer disables location information for non-Documents. - +{ package => 1 } doesn't create a PPI::Statement::Package - PPI::Token::Regexp and PPI::Token::QuoteLike::Regexp how have methods for getting at the various components (delimiters, modifiers, match & substitution strings). 1.206 Sun 9 Aug 2009 Summary: - This is an optimisation release (1-2% speed up) (Using information uncovered by a Devel::NYTProf 3 alpha) Details: - Removing som superfluous 1; returns - Using defined and ref to avoid highly excessive calls to PPI::Util::TRUE 1.205 Mon 3 Aug 2009 Summary: - This is a production release Details: - No changes from 1.204_07 1.204_07 Fri 31 Jul 2009 Summary: - Minor tweaks Details: - Allow ::For and ::List to return true to ->isa(::ForLoop) and do a once-per-process warning when we do. - Fixed a bug in Class::XSAccessor prototype. 1.204_06 Wed 22 Jul 2009 Summary: - API Change Details: - Changing PPI::Structure::ForLoop to PPI::Structure::For 1.204_05 Tue 21 Jul 2009 Summary: - Bug fixes in preparation for production release Details: - There is no longer any real reason to bundle the testing modules except as a potential source of more bugs. - Removed quantifier ? on zero-length ^ in /^?for(?:each)?\z/ - Run-time load PPI::Document instal of compile-time loading it - Tweak a few load orders to get PPI::Util loaded earlier. - Fixed location access methods on PPI::Element - New PPI::Statement::Include::version_literal() method. 1.204_04 Thu 16 Jul 2009 Summary: - Dependency tweaks Details: - Because we bundle Test::ClassAPI, we need to explicitly match its dependencies. Bumped Params::Util to 1.00. - Bumped a couple of deps a couple of revisions to get better XS. 1.204_03 Tue 14 Jul 2009 Summary: - More bug fixing, clean up, and optimisation - Cleaning up contributed APIs - Adding some demonstration classes Details: - Implemented PPI::Transform::UpdateCopyright - Removed the use of 'use base' - Various minor simplifications - Renamed PPI::Statement::Switch to ::Given - Renamed PPI::Structure::WhenMatch to ::When - Converted the Lexer internals to use exception-based error handling. - Take advantage of the removal of all those "or return undef" to simplify the Lexer code, remove variable declarations, and inline calls to several hot-code-path functions. The Lexer should be significantly faster (FSDO "significant"). - The v6 key on Tokenizer broke support for Perl 5.6 (perl thought it was a numeric v-string) 1.204_02 Sun 10 May 2009 Summary: - Various bug fixing and stabilisation work - It's a perl 5.10 extravaganza! Details: - Updated Module::Install to 0.87 - Added Test::NoWarnings to the test suite - Added support for qw{foo} in addition to for ('foo') - Added support for vstrings again - Now supports the 5.10 "state" keyword. (As far as PPI is concerned it's a synonym for "my") - Now supports switch statements. - Now supports the smart match operator (~~). - Now supports keeping track of line numbers and file names as affected by the #line directive. - Now supports UNITCHECK blocks. - Statement::Include::module_version() implemented. - Statement::Include::arguments() implemented. - Statement::Variable::symbols() implemented. - Token::QuoteLike::Words::literal() implemented. - Token::Quote::Double::simplify() fixed. - Element line_number(), column_number(), visual_column_number(), logical_line_number(), and logical_filename() implemented. - Support for Unicode byte order marks (PPI::Token::BOM) added. - Token::Word::method_call() implemented. - Element::descendant_of() and Element::ancestor_of() implemented. - Statement::specialized() implemented. - Now can handle files named "0". (Perl::Critic got a complaint about this) - foreach loop variables can be declared using "our". - Much more comprehensive testing of compound statement detection. 1.204_01 Sun 18 May 2008 Summary: - Unicode cleanup and bug fixing - Taking the opportunity to do some house cleaning while the code base is relatively stable, before things get crazy again. Details: - For completeness sake, add support for empty documents - Moved capability detection into PPI::Util - POD test script now skips on install properly - Removed 200 lines of old dead "rawinput" code from PPI::Tokenizer - 100% of PPI::Tokenizer is now exception-driven - Workaround for "RT#35917 - charsets.t eats all available VM" (unicode bug in 5.8.6, works in 5.8.8) - Temporarily disable round-trip testing of 14_charset.t 1.203 Wed 14 May 2008 Summary: - No change, switching to production version 1.202_03 Wed 14 May 2008 Summary: - Initial Perl 6 support - Bug fixes and final 1.203 release candidate - I finally catch up with all the failing test cases that Chris Dolan keeps commiting :) Details: - Adding initial support for "use v6-alpha;" - Adding new class Perl::Statement::Include::Perl6 - Adding a test on the KindaPerl6::Grammar, which triggered a bug in the tokenizer during CPAN::Metrics tinderboxing. - All open() calls now use three-argument form - Upgrading explicit Perl dependency to 5.006, because of the previous item. - Better support for labels, including tricky ones like "BEGIN : { ... }" 1.202_02 Wed 2 Jan 2008 Summary: - Back-compatibility and 1.203 release candidate Details: - Removing the use of use base 'Exporter'; - Updating Test::SubCalls dep to 1.07 to get the use base 'Exporter' fix for that too. 1.202_01 Tue 20 Nov 2007 Summary: - Minor bug fix release Details: - RT #30469: calling length() on PPI::Token gives error - 14_charsets.t was incorrectly skipping in situations that it should have been running. 1.201 Mon 22 Oct 2007 Summary: - Minor bug fix release Details: - The internal exception class PPI::Exception::ParserTimeout was inheriting from itself. 1.200 Mon 15 Oct 2007 Summary: - Production Release Details: - Zero changes from 1.199_07 - Updated version from 1.199_07 to 1.200 1.199_07 Fri 12 Oct 2007 Summary: - This is the third release candidate for 1.200 - Minor tweak Details: - Changed the way to detect Perl 5.6 to ignore the 1_0e1_0 failure 1.199_06 Wed 10 Oct 2007 Summary: - This is the second release candidate for 1.200 - Some small bug fixes Details: - Remove -w from test scripts to allow taint'enabled testing - Skip the failing 1_0e1_0 test on Perl 5.6.2 1.199_05 Tue 9 Oct 2007 Summary: - This is the first release candidate for 1.200 - Fix some parser corner cases Details: - Fixed parsing of %!, $^\w, and %^H - Fixed parsing of @{$foo}-1 - Fixed parsing of <$fh1>, <$fh2> 1.199_04 Summary: - Build tweaks - More regression changes Details: - Increasing List::Util dependency to 1.19 (Removes a memory leak on Win32) 1.199_03 Thu 12 Jul 2007 Summary: - Support for a few more rare/legacy Perl syntax - Tokenizer simplification, optimization and exception'ification Details: - Added support for the <<\EOF heredoc style - Always create ->{type} in full-quote sections - Converted more of the Tokenizer to use exceptions - Optimized away a bunch of now-unneeded "or return undef" - Optimized _set_token_class down to a single statement - Inlined _set_token_class out of existence - Cache and fast-clone PPI::Token::Whitespace->null - Removed some superfluous parameter checks on private methods, for conditions that would cause explosions and be noticed anyway. - Removed the fancy options from PPI::Token::new - More consistent structure of incomplete quotes 1.199_02 Mon 5 Mar 2007 Summary: - Added parser timeout support - Fixing various regression cases - Adding some housekeeping tweaks Details: - Created PPI::Exception with an eye to moving towards using exceptions more for error handling (for speed). The goal is to get rid of the "or return undef"s. - Added the timeout param to the PPI::Document constructor which uses alarm to implement basic timeout support. This should help when parsing a large corpus on Unix. (Not available on Win32) - Fixed incorrect location() for PPI::Structure instances. - Adding better parsing of hash constructors. - Pushing Clone dependency to 0.22 to get closer to taint support) - Pushing deps on bundled test modules to prevent accidentally bundling old versions. 1.199_01 Tue 31 Oct 2006 Summary: - Improved lexing correctness - Partial implementation of literal - Initial implementation of Number classes (Chris Dolan) Details: - Split out PPI::Token::Number subclasses - Implement numbers with exponential notation - Implement literal() for ::Number classes (except ::Version) - Implement literal() for ::Token::Quote::Single - Added -T for inline tests - Add tests for nested statements and nested structures - Fixed some bugs as a result - Improved detection of the correct curly brace structure types 1.118 Fri 22 Sep 2006 Summary: - Better 5.10 support - Fixing various (mostly parsing) bugs Details: - Upgraded to Module::Install 0.64 - Improving support for dor and added //= operators - Fixed parsing of binary, octal and hex numbers - Fixed parsing of /= and *= - Fixed #21571 symbol() returns just sigil with adjacent braces - Fixed #21575 variables() chokes on list with whitespace - Fixed #20480 (Misparse of some floating-point numbers.) - Fixed #19999: Make test fails (undeclared global variable $document) under Perl 5.6.2 (or at least, I think I have. This needs double-checking on Perl 5.6.2) - Partially Fixed #16952: [PATCH] Speed up tokenizer char-by-char (Did not apply the patch, but fixed a bug noted as an aside in the report) - PPI::Document::File was returning a plain PPI::Document object, fixed. - FINALLY added some basic POD for PPI::Structure, the one class I somehow keep forgetting to do. 1.117 Sat 02 Sep 2006 Summary: - Fixing bugs introduced in 1.116 Details: - Simple compound statements "{ 1 }" were not end-detecting properly - The new handling for the "-" character was shortcutting naively - Labelled compound statements were not end-detecting properly - { package => 1 } was treating package incorrectly - Fixed bugs in test cases submitted by the Perl::Critic team - Added a number of extra test cases, and introduced Test::Object based testing for PPI::Document objects. 1.116 Thu 31 Aug 2006 Summary: - PPI::Document::File first release - Adding readonly attribute - Fixed various accumulated bugs Details: - Upgraded to Module::Install 0.63 - Add a new file-only subclass of PPI::Document - Added the readonly attribute to the PPI::Document->new constructor - Added method PPI::Document->readonly method - 'goto' is a PPI::Statement::Break - Re-fixed #19629: End of list mistakenly seen as end of statement - Applied #16892: [PATCH] docs and comments - Fixed #16815 (location of Structure::List is not defined.) - Fixed misparsing of C< 1-1 > - Fixed #18413: PPI::Node prune() implementation broken - Fixed #20428 (minor doc bug in PPI::Token::Symbol) - Resolved NOTABUG #20031 (PPI installation) - Resolved NOTABUG #20038 (PPI installation) - Fixed #19883: 'package' bareword used as hash key is detected as package statement - Fixed #19629: End of list mistakenly seen as end of statement - Fixed #15043: (no description) # He wanted PPI::Document::File 1.115 Sat 03 Jun 2006 Summary: - Fixing rt.cpan.org bugs Details: - Fixed #19614: Suspicious code in PPI::Structure - Fixed #16831: until () { } not parsed as compound statement - NOTABUG #16834: "$a = 1 if ($a == 2)" vs "$a = 1 if $a == 2" - Fixed #19629: End of list mistakenly seen as end of statement - Fixed #18413: PPI::Node prune() implementation broken 1.114 Thu 25 May 2006 Summary: - This release addresses only dependency issues Details: - Changed over from IO::Scalar to IO::String - Added a dependency on Task::Weaken so that we can make various not-so-clueful downstream packagers play nicely. 1.113 Wed 10 May 2006 Summary: - This release contains only build-time changes Details: - Upgraded to Module::Install 0.62 - No features() used in this dist, so removing auto_install 1.112 Mon 24 Apr 2006 Summary: - Emergency release to fix a bug that prevents install on perl > 5.8.4 Details: - Small typo in the unicode-specific section of 14_charsets.t prevents tests passing for anyone with a unicode-sane Perl version. - Added a test for strange locales that can't handle unicode, and skip the unicode tests. 1.111 Sat 22 Apr 2006 General - Moved from SourceForge CVS to new collaborative SVN repository - Fixed regressions other people had added since 1.110 - Upgraded to Module::Install 0.62 Details: - SourceForge was too hard to get into, so moved to specially designed new SVN repository to make it easy for others to help out. - Moved t.data to t/data in line with current style and to reduce complexity. - Fixed t/data/08_regression/11_multiply_vs_glob_cast (added by unknown) - Fixed t/data/08_regression/12_pow (added by unknown) - Removed every use of UNIVERSAL::isa in the tests - Upgraded to Module::Install 0.62 (my private prerelease) 1.110 Fri Jan 27 2005 General - Added test support for the third location component (Arjen Laarhoven) - Various bug fixes (Releasing early with only small changes at the request of Perl::Critic) Details: - Fixed CPAN #16924: PPI::Statement::Sub.pm fix to use Params::Util line to resolve _INSTANCE error - Fixed CPAN #16837: typo in PPI::Statement::Expression POD - Fixed CPAN #16973: PPI 1.109 shouldn't require List::Util 1.18 (We do need 1.18 to avoid a leak, but it doesn't work everywhere) - Fixed CPAN #16814: _INSTANCE method not defined in PPI::Statement::Sub (dupe) - Arjen Laarhoven added to CVS committers - Added a third element to ->location return arrayref that contains the visual starting column of the token, taking into account tabbing. 1.109 Fri Dec 30 2005 Summary: - Various bug fixes - Minor structural cleanup Details: - Removed every single use of UNIVERSAL::isa - PPI::Normal was quite broken, cleaned it up - Fixed PPI::Normal::Standard::remove_statement_separator - Fixed CPAN #16674 PPI::Token::Quote::Double->interpolations (awigley) - Fixed CPAN #15131 PPI::Node->find() behavior not completely documented (Jeffrey Thalhammer) - Fixed CPAN 13743 PPI::Statement::Scheduled api (johanl) - PPI::Statement::Scheduled is now a subclass of PPI::Statement::Sub - Removed breaking circular include in PPI::Util - Removed an 'our' variable in t/04_element.t that created a 5.6.0 dependency - Only do the PPI::Cache tests that use Test::SubCalls if >= 5.006 - (Except for File::Remove, we should ACTUALLY depend on 5.005 now) - Fixed CPAN #16671 $_ is not localized (JPIERCE) (I missed an unlocaled $_ hiding in the Node object destructor) 1.108 Thu Dec 15 2005 Summary: - Fixing of some very minor bugs Details: - 8 wasn't an illegal character in an octal number (fixed) - Two <= 5.8.5) (not pre-checked and enforced yet, but will be) - Starting new generation of "exhaustive" testing Details: - Added 20_tokenizer_regressions, which tests all detectably-failing 3-or-less character long Perl programs (not inclusive of latin-1 or Unicode). (Audrey Tang) - Fixed bug for incomplete quotes at EOF (there may be a few more similar cases) - Fixed bug with $'0 (where 0 is only legal after ::) - No longer die for illegal chars in hex/bin number types (Attach the error to $token->{_warning} instead) - Caught a number of cases with trailing colons for $things (Both at EOF and end of token) - Convert [^\W\d]\w* to (?!\d)\w+ to improve unicode support in symbols etc (Audrey Tang) - Miscellaneous doc bugs in the SYNOPSIS (Audrey Tang) 1.104 Thu Nov 10 2005 General - No change to code - Both List::Util and List::MoreUtil contain memory leaks, and we use them extensively. Pushed the dependencies up to versions with the memory leaks fixed. 1.103 Thu Oct 6 2005 General - Small bug fix that shouldn't have escaped Details: - Changed md5hex_file to act more like the PPI::Documeny way. That is, localise and THEN convert to \015 1.102 Wed Oct 5 2005 General - Small things to support Perl::Metrics Details: - Added undocumented PPI::Util::md5hex_file function 1.101 Thu Sep 29 2005 General - Bug fix release Details: - Fixed CPAN bug #14436 and #14440, misparse for my ($foo) ... - Added an self-analysis test script for PPI-testable problems - Fixed some minor bugs it threw up. 1.100_03 General - Major bug fixing - Some additions to help simplify Perl::Metrics Details: - A whole bunch (practically all) of the sibling code was breaking under non-trivial use. Fixed, with a number of new tests added. - Added function PPI::Util::md5hex - Added method PPI::Document::hex_id 1.100_02 General - Various bug fixes - Completed the first version of PPI::Cache Details: - Expanded round-trip testing coverage to all the lexer and regression test files - 06_round_trip.t wasn't doing the round-trip test properly. Fortunately, this only resulted in false failures, so no actual damage was done as a result of this. 1.100_01 Sat Sep 03 2005 Summary: - Added integrated cache support Details: - Added PPI::Cache class - Removed warning in 99_pod.t - Added a common PPI::Util::_slurp function - PPI::Document can be given a cache to use 1.003 Tue Aug 18 2005 Summary: - Bug fix release Details: - Add support for 'for $foo () {}' - Add support for 'for my $foo () {}' - Fixed bug where "'Hello..." crashed the Tokenizer - Fixed bug where '"Hello...' crashed the Tokenizer - Fixed bug where 's' crashed the Tokenizer 1.002 Thu Jul 14 2005 Summary: - Bug fix release Details: - Fixed CPAN #13655 - insert_before and insert_after broken. 1.001 Tue Jul 12 2005 Summary: - Turning on Test::Inline scripts Details: - Bug fix: ->string returns wrong for qq and all braced quotes - Added Test::Inline 2.100-type inline2test.conf and inline2test.tpl files - Added t/ppi_token__quoteengine_full.t - Added t/ppi_token_quote_single.t - Added t/ppi_token_quote_double.t - Added t/ppi_token_quote_literal.t - Added t/ppi_token_quote_interpolate.t 1.000 Sat Jul 9 2005 Summary: - FIRST PRODUCTION RELEASE - Finalising POD, corrected the Copyright dates - Rewrote much of the main PPI.pm docs - Removing more unneeded dependencies - Added native Storable support Details: - Removed dependency on Class::Inspector - Added build dependency on Class::Inspector and include() it (although it's still needed at build time, this still does manage to reduce the number of files to download by one more) - Added PPI::Document::STORABLE_freeze and PPI::Document::STORABLE_thaw 0.996 Fri Jul 8 2005 Summary: - RELEASE CANDIDATE 2 - Clearing all remaining RT bugs - Removing and inlining dependencies Details: - Resolved PDOM bug CPAN #13454 ( while ( $s = $s->sprevious_sibling ) infinite loops ) Mental Note: Doing an auto-decrement in an array subscript is BAD - Resolved Lexer bug CPAN #13425 ( $p{package} creates a PPI::Statement::Package ) Added smarts to resolve word-started statements as ::Expression in subscripts - Resolved PDOM bug CPAN #13326 ( problems in index_locations ) Patch and comprehensive additional tests provided by johanl[ÄT]DarSerMan.com - Removed dependency on Class::Autouse. Just load Tokenizer and Lexer up front. - Removed dependency on File::Slurp. Only use it 3 times and it's not worth it when almost all the files we will read are under 50k. 0.995 Sun Jul 3 2005 Summary: - RELEASE CANDIDATE 1 - Added some internals to help with XML compatibility - Completed primary POD docs - Completed first versions of insert_before and insert_after - Removed last uses of _isa - Added final missing POD docs Details: - Added convenience method PPI::Element::class - Added docs for all PPI::Structure classes - Added additional tests to check for ::Unknown classes - Added PPI::Document::insert_before to return an error - Added PPI::Document::insert_after to return an error - Added PPI::Document::replace to return an error - Removed a number of unneeded UNIVERSAL::isa imports - Removed PPI::Token::_isa before anyone starts using it. It was hacky and unsuitable to a production release 0.994 skipped 0.993 Tue Jun 21 2005 Summary: - Various minor code, packaging and POD cleanups Details: - Corrected a POD bug in PPI::Dumper - Upgraded PPI::Dumper param checking to Params::Util - Restored PPI::Element->clone to using Clone::clone ( 0.17+ ) - Removed dependency on Storable - Until it fixes the problem, explicitly include ExtUtils::AutoInstall 0.992 Sun Jun 12 2005 Summary: - Added the PPI::Transform API 0.991 Fri Jun 10 2005 - Typo. I wasn't dieing on newlines to PPI::Document->new( string ) correctly, and thus dieing without the API CHANGE message. This was confusing people as to why. 0.990 Wed Jun 8 2005 Summary: - Last version (hopefully) to make API changes - Slight API shuffle in the constructors - Completed all PPI::Statement::* API documentation - Enabled latin-1 support in the appropriate places 0.906 Thu Apr 28 2005 Summary: - Completed location support and added related unit tests - Added API for future support of tab widths Details: - Removed PPI::Element::_line - Removed PPI::Element::_col - Fixed bugs in PPI::Document::index_location - Fixed bugs in PPI::Element::location - Added 12_location.t unit test - Added PPI::Document::tab_width method - Added PPI::Normal::Standard::remove_useless_attributes (to remove the ->{tab_width} attributes and later other things) 0.905 Wed Apr 20 2005 Summary: - Completely forgot to write unit tests for PPI::Util, and a bug slipped in. Fixed and added tests Details: - Fixed bug in PPI::Util::_Document - Added 11_util.t 0.904 Wed Apr 20 2005 Summary: - Improvements to PPI::Normal - Method renaming to parse-time PDOM private methods - Various bug fixes and POD tweaks - Added PPI::Util Details: - Partly added Layer 2 to PPI::Normal - Added function PPI::Normal::Standard::remove_useless_pragma - Added function PPI::Normal::Standard::remove_statement_separator - Added function PPI::Normal::Standard::remove_useless_return - Renamed _on_line_start to __TOKENIZER__on_line_start - Renamed _on_line_end to __TOKENIZER__on_line_end - Renamed _on_char to __TOKENIZER__on_char - Renamed _scan_for_end to __TOKENIZER__scan_for_end - Renamed _commit to __TOKENIZER__commit - Renamed _is_an_attribute to __TOKENIZER__is_an_attribute - Renamed _literal to __TOKENIZER__literal - Renamed _opposite to __LEXER__opposite - Fixed bug in PPI::Statement::Package::namespace - Added unit tests for PPI::Statement::Package - Added (currently mostly internal) PPI::Util - Added exportable function PPI::Util::_Document 0.903 Fri Mar 25 2005 Summary: - PPI::Document and other PPI::Node-subclasses will now implicitly DESTROY correctly. - Now that PPI.pm is just a module loader, merge the main documentation from PPI::Manual back into it again. Details: - Added use of Scalar::Util::weaken for all %_PARENT writes - Uncovered critical bug in Clone, so we use Storable::dclone for now, until Clone is fixed. This resolves rt.cpan.org #11552 - Added dependency on Storable 1.13 - Moved all PPI::Manual content to PPI and relinked This resolves rt.cpan.org #11803 - Removed lib/PPI/Manual.pod - Added the standard 99_pod.t to check POD - Fixed a POD bug in Element.pm 0.902 Sun Feb 6 2005 Summary: - Added Document Normalization functions from old Perl::Compare (although it is very very limited in function at this point) Details: - Added class PPI::Normal - Added class PPI::Normal::Standard - Added class PPI::Document::Normalized - Added method PPI::Document->normalize - Bug: ->clone was going to all the trouble to build a clone, but then returning the original :( Fixed 0.901 Sat Jan 29 2005 Summary: - Moved all up-to-date code over to SourceForge - Various fixes to allow the release of File::Find::Rule::PPI Details: - Got all modules synchronising their versions correctly - Moved to SourceForge CVS repository - Changed all files over to the new CVS directory layout - Fixed bug in PPI::Node::find_first - Added unit tests for PPI::Node::find_first - Added unit tests for PPI::Node::find_any - Added a stub and docs for PPI::Statement::stable 0.900 Mon Jan 17 2005 Summary: - Final removal of PPI::Base - Completed majority of crash bugs in the Tokenizer Details: - Fixed Tokenizer Bug C< @foo = < seen as ::Readline - Fixed Tokenizer Bug C< (< seen as ::Readline - Fixed Tokenizer Bug C< q'foo bar' > parsed incorrectly - Fixed bug in PPI::Token::_QuoteEngine::_scan_quote_like_operator_gap - Fixed Tokenizer Bug C< $foo:'' > sees symbol $foo:' - Fixed Tokenizer Bug C< $#arrayindex > was seen as a Symbol - Fixed Tokenizer Bug C< %2 > was seen as a Symbol - Fixed Tokenizer Bug C< &64 > was seen as a Symbol - Fixed Tokenizer Bug C< $::| > is actually a Magic - Fixed Tokenizer Bug C< @0 > is a Magic - Deleted PPI::Base - Added $PPI::Element::errstr - Added basic private error methods to PPI::Element - PPI::Element::significant now returns '' as false - PPI::XS - Added all C methods 0.846 Mon Jan 17 2005 Summary: - Added proper support for - Last release before beta 1 if all looks good Details: - Added class PPI::Token::QuoteLike::Readline - Added t.data/05_lexer_practical/10_readline.code/dump - Added support for <> - A few other minor bug fixes 0.845 Sat Jan 15 2005 Summary: - Adding integration with PPI::XS, autoloading if installed Details: - Added $PPI::XS_COMPATIBLE and $PPI::XS_EXCLUDE variables to guide integration - Don't autoload PPI::Document, always load - Load in PPI::XS whenever it is installed - Loading and depending on Class::Inspector - PPI::Element::significant implemented in XS (as a trial) 0.844 Fri Jan 14 2005 Summary: - Found a massive performance bug when parsing large perl constructs - Fixed some install problems Details: - PPI::Node::schild was copying the entirety of its child array each call. This was causing massive slowdowns when ->{children} got large. Fixed. - The core tests still expect Transform to be in the core. Fixed. 0.843 Tue Jan 12 2005 Summary: - Starting the process of removing PPI::Base. It only does does error handling now, which will be split up. - Fixing some packaging and "play well with others" issues Details: - Randal Schwartz pointed out t/06... wouldn't working for him. It appears when Test::More bug CPAN #8385 was fixed, we broke. - We now include build-time-only dependencies in the installer - Although unusable, PPI::Document::Normalized's version fell out of sync with the rest of the distribution. Fixed. - PPI::Tokenizer no longer inherits from PPI::Base - Added class variable $PPI::Tokenizer::errstr - Added class method PPI::Tokenizer->errstr - Fixed Tokenizer Bug: C< y => 1 > was being seen as a regex - Fixed Tokenizer Bug: C< <<''; > was dying because I expected at least one character - Fixed Tokenizer Bug: C< $foo->{s} > was being seen as a regex 0.842 Tue Jan 11 2005 Summary: - Lots of debugging based on Tinderbox results Details: - Fixed MANIFEST.SKIP to removed PPI::Transform and PPI::Tinderbox from the core PPI distribution (like they should be) - Optimised the previous #9582 to not have to run for EVERY word, only those where it might be needed. - Corrected a use of QuoteLike::Execute to QuoteLike::Backtick - Fixed CPAN #9598 Tokenizer Bug: C< qx( $command ) > - Fixed CPAN #9614 Tokenizer Bug: C< $foo << 16 > - Set the properly includive regex for << '...' here-doc - Added an very early filter to prevent non-basic chars going in 0.841 Mon Jan 10 2005 Summary: - Completed much more documentation on the core classes - PPI::Tester back in sync again (separate distribution) - PPI::Processor and PPI::Tinderbox completed (separate distribution) Details: - Documented PPI::Tokenizer - PPI::Document->new( $source ) added as a convenience - PPI::Lexer::lex_file can now be called statically - PPI::Lexer::lex_source can now be called statically - PPI::Lexer::lex_tokenizer can now be called statically - Fixed a small bug in PPI::Dumper::print - Fixed CPAN #9582 Tokenizer Bug: C< sub y { } # Comment > - Fixed similar case with C< foo->y() > 0.840 Thu Dec 21 2004 Summary: - Changed the PPI summary to no longer use the devisive word "parse" Now: "PPI - Analyze and manipulate Perl code without using perl itself" - Total rewrite of all the ->location code - Upgrading MakeFile.PL to Module::Install - Fixed #CPAN 8752 (a round-trip edge case bug) - Added 08_regression.t to do code/dump regression testing for lexer bugs - Completed (hopefully) HereDocs conversion to a single complex token - PPI is now compatible with prefork.pm (although not dependant) Details: - Added PPI::Node::find_first object method - Changed PPI::Node::find_any to just call PPI::Node::find_first - Added PPI::Element::first_token object method - Added PPI::Element::last_token object method - Made a partial-removal-capable PPI::Element::_flush_locations - PPI::Document::flush_locations uses PPI::Element::_flush_locations - PPI::Document::index_locations is here-doc sane - Added PPI::Token::HereDoc::heredoc object method - Added PPI::Token::HereDoc::terminator object method - Documented PPI::Token::HereDoc - Added a HereDoc code/dump test to 05_lexer_practical.t - Added PPI::Document::serialize, which replaces the use of ->content for generating the actual string to write out to files when saving Documents. - File::Spec reduced from dependency to build dependency - Updated Test::ClassAPI dependency to newest version - Enabled API collision detection in 02_api.t - Updated Class::Autouse dependency to newest version 0.840_01 Tue Dec 21 2004 Summary: - Perl Foundation Funding Commences - Changes separated into General and Details from here on - Complete re-organisation of the quote-like token classes. Any and all code that works with quotes will be broken. - Gave up on the old PPI::Query code and wrote a complete new and much thinner implementation based roughly on the API of File::Find::Rule. PPI::Find uses the &wanted function (which also has a slightly different API to the old one) but has the ->in style search methods. It should be relatively easy for someone to write PPI::Find::Rule on top of it. - PPI::Transform is thus temporarily stale Details: - Introduced a bug for C< foreach $foo () > and caught/fixed it during the changeover. - Changed PPI::Lexer::Dump to PPI::Dumper - API Freeze PPI::Find - API Freeze PPI::Dumper - Documented PPI::Find - Documented PPI::Dumper 0.831 Fri Nov 5 2004 - Overloaded PPI::Document bool => true - Overloaded PPI::Document "" => content (That is, ::Documents stringify to their content) - Fixed PPI::Document::save - Merged Leon Brocard's docs patch - Cleaned up PPI::Node::_condition and documented conditions better (fixed #7799) - Allow dropping of the initial PPI:: in class search conditions - Fixed two instances of File::Slurp::read_file being called as a method 0.830 Mon Sep 27 2004 - Added PPI::Statement::Package::file_scoped object method - Handle potentially dangerous C< sub foo ($$ > safer - Resolve C< sub BEGIN { } > to PPI::Statement::Scheduled correctly - Resolve C< sub () { 1 }; > to PPI::Statement correctly - API Freeze PPI::Statement::Package - API Freeze PPI::Statement::Scheduled - API Freeze PPI::Statement::Sub - Documented PPI::Statement - Documented PPI::Statement::Package - Documented PPI::Statement::Scheduled - Documented PPI::Statement::Sub - Documented PPI::Document::Fragment 0.829 Sat Sep 25 2004 - BREAKS API COMPATIBILITY - Changed PPI::Token::SubPrototype to PPI::Token::Prototype - Added PPI::Token::Prototype::prototype object method - Added PPI::Statement::Sub::prototype object method - Added PPI::Statement::Sub::block object method - Fixed PPI::Statement::Include::version 0.828 Sun Aug 8 2004 - BREAKS API COMPATIBILITY - Changed PPI::Token::DashedBareword to PPI::Token::Quote::Dashed - Changed PPI::Token::Bareword to PPI::Token::Word - Vastly improved PPI::Manual 0.827 Thu Aug 5 2004 - Added PPI::Token::Separator class ( for __DATA__ and __END__ ) - Added better Tokenizer handling of __DATA__ and __END__ - Added better Lexer handling of __DATA__ and __END__ - Fixed some version inconsistencies 0.826 Sat Jul 31 2004 - Added PPI::Element::statement object method - Added PPI::Transform abstract class - Sped up the 'bool' overload for PPI::Element - Added PPI::Element::snext_sibling object method - Added PPI::Element::sprevious_sibling object method - Added PPI::Element::insert_before object method placeholder - Added PPI::Element::insert_after object method placeholder - Changed {elements} to {children} to match PPI::Node definitions - Added PPI::Node::first_element object method - Added PPI::Node::last_element object method - Added PPI::Element::next_token object method - Added PPI::Element::previous_token object method - Added PPI::Token::Symbol::symbol object method 0.825 Mon Jul 26 2004 - Added PPI::Statement::Include::type object method - Added PPI::Statement::Include::module object method - Added PPI::Statement::Include::pragma object method - Added PPI::Statement::Include::version object method - Overloaded == as "the same object" for PPI::Element - Overloaded eq as "->content is the same" for PPI::Element - Overloaded bool as always true, to prevent an error - Added PPI::Statement::Package::namespace object method - 100% round-trip safe. What goes in, will come out. - Reduced leaks by 95%. Process size 30meg after 5000 files. Still some leaks remaining when Lexing errors out. - Separated largest Tokens into their own files. This aligns token class structure with that of ::Statement and ::Structure - Rewrote PPI::Node::DESTROY several times while hunting down more leaks - Fixed Tokenizer crash on empty subroutine prototypes such as C< sub foo() {} > - Treat unexpected braces as an implicit close, to make the lexer more resilient - Added PPI::Statement::UnmatchedBrace (name suggested by Abhijit Menon-Sen) to handle closing braces found at the base of a Document. - Enabled foo'bar package notation again. - Getting close to the first 0.900 series beta release 0.824 Wed Jul 21 2004 - Removed a 6 meg tmon.out file I accidentally bundled 0.823 Wed Jul 21 2004 - Added PPI::Document::Fragment class - Added PPI::Node::schildren object method - Completed compound statement parsing - Lexer is now officially feature complete 0.822 Wed Jul 21 2004 - Filling out the API test as much as possible - Added PPI::Statement::label object method - Moved PPI::Structure::elements object method to PPI::Node::elements - Re-organised statement parsing to better implement ::Compound statements - Added PPI::Statement::Data class - Added PPI::Statement::End class - Re-organised the _lex_statement, _statement_continues stuff, ready for while - Added PPI::Lexer::_lex_statement_end to handle PPI::Statement::End properly - Organising 02_api.t was getting hard, so added implicit Module=class to Test::ClassAPI 0.821 Mon Jul 19 2004 - Cleaned up test data files directories - Added PPI::Statement::Variable::type object method - Added PPI::Statement::Variable::variables object method - Added some more classes to the API testing - Started 07_tokens.t for testing particular token classes - Added PPI::Token::Symbol::canonical object method (and tests) - PPI::Token::Magic now ISA PPI::Token::Symbol - PPI::Element::clone now fixes _PARENT links for Nodes 0.820 Mon Jul 19 2004 - Added Round-Trip-Safe testing for all PPI files - Added PPI::Node::find_any object method - Added PPI::Node::contains object method - Continuing the never ending addition of tests - Structure open and close brace tokens now see the Structure as their parent - Removed the sample application, to streamline the core install - Removed dependencies for the sample application - Removed custom META.yml, as now no longer needed 0.819 Mon Jul 14 2004 - Many parts of PPI are VASTLY changed in this revision - Breaks API compatibility heavily - Adds dependency on List::MoreUtils - Added PPI::Lexer support for CHECK blocks - Added PPI::Document::load method - Added PPI::Document::save method - Added PPI::Document::index_locations method - Added PPI::Document::flush_locations method - Added PPI::Element::top method - Added PPI::Element::document method - Renamed PPI::Element::extract -> PPI::Element::remove - Added test script for element-y stuff - Optimisation across the board using List::Any - Added PPI::Node::first_child method - Added PPI::Node::last_child method - Added PPI::Element::clone method - Removed Filehandle support from PPI::Tokenizer, to allow the ability to rollback source lines into the buffer if needed. - Added POD documentation for PPI::Element - Added POD documentation for PPI::Node - Added POD documentation for PPI::Document 0.818 Mon Jul 5 2004 - Changed lib/PPI/Manual.pm to lib/PPI/Manual.pod - Added documentation for PPI::Lexer - Fixed the misparsing of s{//}{\} - More clues added for deciding "slash or regex" - Removed PPI::Batch from the default distribution - Replaced File::Flat with File::Slurp to reduce dependencies 0.817 Thu Jul 1 2004 - Fixed the misparsing of $#{ } - Changed PPI::ParentElement to PPI::Node and moved it to its own file - Changed PPI::Common to PPI::Base - Fixed PPI::Node::find - Added PPI::Node::prune - Started to add a little more class structure documentation - Tried to make the DESTROY sequence of events work better 0.816 Tue Jun 29 2004 - Solved the "last token in file parses wrong" bug 0.815 Sun Jun 27 2004 - Fixed a bug with the detection of @- and @+ - Added support for @* - Added missing classmap entry for ^ to ::Token::WhiteSpace - Added support for arcane "foo"x10 idiosyncracy 0.814 Sat Jun 26 2004 - Added the PPI tester, a desktop-based interactive debugger, which should greatly accelerate finding and fixing both ::Tokenizer and ::Lexer bugs. This will probably end up as a separate distribution though, as it has a dependency on wxPerl. - Fixed the misparsing of Foo::Bar::Baz - Fixed the misparsing of *100 - Fixed the misparsing of Class::->method properly, or rather Foo:: - Tokenizer correctly identifies labels - Changed PPI::Statement::Flow to PPI::Statement::Compound - Removed the extra null whitespace token appearing after a bareword at the end of a file. - -X operator are recognised correctly, although not at end of file - Lexer detects subroutine and if () statement ends correctly 0.813 Sat Jun 26 2004 - PPI::Lexer is now structurally complete 0.812 Tue Jun 22 2004 - No changes to PPI itself. - With the addition of Test::ClassAPI 'complete' support, upgraded 02_api.t to use it. Fixed a few small house-keeping bugs. 0.811 Mon Jun 21 2004 - Added support for subroutine attributes - Fixed some problems with anonymous subroutines and prototypes - $#$foo parses as (Cast,Symbol) now, not (Magic,Symbol) 0.810 Mon Jun 14 2004 - Recognise the _ magic filehandle 0.809 Sat Apr 17 2004 - No changes to PPI itself. Set the correct number of tests to match changes to Test::ClassAPI 0.808 Sat Apr 17 2004 - No changes to PPI itself. Upgraded 02_api.t to match changes to Test::ClassAPI 0.807 Sat Apr 3 2004 - Added a manual META.yml file to stop the bundled private AppLib library from being indexed by CPAN 0.806 Mon Mar 22 2004 - The $} magic variable is now supported - Fixed a "tight sub property" bug ( sub foo:lvalue ) 0.805 Sun Sep 28 2003 - The maximum line length regressed, reseting it to 5000. - In PPI::Format::HTML, not any parsing error causing a premature end of tokenizer by adding it in a comment at the end of the file. 0.804 Sat Sep 06 2003 - Statement and Structure resolution preliminarily work. Some basic types of statements and structures are identified. - PPI::Format::Apache has been separated into a different module 0.803 Sat Sep 06 2003 - Added very long line protection support. Maximum line length is now 5000. - Added bug fixes to the Lexer so that block tree building works mostly OK again, without adding broken duplicate tokens. - Added the PPI::Lexer::Dump module, to do Lexer object dumps. 0.802 Sat Aug 23 2003 - PPI::Format::HTML sends the correct content headers 0.801 Fri Aug 22 2003 - Moved to a new numbering scheme to get more room before 1.0 - Always fully load when called under mod_perl - Add mod_perl hook to PPI::Format::HTML 0.8 Fixes to the quote parsing engine 0.7 Fixed some minor bugs 0.6 Fixed POD, fixed version number, included $'a as a symbol 0.5 Missing 0.4 Mon Dec 23 10:24:21 - Some more minor parsing fixes in Tokenizer - Completely changed the API from doThis to do_this style - Changed API to indicate private methods properly 0.3 Tue Dec 17 10:29:27 - Restructured a little bit - Fixed some mis-parsing cases 0.2 Unknown - Added test script 0.1 Thu Dec 06 16:50:23 2002 - original version LICENSE100644000000000000 4365513511127601 13622 0ustar00unknownunknown000000000000PPI-1.270This software is copyright (c) 2002 by Adam Kennedy. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2002 by Adam Kennedy. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2002 by Adam Kennedy. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini100644000000000000 471013511127601 14226 0ustar00unknownunknown000000000000PPI-1.270name = PPI author = Adam Kennedy license = Perl_5 copyright_holder = Adam Kennedy copyright_year = 2002 [MetaResources] homepage = https://github.com/adamkennedy/PPI bugtracker = https://github.com/adamkennedy/PPI/issues repository = https://github.com/adamkennedy/PPI [Encoding] ; exclude paths from autoprereqs detection encoding = bytes match = ^t/data/ [AutoPrereqs] ; to lower the risk of stuff getting overlooked skip = Class::XSAccessor ; used only in an experimental module skip = Time::HiRes ; optional, only used to speed up testing a little skip = PPI::XS ; optional, experimental [Prereqs] ; Force the existence of the weaken function ; (which some distributions annoyingly don't have) Task::Weaken = 0 [DynamicPrereqs] -body = requires('File::Spec', is_os('MSWin32') ? '3.2701' : '0.84'); ; The distribution version is calculated from the last git tag. ; To override, use V= dzil ... [Git::NextVersion] version_regexp = ^v([\d._]+)(-TRIAL)?$ [OurPkgVersion] :version = 0.12 underscore_eval_version = 1 [Git::GatherDir] exclude_filename = README.pod [MetaYAML] [MetaJSON] [Readme] [Manifest] [License] [MakeMaker] [Test::Compile] :version = 2.039 bail_out_on_fail = 1 xt_mode = 1 ;[Test::NoTabs] ;[Test::EOL] [MetaTests] ;[Test::CPAN::Changes] [Test::ChangesHasContent] [PodSyntaxTests] ;[PodCoverageTests] ;[Test::PodSpelling] [Test::Pod::No404s] [Test::Kwalitee] :version = 2.10 filename = xt/author/kwalitee.t [MojibakeTests] :version = 0.8 [Test::ReportPrereqs] :version = 0.022 verify_prereqs = 1 version_extractor = ExtUtils::MakeMaker [Test::Portability] ;[Test::CleanNamespaces] [MetaProvides::Package] [MetaConfig] [Keywords] [Git::Contributors] [RunExtraTests] [Git::Check / initial check] [Git::CheckFor::MergeConflicts] [Git::CheckFor::CorrectBranch] :version = 0.004 release_branch = master [CheckPrereqsIndexed] :version = 0.019 [TestRelease] [Git::Check / after tests] [UploadToCPAN] [CopyFilesFromRelease] filename = Changes [ReadmeAnyFromPod] :version = 0.142180 type = pod location = root phase = release [NextRelease] :version = 5.033 time_zone = UTC format = %-6v %{yyyy-MM-dd HH:mm:ss'Z'}d%{ (TRIAL RELEASE)}T [Git::Commit / release snapshot] :version = 2.046 add_files_in = . commit_msg = %N-%v%t%n%n%c [Git::Tag] tag_format = v%v tag_message = v%v%t [Git::Push] ; listed late, to allow all other plugins which do BeforeRelease checks to run first. [ConfirmRelease] xt000755000000000000 013511127601 13053 5ustar00unknownunknown000000000000PPI-1.270api.t100644000000000000 1674413511127601 14205 0ustar00unknownunknown000000000000PPI-1.270/xt#!/usr/bin/perl # Basic first pass API testing for PPI use lib 't/lib'; use PPI::Test::pragmas; use Test::More; BEGIN { my $tests = 2931 + ($ENV{AUTHOR_TESTING} ? 1 : 0); if ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( tests => $tests ); } else { plan( skip_all => 'Author tests not required for installation' ); } } use Test::ClassAPI; use PPI; use PPI::Dumper; use PPI::Find; use PPI::Transform; # Ignore various imported or special functions $Test::ClassAPI::IGNORE{'DESTROY'}++; $Test::ClassAPI::IGNORE{'refaddr'}++; $Test::ClassAPI::IGNORE{'reftype'}++; $Test::ClassAPI::IGNORE{'blessed'}++; # Execute the tests Test::ClassAPI->execute('complete', 'collisions'); exit(0); # Now, define the API for the classes __DATA__ # Explicitly list the core classes PPI=class PPI::Tokenizer=class PPI::Lexer=class PPI::Dumper=class PPI::Find=class PPI::Transform=abstract PPI::Normal=class # The abstract PDOM classes PPI::Element=abstract PPI::Node=abstract PPI::Token=abstract PPI::Token::_QuoteEngine=abstract PPI::Token::_QuoteEngine::Simple=abstract PPI::Token::_QuoteEngine::Full=abstract PPI::Token::Quote=abstract PPI::Token::QuoteLike=abstract PPI::Token::Regexp=abstract PPI::Structure=abstract PPI::Statement=abstract ##################################################################### # PDOM Classes [PPI::Element] new=method clone=method parent=method descendant_of=method ancestor_of=method top=method document=method statement=method next_sibling=method snext_sibling=method previous_sibling=method sprevious_sibling=method first_token=method last_token=method next_token=method previous_token=method insert_before=method insert_after=method remove=method delete=method replace=method content=method tokens=method significant=method location=method line_number=method column_number=method visual_column_number=method logical_line_number=method logical_filename=method class=method [PPI::Node] PPI::Element=isa scope=method add_element=method elements=method first_element=method last_element=method children=method schildren=method child=method schild=method contains=method find=method find_any=method find_first=method remove_child=method prune=method [PPI::Token] PPI::Element=isa new=method add_content=method set_class=method set_content=method length=method [PPI::Token::Whitespace] PPI::Token=isa null=method tidy=method [PPI::Token::Pod] PPI::Token=isa lines=method merge=method [PPI::Token::Data] PPI::Token=isa handle=method [PPI::Token::End] PPI::Token=isa [PPI::Token::Comment] PPI::Token=isa line=method [PPI::Token::Word] PPI::Token=isa literal=method method_call=method [PPI::Token::Separator] PPI::Token::Word=isa [PPI::Token::Label] PPI::Token=isa [PPI::Token::Structure] PPI::Token=isa [PPI::Token::Number] PPI::Token=isa base=method literal=method [PPI::Token::Symbol] PPI::Token=isa canonical=method symbol=method raw_type=method symbol_type=method [PPI::Token::ArrayIndex] PPI::Token=isa [PPI::Token::Operator] PPI::Token=isa [PPI::Token::Magic] PPI::Token=isa PPI::Token::Symbol=isa [PPI::Token::Cast] PPI::Token=isa [PPI::Token::Prototype] PPI::Token=isa prototype=method [PPI::Token::Attribute] PPI::Token=isa identifier=method parameters=method [PPI::Token::DashedWord] PPI::Token=isa literal=method [PPI::Token::HereDoc] PPI::Token=isa heredoc=method terminator=method [PPI::Token::_QuoteEngine] [PPI::Token::_QuoteEngine::Simple] PPI::Token::_QuoteEngine=isa [PPI::Token::_QuoteEngine::Full] PPI::Token::_QuoteEngine=isa [PPI::Token::Quote] PPI::Token=isa string=method [PPI::Token::Quote::Single] PPI::Token=isa PPI::Token::Quote=isa literal=method [PPI::Token::Quote::Double] PPI::Token=isa PPI::Token::Quote=isa interpolations=method simplify=method [PPI::Token::Quote::Literal] PPI::Token=isa literal=method [PPI::Token::Quote::Interpolate] PPI::Token=isa [PPI::Token::QuoteLike] PPI::Token=isa [PPI::Token::QuoteLike::Backtick] PPI::Token=isa PPI::Token::_QuoteEngine::Simple=isa [PPI::Token::QuoteLike::Command] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa [PPI::Token::QuoteLike::Words] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa literal=method [PPI::Token::QuoteLike::Regexp] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa get_match_string=method get_substitute_string=method get_modifiers=method get_delimiters=method [PPI::Token::QuoteLike::Readline] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa [PPI::Token::Regexp] PPI::Token=isa PPI::Token::_QuoteEngine::Full=isa get_match_string=method get_substitute_string=method get_modifiers=method get_delimiters=method [PPI::Token::Regexp::Match] PPI::Token=isa [PPI::Token::Regexp::Substitute] PPI::Token=isa [PPI::Token::Regexp::Transliterate] PPI::Token=isa [PPI::Statement] PPI::Node=isa label=method specialized=method stable=method [PPI::Statement::Expression] PPI::Statement=isa [PPI::Statement::Package] PPI::Statement=isa namespace=method version=method file_scoped=method [PPI::Statement::Include] PPI::Statement=isa type=method arguments=method module=method module_version=method pragma=method version=method version_literal=method [PPI::Statement::Include::Perl6] PPI::Statement::Include=isa perl6=method [PPI::Statement::Sub] PPI::Statement=isa name=method prototype=method block=method forward=method reserved=method [PPI::Statement::Scheduled] PPI::Statement::Sub=isa PPI::Statement=isa type=method block=method [PPI::Statement::Variable] PPI::Statement=isa PPI::Statement::Expression=isa type=method variables=method symbols=method [PPI::Statement::Compound] PPI::Statement=isa type=method [PPI::Statement::Given] PPI::Statement=isa [PPI::Statement::When] PPI::Statement=isa [PPI::Statement::Break] PPI::Statement=isa [PPI::Statement::Null] PPI::Statement=isa [PPI::Statement::Data] PPI::Statement=isa [PPI::Statement::End] PPI::Statement=isa [PPI::Statement::Unknown] PPI::Statement=isa [PPI::Structure] PPI::Node=isa braces=method complete=method start=method finish=method [PPI::Structure::Block] PPI::Structure=isa [PPI::Structure::Subscript] PPI::Structure=isa [PPI::Structure::Constructor] PPI::Structure=isa [PPI::Structure::Condition] PPI::Structure=isa [PPI::Structure::List] PPI::Structure=isa [PPI::Structure::For] PPI::Structure=isa [PPI::Structure::Given] PPI::Structure=isa [PPI::Structure::When] PPI::Structure=isa [PPI::Structure::Unknown] PPI::Structure=isa [PPI::Document] PPI::Node=isa get_cache=method set_cache=method load=method save=method readonly=method tab_width=method serialize=method hex_id=method index_locations=method flush_locations=method normalized=method complete=method errstr=method STORABLE_freeze=method STORABLE_thaw=method [PPI::Document::Fragment] PPI::Document=isa ##################################################################### # Non-PDOM Classes [PPI] [PPI::Tokenizer] new=method get_token=method all_tokens=method increment_cursor=method decrement_cursor=method [PPI::Lexer] new=method lex_file=method lex_source=method lex_tokenizer=method errstr=method [PPI::Dumper] new=method print=method string=method list=method [PPI::Find] new=method clone=method in=method start=method match=method finish=method errstr=method [PPI::Transform] new=method document=method apply=method file=method [PPI::Normal] register=method new=method layer=method process=method [PPI::Normal::Standard] import=method remove_insignificant_elements=method remove_useless_attributes=method remove_useless_pragma=method remove_statement_separator=method remove_useless_return=method [PPI::Document::Normalized] new=method version=method functions=method equal=method pmv.t100644000000000000 163613511127601 14210 0ustar00unknownunknown000000000000PPI-1.270/xt#!/usr/bin/perl # Test that our declared minimum Perl version matches our syntax use strict; BEGIN { $| = 1; $^W = 1; } my @MODULES = ( 'File::Find::Rule 0.32', 'File::Find::Rule::Perl 1.09', 'Perl::MinimumVersion 1.25', 'Test::MinimumVersion 0.101080', ); # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing modules foreach my $MODULE ( @MODULES ) { if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } } all_minimum_version_from_metayml_ok( { paths => [ grep { ! /14_charsets/ and ! /24_v6/ } File::Find::Rule->perl_file->in('.') ], } ); META.yml100644000000000000 5056313511127601 14062 0ustar00unknownunknown000000000000PPI-1.270--- abstract: 'Parse, Analyze and Manipulate Perl (without perl)' author: - 'Adam Kennedy ' build_requires: B: '0' Class::Inspector: '1.22' Encode: '0' ExtUtils::MakeMaker: '0' File::Copy: '0' File::Spec: '0' File::Spec::Functions: '0' File::Spec::Unix: '0' File::Temp: '0' Test::Deep: '0' Test::More: '0.88' Test::NoWarnings: '0' Test::Object: '0.07' Test::SubCalls: '1.07' if: '0' lib: '0' utf8: '0' warnings: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: PPI provides: PPI: file: lib/PPI.pm version: '1.270' PPI::Cache: file: lib/PPI/Cache.pm version: '1.270' PPI::Document: file: lib/PPI/Document.pm version: '1.270' PPI::Document::File: file: lib/PPI/Document/File.pm version: '1.270' PPI::Document::Fragment: file: lib/PPI/Document/Fragment.pm version: '1.270' PPI::Document::Normalized: file: lib/PPI/Document/Normalized.pm version: '1.270' PPI::Dumper: file: lib/PPI/Dumper.pm version: '1.270' PPI::Element: file: lib/PPI/Element.pm version: '1.270' PPI::Exception: file: lib/PPI/Exception.pm version: '1.270' PPI::Exception::ParserRejection: file: lib/PPI/Exception/ParserRejection.pm version: '1.270' PPI::Find: file: lib/PPI/Find.pm version: '1.270' PPI::Lexer: file: lib/PPI/Lexer.pm version: '1.270' PPI::Node: file: lib/PPI/Node.pm version: '1.270' PPI::Normal: file: lib/PPI/Normal.pm version: '1.270' PPI::Normal::Standard: file: lib/PPI/Normal/Standard.pm version: '1.270' PPI::Singletons: file: lib/PPI/Singletons.pm version: '1.270' PPI::Statement: file: lib/PPI/Statement.pm version: '1.270' PPI::Statement::Break: file: lib/PPI/Statement/Break.pm version: '1.270' PPI::Statement::Compound: file: lib/PPI/Statement/Compound.pm version: '1.270' PPI::Statement::Data: file: lib/PPI/Statement/Data.pm version: '1.270' PPI::Statement::End: file: lib/PPI/Statement/End.pm version: '1.270' PPI::Statement::Expression: file: lib/PPI/Statement/Expression.pm version: '1.270' PPI::Statement::Given: file: lib/PPI/Statement/Given.pm version: '1.270' PPI::Statement::Include: file: lib/PPI/Statement/Include.pm version: '1.270' PPI::Statement::Include::Perl6: file: lib/PPI/Statement/Include/Perl6.pm version: '1.270' PPI::Statement::Null: file: lib/PPI/Statement/Null.pm version: '1.270' PPI::Statement::Package: file: lib/PPI/Statement/Package.pm version: '1.270' PPI::Statement::Scheduled: file: lib/PPI/Statement/Scheduled.pm version: '1.270' PPI::Statement::Sub: file: lib/PPI/Statement/Sub.pm version: '1.270' PPI::Statement::Unknown: file: lib/PPI/Statement/Unknown.pm version: '1.270' PPI::Statement::UnmatchedBrace: file: lib/PPI/Statement/UnmatchedBrace.pm version: '1.270' PPI::Statement::Variable: file: lib/PPI/Statement/Variable.pm version: '1.270' PPI::Statement::When: file: lib/PPI/Statement/When.pm version: '1.270' PPI::Structure: file: lib/PPI/Structure.pm version: '1.270' PPI::Structure::Block: file: lib/PPI/Structure/Block.pm version: '1.270' PPI::Structure::Condition: file: lib/PPI/Structure/Condition.pm version: '1.270' PPI::Structure::Constructor: file: lib/PPI/Structure/Constructor.pm version: '1.270' PPI::Structure::For: file: lib/PPI/Structure/For.pm version: '1.270' PPI::Structure::Given: file: lib/PPI/Structure/Given.pm version: '1.270' PPI::Structure::List: file: lib/PPI/Structure/List.pm version: '1.270' PPI::Structure::Subscript: file: lib/PPI/Structure/Subscript.pm version: '1.270' PPI::Structure::Unknown: file: lib/PPI/Structure/Unknown.pm version: '1.270' PPI::Structure::When: file: lib/PPI/Structure/When.pm version: '1.270' PPI::Token: file: lib/PPI/Token.pm version: '1.270' PPI::Token::ArrayIndex: file: lib/PPI/Token/ArrayIndex.pm version: '1.270' PPI::Token::Attribute: file: lib/PPI/Token/Attribute.pm version: '1.270' PPI::Token::BOM: file: lib/PPI/Token/BOM.pm version: '1.270' PPI::Token::Cast: file: lib/PPI/Token/Cast.pm version: '1.270' PPI::Token::Comment: file: lib/PPI/Token/Comment.pm version: '1.270' PPI::Token::DashedWord: file: lib/PPI/Token/DashedWord.pm version: '1.270' PPI::Token::Data: file: lib/PPI/Token/Data.pm version: '1.270' PPI::Token::End: file: lib/PPI/Token/End.pm version: '1.270' PPI::Token::HereDoc: file: lib/PPI/Token/HereDoc.pm version: '1.270' PPI::Token::Label: file: lib/PPI/Token/Label.pm version: '1.270' PPI::Token::Magic: file: lib/PPI/Token/Magic.pm version: '1.270' PPI::Token::Number: file: lib/PPI/Token/Number.pm version: '1.270' PPI::Token::Number::Binary: file: lib/PPI/Token/Number/Binary.pm version: '1.270' PPI::Token::Number::Exp: file: lib/PPI/Token/Number/Exp.pm version: '1.270' PPI::Token::Number::Float: file: lib/PPI/Token/Number/Float.pm version: '1.270' PPI::Token::Number::Hex: file: lib/PPI/Token/Number/Hex.pm version: '1.270' PPI::Token::Number::Octal: file: lib/PPI/Token/Number/Octal.pm version: '1.270' PPI::Token::Number::Version: file: lib/PPI/Token/Number/Version.pm version: '1.270' PPI::Token::Operator: file: lib/PPI/Token/Operator.pm version: '1.270' PPI::Token::Pod: file: lib/PPI/Token/Pod.pm version: '1.270' PPI::Token::Prototype: file: lib/PPI/Token/Prototype.pm version: '1.270' PPI::Token::Quote: file: lib/PPI/Token/Quote.pm version: '1.270' PPI::Token::Quote::Double: file: lib/PPI/Token/Quote/Double.pm version: '1.270' PPI::Token::Quote::Interpolate: file: lib/PPI/Token/Quote/Interpolate.pm version: '1.270' PPI::Token::Quote::Literal: file: lib/PPI/Token/Quote/Literal.pm version: '1.270' PPI::Token::Quote::Single: file: lib/PPI/Token/Quote/Single.pm version: '1.270' PPI::Token::QuoteLike: file: lib/PPI/Token/QuoteLike.pm version: '1.270' PPI::Token::QuoteLike::Backtick: file: lib/PPI/Token/QuoteLike/Backtick.pm version: '1.270' PPI::Token::QuoteLike::Command: file: lib/PPI/Token/QuoteLike/Command.pm version: '1.270' PPI::Token::QuoteLike::Readline: file: lib/PPI/Token/QuoteLike/Readline.pm version: '1.270' PPI::Token::QuoteLike::Regexp: file: lib/PPI/Token/QuoteLike/Regexp.pm version: '1.270' PPI::Token::QuoteLike::Words: file: lib/PPI/Token/QuoteLike/Words.pm version: '1.270' PPI::Token::Regexp: file: lib/PPI/Token/Regexp.pm version: '1.270' PPI::Token::Regexp::Match: file: lib/PPI/Token/Regexp/Match.pm version: '1.270' PPI::Token::Regexp::Substitute: file: lib/PPI/Token/Regexp/Substitute.pm version: '1.270' PPI::Token::Regexp::Transliterate: file: lib/PPI/Token/Regexp/Transliterate.pm version: '1.270' PPI::Token::Separator: file: lib/PPI/Token/Separator.pm version: '1.270' PPI::Token::Structure: file: lib/PPI/Token/Structure.pm version: '1.270' PPI::Token::Symbol: file: lib/PPI/Token/Symbol.pm version: '1.270' PPI::Token::Unknown: file: lib/PPI/Token/Unknown.pm version: '1.270' PPI::Token::Whitespace: file: lib/PPI/Token/Whitespace.pm version: '1.270' PPI::Token::Word: file: lib/PPI/Token/Word.pm version: '1.270' PPI::Tokenizer: file: lib/PPI/Tokenizer.pm version: '1.270' PPI::Transform: file: lib/PPI/Transform.pm version: '1.270' PPI::Transform::UpdateCopyright: file: lib/PPI/Transform/UpdateCopyright.pm version: '1.270' PPI::Util: file: lib/PPI/Util.pm version: '1.270' PPI::XSAccessor: file: lib/PPI/XSAccessor.pm version: '1.270' requires: Carp: '0' Clone: '0.30' Digest::MD5: '2.35' Exporter: '0' File::Path: '0' File::Spec: '0' IO::String: '1.07' List::Util: '1.33' Params::Util: '1.00' Scalar::Util: '0' Storable: '2.17' Task::Weaken: '0' constant: '0' overload: '0' perl: '5.006' strict: '0' resources: bugtracker: https://github.com/adamkennedy/PPI/issues homepage: https://github.com/adamkennedy/PPI repository: https://github.com/adamkennedy/PPI version: '1.270' x_Dist_Zilla: perl: version: '5.028000' plugins: - class: Dist::Zilla::Plugin::MetaResources name: MetaResources version: '6.012' - class: Dist::Zilla::Plugin::Encoding name: Encoding version: '6.012' - class: Dist::Zilla::Plugin::AutoPrereqs name: AutoPrereqs version: '6.012' - class: Dist::Zilla::Plugin::Prereqs config: Dist::Zilla::Plugin::Prereqs: phase: runtime type: requires name: Prereqs version: '6.012' - class: Dist::Zilla::Plugin::DynamicPrereqs config: Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000033' version: '0.006' name: DynamicPrereqs version: '0.034' - class: Dist::Zilla::Plugin::Git::NextVersion config: Dist::Zilla::Plugin::Git::NextVersion: first_version: '0.001' version_by_branch: 0 version_regexp: (?^u:^v([\d._]+)(-TRIAL)?$) Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: Git::NextVersion version: '2.046' - class: Dist::Zilla::Plugin::OurPkgVersion name: OurPkgVersion version: '0.12' - class: Dist::Zilla::Plugin::Git::GatherDir config: Dist::Zilla::Plugin::GatherDir: exclude_filename: - README.pod exclude_match: [] follow_symlinks: 0 include_dotfiles: 0 prefix: '' prune_directory: [] root: . Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: Git::GatherDir version: '2.046' - class: Dist::Zilla::Plugin::MetaYAML name: MetaYAML version: '6.012' - class: Dist::Zilla::Plugin::MetaJSON name: MetaJSON version: '6.012' - class: Dist::Zilla::Plugin::Readme name: Readme version: '6.012' - class: Dist::Zilla::Plugin::Manifest name: Manifest version: '6.012' - class: Dist::Zilla::Plugin::License name: License version: '6.012' - class: Dist::Zilla::Plugin::MakeMaker config: Dist::Zilla::Role::TestRunner: default_jobs: 1 name: MakeMaker version: '6.012' - class: Dist::Zilla::Plugin::Test::Compile config: Dist::Zilla::Plugin::Test::Compile: bail_out_on_fail: '1' fail_on_warning: author fake_home: 0 filename: xt/author/00-compile.t module_finder: - ':InstallModules' needs_display: 0 phase: develop script_finder: - ':PerlExecFiles' skips: [] switch: [] name: Test::Compile version: '2.058' - class: Dist::Zilla::Plugin::MetaTests name: MetaTests version: '6.012' - class: Dist::Zilla::Plugin::Test::ChangesHasContent name: Test::ChangesHasContent version: '0.011' - class: Dist::Zilla::Plugin::PodSyntaxTests name: PodSyntaxTests version: '6.012' - class: Dist::Zilla::Plugin::Test::Pod::No404s name: Test::Pod::No404s version: '1.004' - class: Dist::Zilla::Plugin::Test::Kwalitee config: Dist::Zilla::Plugin::Test::Kwalitee: filename: xt/author/kwalitee.t skiptest: [] name: Test::Kwalitee version: '2.12' - class: Dist::Zilla::Plugin::MojibakeTests name: MojibakeTests version: '0.8' - class: Dist::Zilla::Plugin::Test::ReportPrereqs name: Test::ReportPrereqs version: '0.027' - class: Dist::Zilla::Plugin::Test::Portability config: Dist::Zilla::Plugin::Test::Portability: options: '' name: Test::Portability version: '2.001000' - class: Dist::Zilla::Plugin::MetaProvides::Package config: Dist::Zilla::Plugin::MetaProvides::Package: finder_objects: - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM version: '6.012' include_underscores: 0 Dist::Zilla::Role::MetaProvider::Provider: $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' inherit_missing: '1' inherit_version: '1' meta_noindex: '1' Dist::Zilla::Role::ModuleMetadata: Module::Metadata: '1.000033' version: '0.006' name: MetaProvides::Package version: '2.004003' - class: Dist::Zilla::Plugin::MetaConfig name: MetaConfig version: '6.012' - class: Dist::Zilla::Plugin::Keywords config: Dist::Zilla::Plugin::Keywords: keywords: [] name: Keywords version: '0.007' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: git_version: 2.22.0.windows.1 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: Git::Contributors version: '0.035' - class: Dist::Zilla::Plugin::RunExtraTests config: Dist::Zilla::Role::TestRunner: default_jobs: 1 name: RunExtraTests version: '0.029' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: 'initial check' version: '2.046' - class: Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts config: Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: Git::CheckFor::MergeConflicts version: '0.014' - class: Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch config: Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: Git::CheckFor::CorrectBranch version: '0.014' - class: Dist::Zilla::Plugin::CheckPrereqsIndexed name: CheckPrereqsIndexed version: '0.020' - class: Dist::Zilla::Plugin::TestRelease name: TestRelease version: '6.012' - class: Dist::Zilla::Plugin::Git::Check config: Dist::Zilla::Plugin::Git::Check: untracked_files: die Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: 'after tests' version: '2.046' - class: Dist::Zilla::Plugin::UploadToCPAN name: UploadToCPAN version: '6.012' - class: Dist::Zilla::Plugin::CopyFilesFromRelease config: Dist::Zilla::Plugin::CopyFilesFromRelease: filename: - Changes match: [] name: CopyFilesFromRelease version: '0.006' - class: Dist::Zilla::Plugin::ReadmeAnyFromPod config: Dist::Zilla::Role::FileWatcher: version: '0.006' name: ReadmeAnyFromPod version: '0.163250' - class: Dist::Zilla::Plugin::NextRelease name: NextRelease version: '6.012' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: - . commit_msg: '%N-%v%t%n%n%c' Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes - dist.ini allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: 'release snapshot' version: '2.046' - class: Dist::Zilla::Plugin::Git::Tag config: Dist::Zilla::Plugin::Git::Tag: branch: ~ changelog: Changes signed: 0 tag: v1.270 tag_format: v%v tag_message: v%v%t Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: Git::Tag version: '2.046' - class: Dist::Zilla::Plugin::Git::Push config: Dist::Zilla::Plugin::Git::Push: push_to: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: git_version: 2.22.0.windows.1 repo_root: . name: Git::Push version: '2.046' - class: Dist::Zilla::Plugin::ConfirmRelease name: ConfirmRelease version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':IncModules' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':TestFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ExtraTestFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ExecFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':PerlExecFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':ShareFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':MainModule' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':AllFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: ':NoFiles' version: '6.012' - class: Dist::Zilla::Plugin::FinderCode name: MetaProvides::Package/AUTOVIV/:InstallModulesPM version: '6.012' zilla: class: Dist::Zilla::Dist::Builder config: is_trial: '0' version: '6.012' x_contributors: - 'Adam Kennedy ' - 'Arnout Pierre ' - 'bowtie ' - 'brian d foy ' - 'Chas. J. Owens IV ' - 'Chris Capaci ' - 'Chris Dolan ' - 'Christian Walde ' - 'Colin Newell ' - 'Damyan Ivanov ' - 'Dan Book ' - 'David Steinbrunner ' - 'Edmund Adjei ' - 'Elliot Shank ' - 'Gabor Szabo ' - 'Graham Ollis ' - 'Guillaume Aubert ' - 'Joel Maslak ' - 'Julian Fondren ' - 'Karen Etheridge ' - 'Kent Fredric ' - 'Lance Wicks ' - 'Matt Church ' - 'Matthew Horsfall ' - 'Mike ' - 'Milos Kukla ' - 'Mohammad S Anwar ' - 'Olivier Mengué ' - 'Philippe Bruhat (BooK) ' - 'Randy Lauen ' - 'Reini Urban ' - 'Shmuel Fomberg ' - 'Steffen Müller ' - 'Szymon Nieznański ' - 'Takumi Akiyama ' - 'Thomas Sibley ' - 'Tom Wyant ' - 'Van de Bugger ' - 'Will Braswell ' x_generated_by_perl: v5.28.0 x_serialization_backend: 'YAML::Tiny version 1.73' MANIFEST100644000000000000 2511513511127601 13735 0ustar00unknownunknown000000000000PPI-1.270# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.012. Changes LICENSE MANIFEST META.json META.yml Makefile.PL README dev_notes.txt dist.ini lib/PPI.pm lib/PPI/Cache.pm lib/PPI/Document.pm lib/PPI/Document/File.pm lib/PPI/Document/Fragment.pm lib/PPI/Document/Normalized.pm lib/PPI/Dumper.pm lib/PPI/Element.pm lib/PPI/Exception.pm lib/PPI/Exception/ParserRejection.pm lib/PPI/Find.pm lib/PPI/Lexer.pm lib/PPI/Node.pm lib/PPI/Normal.pm lib/PPI/Normal/Standard.pm lib/PPI/Singletons.pm lib/PPI/Statement.pm lib/PPI/Statement/Break.pm lib/PPI/Statement/Compound.pm lib/PPI/Statement/Data.pm lib/PPI/Statement/End.pm lib/PPI/Statement/Expression.pm lib/PPI/Statement/Given.pm lib/PPI/Statement/Include.pm lib/PPI/Statement/Include/Perl6.pm lib/PPI/Statement/Null.pm lib/PPI/Statement/Package.pm lib/PPI/Statement/Scheduled.pm lib/PPI/Statement/Sub.pm lib/PPI/Statement/Unknown.pm lib/PPI/Statement/UnmatchedBrace.pm lib/PPI/Statement/Variable.pm lib/PPI/Statement/When.pm lib/PPI/Structure.pm lib/PPI/Structure/Block.pm lib/PPI/Structure/Condition.pm lib/PPI/Structure/Constructor.pm lib/PPI/Structure/For.pm lib/PPI/Structure/Given.pm lib/PPI/Structure/List.pm lib/PPI/Structure/Subscript.pm lib/PPI/Structure/Unknown.pm lib/PPI/Structure/When.pm lib/PPI/Token.pm lib/PPI/Token/ArrayIndex.pm lib/PPI/Token/Attribute.pm lib/PPI/Token/BOM.pm lib/PPI/Token/Cast.pm lib/PPI/Token/Comment.pm lib/PPI/Token/DashedWord.pm lib/PPI/Token/Data.pm lib/PPI/Token/End.pm lib/PPI/Token/HereDoc.pm lib/PPI/Token/Label.pm lib/PPI/Token/Magic.pm lib/PPI/Token/Number.pm lib/PPI/Token/Number/Binary.pm lib/PPI/Token/Number/Exp.pm lib/PPI/Token/Number/Float.pm lib/PPI/Token/Number/Hex.pm lib/PPI/Token/Number/Octal.pm lib/PPI/Token/Number/Version.pm lib/PPI/Token/Operator.pm lib/PPI/Token/Pod.pm lib/PPI/Token/Prototype.pm lib/PPI/Token/Quote.pm lib/PPI/Token/Quote/Double.pm lib/PPI/Token/Quote/Interpolate.pm lib/PPI/Token/Quote/Literal.pm lib/PPI/Token/Quote/Single.pm lib/PPI/Token/QuoteLike.pm lib/PPI/Token/QuoteLike/Backtick.pm lib/PPI/Token/QuoteLike/Command.pm lib/PPI/Token/QuoteLike/Readline.pm lib/PPI/Token/QuoteLike/Regexp.pm lib/PPI/Token/QuoteLike/Words.pm lib/PPI/Token/Regexp.pm lib/PPI/Token/Regexp/Match.pm lib/PPI/Token/Regexp/Substitute.pm lib/PPI/Token/Regexp/Transliterate.pm lib/PPI/Token/Separator.pm lib/PPI/Token/Structure.pm lib/PPI/Token/Symbol.pm lib/PPI/Token/Unknown.pm lib/PPI/Token/Whitespace.pm lib/PPI/Token/Word.pm lib/PPI/Token/_QuoteEngine.pm lib/PPI/Token/_QuoteEngine/Full.pm lib/PPI/Token/_QuoteEngine/Simple.pm lib/PPI/Tokenizer.pm lib/PPI/Transform.pm lib/PPI/Transform/UpdateCopyright.pm lib/PPI/Util.pm lib/PPI/XSAccessor.pm t/00-report-prereqs.dd t/00-report-prereqs.t t/01_compile.t t/03_document.t t/04_element.t t/05_lexer.t t/06_round_trip.t t/07_token.t t/08_regression.t t/09_normal.t t/10_statement.t t/11_util.t t/12_location.t t/13_data.t t/14_charsets.t t/15_transform.t t/16_xml.t t/17_storable.t t/18_cache.t t/19_selftesting.t t/21_exhaustive.t t/22_readonly.t t/23_file.t t/24_v6.t t/25_increment.t t/26_bom.t t/27_complete.t t/28_foreach_qw.t t/29_logical_filename.t t/data/03_document/empty.dat t/data/03_document/test.dat t/data/05_lexer/01_simpleassign.code t/data/05_lexer/01_simpleassign.dump t/data/05_lexer/02_END.code t/data/05_lexer/02_END.dump t/data/05_lexer/03_subroutine_attributes.code t/data/05_lexer/03_subroutine_attributes.dump t/data/05_lexer/04_anonymous_subroutines.code t/data/05_lexer/04_anonymous_subroutines.dump t/data/05_lexer/05_compound_loops.code t/data/05_lexer/05_compound_loops.dump t/data/05_lexer/06_subroutine_prototypes.code t/data/05_lexer/06_subroutine_prototypes.dump t/data/05_lexer/07_unmatched_braces.code t/data/05_lexer/07_unmatched_braces.dump t/data/05_lexer/08_subroutines.code t/data/05_lexer/08_subroutines.dump t/data/05_lexer/09_heredoc.code t/data/05_lexer/09_heredoc.dump t/data/05_lexer/10_readline.code t/data/05_lexer/10_readline.dump t/data/05_lexer/11_dor.code t/data/05_lexer/11_dor.dump t/data/05_lexer/12_switch.code t/data/05_lexer/12_switch.dump t/data/05_lexer/13_braces_in_parens.code t/data/05_lexer/13_braces_in_parens.dump t/data/07_token/exp.code t/data/07_token/exp.dump t/data/07_token/exp1.code t/data/07_token/exp1.dump t/data/07_token/exp2.code t/data/07_token/exp2.dump t/data/07_token/exp3.code t/data/07_token/exp3.dump t/data/07_token/exp4.code t/data/07_token/exp4.dump t/data/07_token/exp5.code t/data/07_token/exp5.dump t/data/07_token/exp6.code t/data/07_token/exp6.dump t/data/07_token/exp7.code t/data/07_token/exp7.dump t/data/07_token/exp8.code t/data/07_token/exp8.dump t/data/07_token/hex.code t/data/07_token/hex.dump t/data/07_token/range_operator.code t/data/07_token/range_operator.dump t/data/07_token/smart_match.code t/data/07_token/smart_match.dump t/data/08_regression/01_rt_cpan_19629.code t/data/08_regression/01_rt_cpan_19629.dump t/data/08_regression/01_rt_cpan_19629b.code t/data/08_regression/01_rt_cpan_19629b.dump t/data/08_regression/02_rt_cpan_9582.code t/data/08_regression/02_rt_cpan_9582.dump t/data/08_regression/03_rt_cpan_9614.code t/data/08_regression/03_rt_cpan_9614.dump t/data/08_regression/04_tinderbox.code t/data/08_regression/04_tinderbox.dump t/data/08_regression/05_rt_cpan_13425.code t/data/08_regression/05_rt_cpan_13425.dump t/data/08_regression/06_partial_quote_double.code t/data/08_regression/06_partial_quote_double.dump t/data/08_regression/07_partial_quote_single.code t/data/08_regression/07_partial_quote_single.dump t/data/08_regression/08_partial_regex_substitution.code t/data/08_regression/08_partial_regex_substitution.dump t/data/08_regression/09_for_var.code t/data/08_regression/09_for_var.dump t/data/08_regression/10_leading_regexp.code t/data/08_regression/10_leading_regexp.dump t/data/08_regression/11_multiply_vs_glob_cast.code t/data/08_regression/11_multiply_vs_glob_cast.dump t/data/08_regression/12_pow.code t/data/08_regression/12_pow.dump t/data/08_regression/13_goto.code t/data/08_regression/13_goto.dump t/data/08_regression/14_minus.code t/data/08_regression/14_minus.dump t/data/08_regression/14b_minus.code t/data/08_regression/14b_minus.dump t/data/08_regression/15_dash_t.code t/data/08_regression/15_dash_t.dump t/data/08_regression/16_sub_declaration.code t/data/08_regression/16_sub_declaration.dump t/data/08_regression/17_scope.code t/data/08_regression/17_scope.dump t/data/08_regression/18_decimal_point.code t/data/08_regression/18_decimal_point.dump t/data/08_regression/19_long_operators.code t/data/08_regression/19_long_operators.dump t/data/08_regression/19_long_operators2.code t/data/08_regression/19_long_operators2.dump t/data/08_regression/20_hash_constructor.code t/data/08_regression/20_hash_constructor.dump t/data/08_regression/21_list_of_refs.code t/data/08_regression/21_list_of_refs.dump t/data/08_regression/22_hash_vs_brace.code t/data/08_regression/22_hash_vs_brace.dump t/data/08_regression/23_rt_cpan_8752.code t/data/08_regression/23_rt_cpan_8752.dump t/data/08_regression/24_compound.code t/data/08_regression/24_compound.dump t/data/08_regression/25_hash_block.code t/data/08_regression/25_hash_block.dump t/data/08_regression/26_rt_cpan_23253.code t/data/08_regression/26_rt_cpan_23253.dump t/data/08_regression/27_constant_hash.code t/data/08_regression/27_constant_hash.dump t/data/08_regression/28_backref_style_heredoc.code t/data/08_regression/28_backref_style_heredoc.dump t/data/08_regression/29_chained_casts.code t/data/08_regression/29_chained_casts.dump t/data/08_regression/29_magic_carat.code t/data/08_regression/29_magic_carat.dump t/data/08_regression/30_hash_bang.code t/data/08_regression/30_hash_bang.dump t/data/08_regression/31_hash_carat_H.code t/data/08_regression/31_hash_carat_H.dump t/data/08_regression/32_readline.code t/data/08_regression/32_readline.dump t/data/08_regression/33_magic_carat_long.code t/data/08_regression/33_magic_carat_long.dump t/data/08_regression/34_attr_whitespace.code t/data/08_regression/34_attr_whitespace.dump t/data/08_regression/35_attr_perlsub.code t/data/08_regression/35_attr_perlsub.dump t/data/08_regression/36_begin_label.code t/data/08_regression/36_begin_label.dump t/data/08_regression/37_partial_prototype.code t/data/08_regression/37_partial_prototype.dump t/data/08_regression/38_multiply.code t/data/08_regression/38_multiply.dump t/data/08_regression/39_foreach_our.code t/data/08_regression/39_foreach_our.dump t/data/08_regression/40_foreach_eval.code t/data/08_regression/40_foreach_eval.dump t/data/08_regression/41_scalar_hash.code t/data/08_regression/41_scalar_hash.dump t/data/08_regression/42_numeric_package.code t/data/08_regression/42_numeric_package.dump t/data/08_regression/43_nonblock_map.code t/data/08_regression/43_nonblock_map.dump t/data/08_regression/44_vstrings.code t/data/08_regression/44_vstrings.dump t/data/08_regression/45_heredoc_w_paren_in_terminator.code t/data/08_regression/45_heredoc_w_paren_in_terminator.dump t/data/08_regression/46_heredoc_w_paren_in_terminator.code t/data/08_regression/46_heredoc_w_paren_in_terminator.dump t/data/08_regression/47_heredoc_w_paren_in_terminator.code t/data/08_regression/47_heredoc_w_paren_in_terminator.dump t/data/08_regression/48_heredoc_w_paren_in_terminator.code t/data/08_regression/48_heredoc_w_paren_in_terminator.dump t/data/11_util/test.pm t/data/13_data/Foo.pm t/data/15_transform/sample1.pm t/data/15_transform/sample1.pm_out t/data/24_v6/Grammar.pm t/data/24_v6/Simple.pm t/data/26_bom/utf8.code t/data/26_bom/utf8.dump t/data/27_complete/01y_helloworld.code t/data/27_complete/02n_helloworld.code t/data/basic.pl t/data/filename.pl t/data/test2.txt t/interactive.t t/lib/Helper.pm t/lib/PPI/Test.pm t/lib/PPI/Test/Object.pm t/lib/PPI/Test/Run.pm t/lib/PPI/Test/pragmas.pm t/marpa.t t/ppi_element.t t/ppi_lexer.t t/ppi_node.t t/ppi_normal.t t/ppi_statement.t t/ppi_statement_compound.t t/ppi_statement_include.t t/ppi_statement_package.t t/ppi_statement_scheduled.t t/ppi_statement_sub.t t/ppi_statement_variable.t t/ppi_token.t t/ppi_token__quoteengine_full.t t/ppi_token_attribute.t t/ppi_token_dashedword.t t/ppi_token_heredoc.t t/ppi_token_magic.t t/ppi_token_number_version.t t/ppi_token_operator.t t/ppi_token_pod.t t/ppi_token_prototype.t t/ppi_token_quote.t t/ppi_token_quote_double.t t/ppi_token_quote_interpolate.t t/ppi_token_quote_literal.t t/ppi_token_quote_single.t t/ppi_token_quotelike_regexp.t t/ppi_token_quotelike_words.t t/ppi_token_regexp.t t/ppi_token_structure.t t/ppi_token_symbol.t t/ppi_token_unknown.t t/ppi_token_whitespace.t t/ppi_token_word.t xt/api.t xt/author.t xt/author/00-compile.t xt/author/kwalitee.t xt/author/mojibake.t xt/author/pod-no404s.t xt/author/pod-syntax.t xt/author/portability.t xt/meta.t xt/pmv.t xt/release/changes_has_content.t xt/release/distmeta.t t000755000000000000 013511127601 12663 5ustar00unknownunknown000000000000PPI-1.27024_v6.t100644000000000000 133313511127601 14050 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Regression test of a Perl 5 grammar that exploded # with a "98 subroutine recursion" error in 1.201 use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; foreach my $file ( qw{ Simple.pm Grammar.pm } ) { my $path = catfile( qw{ t data 24_v6 }, $file ); ok( -f $path, "Found test file $file" ); my $doc = PPI::Document->new( $path ); isa_ok( $doc, 'PPI::Document' ); # Find the first Perl6 include my $include = $doc->find_first( 'PPI::Statement::Include::Perl6' ); isa_ok( $include, 'PPI::Statement::Include::Perl6' ); ok( scalar($include->perl6), 'use v6 statement has a working ->perl6 method', ); } marpa.t100644000000000000 2304013511127601 14327 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token::Unknown use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 23 + ( $ENV{AUTHOR_TESTING} ? 1 : 0 ); use B 'perlstring'; use PPI; test_statement( 'use v5 ;', [ 'PPI::Statement::Include' => 'use v5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 ;', [ 'PPI::Statement::Include' => 'use 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 ;', [ 'PPI::Statement::Include' => 'use 5.1 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz () ;', [ 'PPI::Statement::Include' => 'use xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz () ;', [ 'PPI::Statement::Include' => 'use v5 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz () ;', [ 'PPI::Statement::Include' => 'use 5 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz () ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 () ;', [ 'PPI::Statement::Include' => 'use xyz v5 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 () ;', [ 'PPI::Statement::Include' => 'use xyz 5 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 () ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 () ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Structure::List' => '()', 'PPI::Token::Structure' => '(', 'PPI::Token::Structure' => ')', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz 5 ;', [ 'PPI::Statement::Include' => 'use v5 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz 5 ;', [ 'PPI::Statement::Include' => 'use 5 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz 5 ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 5 ;', [ 'PPI::Statement::Include' => 'use xyz v5 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 5 ;', [ 'PPI::Statement::Include' => 'use xyz 5 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 5 ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use v5 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use v5 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use 5 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number' => '5', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use 5.1 xyz 5,5 ;', [ 'PPI::Statement::Include' => 'use 5.1 xyz 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz v5 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz v5 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Version' => 'v5', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz 5 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number' => '5', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 5,5 ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 5,5 ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Number' => '5', 'PPI::Token::Operator' => ',', 'PPI::Token::Number' => '5', 'PPI::Token::Structure' => ';' ] ); test_statement( 'use xyz 5.1 @a ;', [ 'PPI::Statement::Include' => 'use xyz 5.1 @a ;', 'PPI::Token::Word' => 'use', 'PPI::Token::Word' => 'xyz', 'PPI::Token::Number::Float' => '5.1', 'PPI::Token::Symbol' => '@a', 'PPI::Token::Structure' => ';' ] ); sub one_line_explain { my ( $data ) = @_; my @explain = explain $data; s/\n//g for @explain; return join "", @explain; } sub main_level_line { return "" if not $TODO; my @outer_final; my $level = 0; while ( my @outer = caller( $level++ ) ) { @outer_final = @outer; } return "l $outer_final[2] - "; } sub test_statement { local $Test::Builder::Level = $Test::Builder::Level + 1; my ( $code, $expected, $msg ) = @_; $msg = perlstring $code if !defined $msg; my $d = PPI::Document->new( \$code ); my $tokens = $d->find( sub { $_[1]->significant } ); $tokens = [ map { ref( $_ ), $_->content } @$tokens ]; if ( $expected->[0] !~ /^PPI::Statement/ ) { $expected = [ 'PPI::Statement', $code, @$expected ]; } my $ok = is_deeply( $tokens, $expected, main_level_line . $msg ); if ( !$ok ) { diag ">>> $code -- $msg\n"; diag "GOT: " . one_line_explain $tokens; diag "EXP: " . one_line_explain $expected; } return; } meta.t100644000000000000 107313511127601 14327 0ustar00unknownunknown000000000000PPI-1.270/xt#!/usr/bin/perl # Test that our META.yml file matches the current specification. use strict; BEGIN { $| = 1; $^W = 1; } my $MODULE = 'Test::CPAN::Meta 0.17'; # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing module if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } meta_yaml_ok(); META.json100644000000000000 7571113511127601 14234 0ustar00unknownunknown000000000000PPI-1.270{ "abstract" : "Parse, Analyze and Manipulate Perl (without perl)", "author" : [ "Adam Kennedy " ], "dynamic_config" : 1, "generated_by" : "Dist::Zilla version 6.012, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "PPI", "prereqs" : { "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Encode" : "0", "File::Spec" : "0", "IO::Handle" : "0", "IPC::Open3" : "0", "Test::CPAN::Meta" : "0", "Test::ClassAPI" : "0", "Test::Kwalitee" : "1.21", "Test::Mojibake" : "0", "Test::More" : "0.94", "Test::Pod" : "1.41", "Test::Pod::No404s" : "0", "Test::Portability::Files" : "0", "lib" : "0", "warnings" : "0" } }, "runtime" : { "requires" : { "Carp" : "0", "Clone" : "0.30", "Digest::MD5" : "2.35", "Exporter" : "0", "File::Path" : "0", "File::Spec" : "0", "IO::String" : "1.07", "List::Util" : "1.33", "Params::Util" : "1.00", "Scalar::Util" : "0", "Storable" : "2.17", "Task::Weaken" : "0", "constant" : "0", "overload" : "0", "perl" : "5.006", "strict" : "0" } }, "test" : { "recommends" : { "CPAN::Meta" : "2.120900" }, "requires" : { "B" : "0", "Class::Inspector" : "1.22", "Encode" : "0", "ExtUtils::MakeMaker" : "0", "File::Copy" : "0", "File::Spec" : "0", "File::Spec::Functions" : "0", "File::Spec::Unix" : "0", "File::Temp" : "0", "Test::Deep" : "0", "Test::More" : "0.88", "Test::NoWarnings" : "0", "Test::Object" : "0.07", "Test::SubCalls" : "1.07", "if" : "0", "lib" : "0", "utf8" : "0", "warnings" : "0" } } }, "provides" : { "PPI" : { "file" : "lib/PPI.pm", "version" : "1.270" }, "PPI::Cache" : { "file" : "lib/PPI/Cache.pm", "version" : "1.270" }, "PPI::Document" : { "file" : "lib/PPI/Document.pm", "version" : "1.270" }, "PPI::Document::File" : { "file" : "lib/PPI/Document/File.pm", "version" : "1.270" }, "PPI::Document::Fragment" : { "file" : "lib/PPI/Document/Fragment.pm", "version" : "1.270" }, "PPI::Document::Normalized" : { "file" : "lib/PPI/Document/Normalized.pm", "version" : "1.270" }, "PPI::Dumper" : { "file" : "lib/PPI/Dumper.pm", "version" : "1.270" }, "PPI::Element" : { "file" : "lib/PPI/Element.pm", "version" : "1.270" }, "PPI::Exception" : { "file" : "lib/PPI/Exception.pm", "version" : "1.270" }, "PPI::Exception::ParserRejection" : { "file" : "lib/PPI/Exception/ParserRejection.pm", "version" : "1.270" }, "PPI::Find" : { "file" : "lib/PPI/Find.pm", "version" : "1.270" }, "PPI::Lexer" : { "file" : "lib/PPI/Lexer.pm", "version" : "1.270" }, "PPI::Node" : { "file" : "lib/PPI/Node.pm", "version" : "1.270" }, "PPI::Normal" : { "file" : "lib/PPI/Normal.pm", "version" : "1.270" }, "PPI::Normal::Standard" : { "file" : "lib/PPI/Normal/Standard.pm", "version" : "1.270" }, "PPI::Singletons" : { "file" : "lib/PPI/Singletons.pm", "version" : "1.270" }, "PPI::Statement" : { "file" : "lib/PPI/Statement.pm", "version" : "1.270" }, "PPI::Statement::Break" : { "file" : "lib/PPI/Statement/Break.pm", "version" : "1.270" }, "PPI::Statement::Compound" : { "file" : "lib/PPI/Statement/Compound.pm", "version" : "1.270" }, "PPI::Statement::Data" : { "file" : "lib/PPI/Statement/Data.pm", "version" : "1.270" }, "PPI::Statement::End" : { "file" : "lib/PPI/Statement/End.pm", "version" : "1.270" }, "PPI::Statement::Expression" : { "file" : "lib/PPI/Statement/Expression.pm", "version" : "1.270" }, "PPI::Statement::Given" : { "file" : "lib/PPI/Statement/Given.pm", "version" : "1.270" }, "PPI::Statement::Include" : { "file" : "lib/PPI/Statement/Include.pm", "version" : "1.270" }, "PPI::Statement::Include::Perl6" : { "file" : "lib/PPI/Statement/Include/Perl6.pm", "version" : "1.270" }, "PPI::Statement::Null" : { "file" : "lib/PPI/Statement/Null.pm", "version" : "1.270" }, "PPI::Statement::Package" : { "file" : "lib/PPI/Statement/Package.pm", "version" : "1.270" }, "PPI::Statement::Scheduled" : { "file" : "lib/PPI/Statement/Scheduled.pm", "version" : "1.270" }, "PPI::Statement::Sub" : { "file" : "lib/PPI/Statement/Sub.pm", "version" : "1.270" }, "PPI::Statement::Unknown" : { "file" : "lib/PPI/Statement/Unknown.pm", "version" : "1.270" }, "PPI::Statement::UnmatchedBrace" : { "file" : "lib/PPI/Statement/UnmatchedBrace.pm", "version" : "1.270" }, "PPI::Statement::Variable" : { "file" : "lib/PPI/Statement/Variable.pm", "version" : "1.270" }, "PPI::Statement::When" : { "file" : "lib/PPI/Statement/When.pm", "version" : "1.270" }, "PPI::Structure" : { "file" : "lib/PPI/Structure.pm", "version" : "1.270" }, "PPI::Structure::Block" : { "file" : "lib/PPI/Structure/Block.pm", "version" : "1.270" }, "PPI::Structure::Condition" : { "file" : "lib/PPI/Structure/Condition.pm", "version" : "1.270" }, "PPI::Structure::Constructor" : { "file" : "lib/PPI/Structure/Constructor.pm", "version" : "1.270" }, "PPI::Structure::For" : { "file" : "lib/PPI/Structure/For.pm", "version" : "1.270" }, "PPI::Structure::Given" : { "file" : "lib/PPI/Structure/Given.pm", "version" : "1.270" }, "PPI::Structure::List" : { "file" : "lib/PPI/Structure/List.pm", "version" : "1.270" }, "PPI::Structure::Subscript" : { "file" : "lib/PPI/Structure/Subscript.pm", "version" : "1.270" }, "PPI::Structure::Unknown" : { "file" : "lib/PPI/Structure/Unknown.pm", "version" : "1.270" }, "PPI::Structure::When" : { "file" : "lib/PPI/Structure/When.pm", "version" : "1.270" }, "PPI::Token" : { "file" : "lib/PPI/Token.pm", "version" : "1.270" }, "PPI::Token::ArrayIndex" : { "file" : "lib/PPI/Token/ArrayIndex.pm", "version" : "1.270" }, "PPI::Token::Attribute" : { "file" : "lib/PPI/Token/Attribute.pm", "version" : "1.270" }, "PPI::Token::BOM" : { "file" : "lib/PPI/Token/BOM.pm", "version" : "1.270" }, "PPI::Token::Cast" : { "file" : "lib/PPI/Token/Cast.pm", "version" : "1.270" }, "PPI::Token::Comment" : { "file" : "lib/PPI/Token/Comment.pm", "version" : "1.270" }, "PPI::Token::DashedWord" : { "file" : "lib/PPI/Token/DashedWord.pm", "version" : "1.270" }, "PPI::Token::Data" : { "file" : "lib/PPI/Token/Data.pm", "version" : "1.270" }, "PPI::Token::End" : { "file" : "lib/PPI/Token/End.pm", "version" : "1.270" }, "PPI::Token::HereDoc" : { "file" : "lib/PPI/Token/HereDoc.pm", "version" : "1.270" }, "PPI::Token::Label" : { "file" : "lib/PPI/Token/Label.pm", "version" : "1.270" }, "PPI::Token::Magic" : { "file" : "lib/PPI/Token/Magic.pm", "version" : "1.270" }, "PPI::Token::Number" : { "file" : "lib/PPI/Token/Number.pm", "version" : "1.270" }, "PPI::Token::Number::Binary" : { "file" : "lib/PPI/Token/Number/Binary.pm", "version" : "1.270" }, "PPI::Token::Number::Exp" : { "file" : "lib/PPI/Token/Number/Exp.pm", "version" : "1.270" }, "PPI::Token::Number::Float" : { "file" : "lib/PPI/Token/Number/Float.pm", "version" : "1.270" }, "PPI::Token::Number::Hex" : { "file" : "lib/PPI/Token/Number/Hex.pm", "version" : "1.270" }, "PPI::Token::Number::Octal" : { "file" : "lib/PPI/Token/Number/Octal.pm", "version" : "1.270" }, "PPI::Token::Number::Version" : { "file" : "lib/PPI/Token/Number/Version.pm", "version" : "1.270" }, "PPI::Token::Operator" : { "file" : "lib/PPI/Token/Operator.pm", "version" : "1.270" }, "PPI::Token::Pod" : { "file" : "lib/PPI/Token/Pod.pm", "version" : "1.270" }, "PPI::Token::Prototype" : { "file" : "lib/PPI/Token/Prototype.pm", "version" : "1.270" }, "PPI::Token::Quote" : { "file" : "lib/PPI/Token/Quote.pm", "version" : "1.270" }, "PPI::Token::Quote::Double" : { "file" : "lib/PPI/Token/Quote/Double.pm", "version" : "1.270" }, "PPI::Token::Quote::Interpolate" : { "file" : "lib/PPI/Token/Quote/Interpolate.pm", "version" : "1.270" }, "PPI::Token::Quote::Literal" : { "file" : "lib/PPI/Token/Quote/Literal.pm", "version" : "1.270" }, "PPI::Token::Quote::Single" : { "file" : "lib/PPI/Token/Quote/Single.pm", "version" : "1.270" }, "PPI::Token::QuoteLike" : { "file" : "lib/PPI/Token/QuoteLike.pm", "version" : "1.270" }, "PPI::Token::QuoteLike::Backtick" : { "file" : "lib/PPI/Token/QuoteLike/Backtick.pm", "version" : "1.270" }, "PPI::Token::QuoteLike::Command" : { "file" : "lib/PPI/Token/QuoteLike/Command.pm", "version" : "1.270" }, "PPI::Token::QuoteLike::Readline" : { "file" : "lib/PPI/Token/QuoteLike/Readline.pm", "version" : "1.270" }, "PPI::Token::QuoteLike::Regexp" : { "file" : "lib/PPI/Token/QuoteLike/Regexp.pm", "version" : "1.270" }, "PPI::Token::QuoteLike::Words" : { "file" : "lib/PPI/Token/QuoteLike/Words.pm", "version" : "1.270" }, "PPI::Token::Regexp" : { "file" : "lib/PPI/Token/Regexp.pm", "version" : "1.270" }, "PPI::Token::Regexp::Match" : { "file" : "lib/PPI/Token/Regexp/Match.pm", "version" : "1.270" }, "PPI::Token::Regexp::Substitute" : { "file" : "lib/PPI/Token/Regexp/Substitute.pm", "version" : "1.270" }, "PPI::Token::Regexp::Transliterate" : { "file" : "lib/PPI/Token/Regexp/Transliterate.pm", "version" : "1.270" }, "PPI::Token::Separator" : { "file" : "lib/PPI/Token/Separator.pm", "version" : "1.270" }, "PPI::Token::Structure" : { "file" : "lib/PPI/Token/Structure.pm", "version" : "1.270" }, "PPI::Token::Symbol" : { "file" : "lib/PPI/Token/Symbol.pm", "version" : "1.270" }, "PPI::Token::Unknown" : { "file" : "lib/PPI/Token/Unknown.pm", "version" : "1.270" }, "PPI::Token::Whitespace" : { "file" : "lib/PPI/Token/Whitespace.pm", "version" : "1.270" }, "PPI::Token::Word" : { "file" : "lib/PPI/Token/Word.pm", "version" : "1.270" }, "PPI::Tokenizer" : { "file" : "lib/PPI/Tokenizer.pm", "version" : "1.270" }, "PPI::Transform" : { "file" : "lib/PPI/Transform.pm", "version" : "1.270" }, "PPI::Transform::UpdateCopyright" : { "file" : "lib/PPI/Transform/UpdateCopyright.pm", "version" : "1.270" }, "PPI::Util" : { "file" : "lib/PPI/Util.pm", "version" : "1.270" }, "PPI::XSAccessor" : { "file" : "lib/PPI/XSAccessor.pm", "version" : "1.270" } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/adamkennedy/PPI/issues" }, "homepage" : "https://github.com/adamkennedy/PPI", "repository" : { "url" : "https://github.com/adamkennedy/PPI" } }, "version" : "1.270", "x_Dist_Zilla" : { "perl" : { "version" : "5.028000" }, "plugins" : [ { "class" : "Dist::Zilla::Plugin::MetaResources", "name" : "MetaResources", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Encoding", "name" : "Encoding", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::AutoPrereqs", "name" : "AutoPrereqs", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { "Dist::Zilla::Plugin::Prereqs" : { "phase" : "runtime", "type" : "requires" } }, "name" : "Prereqs", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::DynamicPrereqs", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000033", "version" : "0.006" } }, "name" : "DynamicPrereqs", "version" : "0.034" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", "config" : { "Dist::Zilla::Plugin::Git::NextVersion" : { "first_version" : "0.001", "version_by_branch" : 0, "version_regexp" : "(?^u:^v([\\d._]+)(-TRIAL)?$)" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "Git::NextVersion", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::OurPkgVersion", "name" : "OurPkgVersion", "version" : "0.12" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", "config" : { "Dist::Zilla::Plugin::GatherDir" : { "exclude_filename" : [ "README.pod" ], "exclude_match" : [], "follow_symlinks" : 0, "include_dotfiles" : 0, "prefix" : "", "prune_directory" : [], "root" : "." }, "Dist::Zilla::Plugin::Git::GatherDir" : { "include_untracked" : 0 } }, "name" : "Git::GatherDir", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", "name" : "MetaYAML", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MetaJSON", "name" : "MetaJSON", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Readme", "name" : "Readme", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Manifest", "name" : "Manifest", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::License", "name" : "License", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::MakeMaker", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1 } }, "name" : "MakeMaker", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Test::Compile", "config" : { "Dist::Zilla::Plugin::Test::Compile" : { "bail_out_on_fail" : "1", "fail_on_warning" : "author", "fake_home" : 0, "filename" : "xt/author/00-compile.t", "module_finder" : [ ":InstallModules" ], "needs_display" : 0, "phase" : "develop", "script_finder" : [ ":PerlExecFiles" ], "skips" : [], "switch" : [] } }, "name" : "Test::Compile", "version" : "2.058" }, { "class" : "Dist::Zilla::Plugin::MetaTests", "name" : "MetaTests", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Test::ChangesHasContent", "name" : "Test::ChangesHasContent", "version" : "0.011" }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "PodSyntaxTests", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Test::Pod::No404s", "name" : "Test::Pod::No404s", "version" : "1.004" }, { "class" : "Dist::Zilla::Plugin::Test::Kwalitee", "config" : { "Dist::Zilla::Plugin::Test::Kwalitee" : { "filename" : "xt/author/kwalitee.t", "skiptest" : [] } }, "name" : "Test::Kwalitee", "version" : "2.12" }, { "class" : "Dist::Zilla::Plugin::MojibakeTests", "name" : "MojibakeTests", "version" : "0.8" }, { "class" : "Dist::Zilla::Plugin::Test::ReportPrereqs", "name" : "Test::ReportPrereqs", "version" : "0.027" }, { "class" : "Dist::Zilla::Plugin::Test::Portability", "config" : { "Dist::Zilla::Plugin::Test::Portability" : { "options" : "" } }, "name" : "Test::Portability", "version" : "2.001000" }, { "class" : "Dist::Zilla::Plugin::MetaProvides::Package", "config" : { "Dist::Zilla::Plugin::MetaProvides::Package" : { "finder_objects" : [ { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.012" } ], "include_underscores" : 0 }, "Dist::Zilla::Role::MetaProvider::Provider" : { "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", "inherit_missing" : 1, "inherit_version" : 1, "meta_noindex" : 1 }, "Dist::Zilla::Role::ModuleMetadata" : { "Module::Metadata" : "1.000033", "version" : "0.006" } }, "name" : "MetaProvides::Package", "version" : "2.004003" }, { "class" : "Dist::Zilla::Plugin::MetaConfig", "name" : "MetaConfig", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Keywords", "config" : { "Dist::Zilla::Plugin::Keywords" : { "keywords" : [] } }, "name" : "Keywords", "version" : "0.007" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { "git_version" : "2.22.0.windows.1", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", "paths" : [] } }, "name" : "Git::Contributors", "version" : "0.035" }, { "class" : "Dist::Zilla::Plugin::RunExtraTests", "config" : { "Dist::Zilla::Role::TestRunner" : { "default_jobs" : 1 } }, "name" : "RunExtraTests", "version" : "0.029" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "initial check", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::MergeConflicts", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "Git::CheckFor::MergeConflicts", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::Git::CheckFor::CorrectBranch", "config" : { "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "Git::CheckFor::CorrectBranch", "version" : "0.014" }, { "class" : "Dist::Zilla::Plugin::CheckPrereqsIndexed", "name" : "CheckPrereqsIndexed", "version" : "0.020" }, { "class" : "Dist::Zilla::Plugin::TestRelease", "name" : "TestRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Git::Check", "config" : { "Dist::Zilla::Plugin::Git::Check" : { "untracked_files" : "die" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "after tests", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::UploadToCPAN", "name" : "UploadToCPAN", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::CopyFilesFromRelease", "config" : { "Dist::Zilla::Plugin::CopyFilesFromRelease" : { "filename" : [ "Changes" ], "match" : [] } }, "name" : "CopyFilesFromRelease", "version" : "0.006" }, { "class" : "Dist::Zilla::Plugin::ReadmeAnyFromPod", "config" : { "Dist::Zilla::Role::FileWatcher" : { "version" : "0.006" } }, "name" : "ReadmeAnyFromPod", "version" : "0.163250" }, { "class" : "Dist::Zilla::Plugin::NextRelease", "name" : "NextRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [ "." ], "commit_msg" : "%N-%v%t%n%n%c" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ "Changes", "dist.ini" ], "allow_dirty_match" : [], "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "release snapshot", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", "config" : { "Dist::Zilla::Plugin::Git::Tag" : { "branch" : null, "changelog" : "Changes", "signed" : 0, "tag" : "v1.270", "tag_format" : "v%v", "tag_message" : "v%v%t" }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { "time_zone" : "local" } }, "name" : "Git::Tag", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Push", "config" : { "Dist::Zilla::Plugin::Git::Push" : { "push_to" : [ "origin" ], "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { "git_version" : "2.22.0.windows.1", "repo_root" : "." } }, "name" : "Git::Push", "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "ConfirmRelease", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":InstallModules", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":IncModules", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":TestFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExtraTestFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ExecFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":PerlExecFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":ShareFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":MainModule", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":AllFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : ":NoFiles", "version" : "6.012" }, { "class" : "Dist::Zilla::Plugin::FinderCode", "name" : "MetaProvides::Package/AUTOVIV/:InstallModulesPM", "version" : "6.012" } ], "zilla" : { "class" : "Dist::Zilla::Dist::Builder", "config" : { "is_trial" : 0 }, "version" : "6.012" } }, "x_contributors" : [ "Adam Kennedy ", "Arnout Pierre ", "bowtie ", "brian d foy ", "Chas. J. Owens IV ", "Chris Capaci ", "Chris Dolan ", "Christian Walde ", "Colin Newell ", "Damyan Ivanov ", "Dan Book ", "David Steinbrunner ", "Edmund Adjei ", "Elliot Shank ", "Gabor Szabo ", "Graham Ollis ", "Guillaume Aubert ", "Joel Maslak ", "Julian Fondren ", "Karen Etheridge ", "Kent Fredric ", "Lance Wicks ", "Matt Church ", "Matthew Horsfall ", "Mike ", "Milos Kukla ", "Mohammad S Anwar ", "Olivier Mengu\u00e9 ", "Philippe Bruhat (BooK) ", "Randy Lauen ", "Reini Urban ", "Shmuel Fomberg ", "Steffen M\u00fcller ", "Szymon Niezna\u0144ski ", "Takumi Akiyama ", "Thomas Sibley ", "Tom Wyant ", "Van de Bugger ", "Will Braswell " ], "x_generated_by_perl" : "v5.28.0", "x_serialization_backend" : "Cpanel::JSON::XS version 4.02" } lib000755000000000000 013511127601 13166 5ustar00unknownunknown000000000000PPI-1.270PPI.pm100644000000000000 7302613511127601 14344 0ustar00unknownunknown000000000000PPI-1.270/libpackage PPI; # See POD at end for documentation use 5.006; use strict; # Set the version for CPAN our $VERSION = '1.270'; # VERSION our ( $XS_COMPATIBLE, @XS_EXCLUDE ) = ( '0.845' ); # Load everything use PPI::Util (); use PPI::Exception (); use PPI::Element (); use PPI::Token (); use PPI::Statement (); use PPI::Structure (); use PPI::Document (); use PPI::Document::File (); use PPI::Document::Fragment (); use PPI::Document::Normalized (); use PPI::Normal (); use PPI::Tokenizer (); use PPI::Lexer (); # If it is installed, load in PPI::XS die if !$PPI::XS_DISABLE and !eval { require PPI::XS; 1 } and $@ !~ /^Can't locate .*? at /; # ignore failure to load if not installed 1; __END__ =pod =head1 NAME PPI - Parse, Analyze and Manipulate Perl (without perl) =head1 SYNOPSIS use PPI; # Create a new empty document my $Document = PPI::Document->new; # Create a document from source $Document = PPI::Document->new(\'print "Hello World!\n"'); # Load a Document from a file $Document = PPI::Document->new('Module.pm'); # Does it contain any POD? if ( $Document->find_any('PPI::Token::Pod') ) { print "Module contains POD\n"; } # Get the name of the main package $pkg = $Document->find_first('PPI::Statement::Package')->namespace; # Remove all that nasty documentation $Document->prune('PPI::Token::Pod'); $Document->prune('PPI::Token::Comment'); # Save the file $Document->save('Module.pm.stripped'); =head1 DESCRIPTION =head2 About this Document This is the PPI manual. It describes its reason for existing, its general structure, its use, an overview of the API, and provides a few implementation samples. =head2 Background The ability to read, and manipulate Perl (the language) programmatically other than with perl (the application) was one that caused difficulty for a long time. The cause of this problem was Perl's complex and dynamic grammar. Although there is typically not a huge diversity in the grammar of most Perl code, certain issues cause large problems when it comes to parsing. Indeed, quite early in Perl's history Tom Christiansen introduced the Perl community to the quote I<"Nothing but perl can parse Perl">, or as it is more often stated now as a truism: B<"Only perl can parse Perl"> One example of the sorts of things the prevent Perl being easily parsed are function signatures, as demonstrated by the following. @result = (dothis $foo, $bar); # Which of the following is it equivalent to? @result = (dothis($foo), $bar); @result = dothis($foo, $bar); The first line above can be interpreted in two different ways, depending on whether the C<&dothis> function is expecting one argument, or two, or several. A "code parser" (something that parses for the purpose of execution) such as perl needs information that is not found in the immediate vicinity of the statement being parsed. The information might not just be elsewhere in the file, it might not even be in the same file at all. It might also not be able to determine this information without the prior execution of a C block, or the loading and execution of one or more external modules. Or worse the C<&dothis> function may not even have been written yet. B Even perl itself never really fully understands the structure of the source code after and indeed B it processes it, and in that sense doesn't "parse" Perl source into anything remotely like a structured document. This makes it of no real use for any task that needs to treat the source code as a document, and do so reliably and robustly. For more information on why it is impossible to parse perl, see Randal Schwartz's seminal response to the question of "Why can't you parse Perl". L The purpose of PPI is B to parse Perl I, but to parse Perl I. By treating the problem this way, we are able to parse a single file containing Perl source code "isolated" from any other resources, such as libraries upon which the code may depend, and without needing to run an instance of perl alongside or inside the parser. Historically, using an embedded perl parser was widely considered to be the most likely avenue for finding a solution to parsing Perl. It has been investigated from time to time, but attempts have generally failed or suffered from sufficiently bad corner cases that they were abandoned. =head2 What Does PPI Stand For? C is an acronym for the longer original module name C. And in the spirit of the silly acronym games played by certain unnamed Open Source projects you may have I of, it is also a reverse backronym of "I Parse Perl". Of course, I could just be lying and have just made that second bit up 10 minutes before the release of PPI 1.000. Besides, B the cool Perl packages have TLAs (Three Letter Acronyms). It's a rule or something. Why don't you just think of it as the B for simplicity. The original name was shortened to prevent the author (and you the users) from contracting RSI by having to type crazy things like C 100 times a day. In acknowledgment that someone may some day come up with a valid solution for the grammar problem it was decided at the commencement of the project to leave the C namespace free for any such effort. Since that time I've been able to prove to my own satisfaction that it B truly impossible to accurately parse Perl as both code and document at once. For the academics, parsing Perl suffers from the "Halting Problem". =head2 Why Parse Perl? Once you can accept that we will never be able to parse Perl well enough to meet the standards of things that treat Perl as code, it is worth re-examining I we want to "parse" Perl at all. What are the things that people might want a "Perl parser" for? =over 4 =item Documentation Analyzing the contents of a Perl document to automatically generate documentation, in parallel to, or as a replacement for, POD documentation. Allow an indexer to locate and process all the comments and documentation from code for "full text search" applications. =item Structural and Quality Analysis Determine quality or other metrics across a body of code, and identify situations relating to particular phrases, techniques or locations. Index functions, variables and packages within Perl code, and doing search and graph (in the node/edge sense) analysis of large code bases. L, based on PPI, is a large, thriving tool for bug detection and style analysis of Perl code. =item Refactoring Make structural, syntax, or other changes to code in an automated manner, either independently or in assistance to an editor. This sort of task list includes backporting, forward porting, partial evaluation, "improving" code, or whatever. All the sort of things you'd want from a L. =item Layout Change the layout of code without changing its meaning. This includes techniques such as tidying (like L), obfuscation, compressing and "squishing", or to implement formatting preferences or policies. =item Presentation This includes methods of improving the presentation of code, without changing the content of the code. Modify, improve, syntax colour etc the presentation of a Perl document. Generating "IntelliText"-like functions. =back If we treat this as a baseline for the sort of things we are going to have to build on top of Perl, then it becomes possible to identify a standard for how good a Perl parser needs to be. =head2 How good is Good Enough(TM) PPI seeks to be good enough to achieve all of the above tasks, or to provide a sufficiently good API on which to allow others to implement modules in these and related areas. However, there are going to be limits to this process. Because PPI cannot adapt to changing grammars, any code written using source filters should not be assumed to be parsable. At one extreme, this includes anything munged by L, as well as (arguably) more common cases like L. We do not pretend to be able to always parse code using these modules, although as long as it still follows a format that looks like Perl syntax, it may be possible to extend the lexer to handle them. The ability to extend PPI to handle lexical additions to the language is on the drawing board to be done some time post-1.0 The goal for success was originally to be able to successfully parse 99% of all Perl documents contained in CPAN. This means the entire file in each case. PPI has succeeded in this goal far beyond the expectations of even the author. At time of writing there are only 28 non-Acme Perl modules in CPAN that PPI is incapable of parsing. Most of these are so badly broken they do not compile as Perl code anyway. So unless you are actively going out of your way to break PPI, you should expect that it will handle your code just fine. =head2 Internationalisation PPI provides partial support for internationalisation and localisation. Specifically, it allows the use of characters from the Latin-1 character set to be used in quotes, comments, and POD. Primarily, this covers languages from Europe and South America. PPI does B currently provide support for Unicode. If you need Unicode support and would like to help, contact the author. (contact details below) =head2 Round Trip Safe When PPI parses a file it builds B into the model, including whitespace. This is needed in order to make the Document fully "Round Trip" safe. The general concept behind a "Round Trip" parser is that it knows what it is parsing is somewhat uncertain, and so B to get things wrong from time to time. In the cases where it parses code wrongly the tree will serialize back out to the same string of code that was read in, repairing the parser's mistake as it heads back out to the file. The end result is that if you parse in a file and serialize it back out without changing the tree, you are guaranteed to get the same file you started with. PPI does this correctly and reliably for 100% of all known cases. B The one minor exception at this time is that if the newlines for your file are wrong (meaning not matching the platform newline format), PPI will localise them for you. (It isn't to be convenient, supporting arbitrary newlines would make some of the code more complicated) Better control of the newline type is on the wish list though, and anyone wanting to help out is encouraged to contact the author. =head1 IMPLEMENTATION =head2 General Layout PPI is built upon two primary "parsing" components, L and L, and a large tree of about 70 classes which implement the various the I (PDOM). The PDOM is conceptually similar in style and intent to the regular DOM or other code Abstract Syntax Trees (ASTs), but contains some differences to handle perl-specific cases, and to assist in treating the code as a document. Please note that it is B an implementation of the official Document Object Model specification, only somewhat similar to it. On top of the Tokenizer, Lexer and the classes of the PDOM, sit a number of classes intended to make life a little easier when dealing with PDOM trees. Both the major parsing components were hand-coded from scratch with only plain Perl code and a few small utility modules. There are no grammar or patterns mini-languages, no YACC or LEX style tools and only a small number of regular expressions. This is primarily because of the sheer volume of accumulated cruft that exists in Perl. Not even perl itself is capable of parsing Perl documents (remember, it just parses and executes it as code). As a result, PPI needed to be cruftier than perl itself. Feel free to shudder at this point, and hope you never have to understand the Tokenizer codebase. Speaking of which... =head2 The Tokenizer The Tokenizer takes source code and converts it into a series of tokens. It does this using a slow but thorough character by character manual process, rather than using a pattern system or complex regexes. Or at least it does so conceptually. If you were to actually trace the code you would find it's not truly character by character due to a number of regexps and optimisations throughout the code. This lets the Tokenizer "skip ahead" when it can find shortcuts, so it tends to jump around a line a bit wildly at times. In practice, the number of times the Tokenizer will B move the character cursor itself is only about 5% - 10% higher than the number of tokens contained in the file. This makes it about as optimal as it can be made without implementing it in something other than Perl. In 2001 when PPI was started, this structure made PPI quite slow, and not really suitable for interactive tasks. This situation has improved greatly with multi-gigahertz processors, but can still be painful when working with very large files. The target parsing rate for PPI is about 5000 lines per gigacycle. It is currently believed to be at about 1500, and the main avenue for making it to the target speed has now become L, a drop-in XS accelerator for PPI. Since L has only just gotten off the ground and is currently only at proof-of-concept stage, this may take a little while. Anyone interested in helping out with L is B encouraged to contact the author. In fact, the design of L means it's possible to port one function at a time safely and reliably. So every little bit will help. =head2 The Lexer The Lexer takes a token stream, and converts it to a lexical tree. Because we are parsing Perl B this includes whitespace, comments, and all number of weird things that have no relevance when code is actually executed. An instantiated L consumes L objects and produces L objects. However you should probably never be working with the Lexer directly. You should just be able to create L objects and work with them directly. =head2 The Perl Document Object Model The PDOM is a structured collection of data classes that together provide a correct and scalable model for documents that follow the standard Perl syntax. =head2 The PDOM Class Tree The following lists all of the 72 current PDOM classes, listing with indentation based on inheritance. PPI::Element PPI::Node PPI::Document PPI::Document::Fragment PPI::Statement PPI::Statement::Package PPI::Statement::Include PPI::Statement::Sub PPI::Statement::Scheduled PPI::Statement::Compound PPI::Statement::Break PPI::Statement::Given PPI::Statement::When PPI::Statement::Data PPI::Statement::End PPI::Statement::Expression PPI::Statement::Variable PPI::Statement::Null PPI::Statement::UnmatchedBrace PPI::Statement::Unknown PPI::Structure PPI::Structure::Block PPI::Structure::Subscript PPI::Structure::Constructor PPI::Structure::Condition PPI::Structure::List PPI::Structure::For PPI::Structure::Given PPI::Structure::When PPI::Structure::Unknown PPI::Token PPI::Token::Whitespace PPI::Token::Comment PPI::Token::Pod PPI::Token::Number PPI::Token::Number::Binary PPI::Token::Number::Octal PPI::Token::Number::Hex PPI::Token::Number::Float PPI::Token::Number::Exp PPI::Token::Number::Version PPI::Token::Word PPI::Token::DashedWord PPI::Token::Symbol PPI::Token::Magic PPI::Token::ArrayIndex PPI::Token::Operator PPI::Token::Quote PPI::Token::Quote::Single PPI::Token::Quote::Double PPI::Token::Quote::Literal PPI::Token::Quote::Interpolate PPI::Token::QuoteLike PPI::Token::QuoteLike::Backtick PPI::Token::QuoteLike::Command PPI::Token::QuoteLike::Regexp PPI::Token::QuoteLike::Words PPI::Token::QuoteLike::Readline PPI::Token::Regexp PPI::Token::Regexp::Match PPI::Token::Regexp::Substitute PPI::Token::Regexp::Transliterate PPI::Token::HereDoc PPI::Token::Cast PPI::Token::Structure PPI::Token::Label PPI::Token::Separator PPI::Token::Data PPI::Token::End PPI::Token::Prototype PPI::Token::Attribute PPI::Token::Unknown To summarize the above layout, all PDOM objects inherit from the L class. Under this are L, strings of content with a known type, and L, syntactically significant containers that hold other Elements. The three most important of these are the L, the L and the L classes. =head2 The Document, Statement and Structure At the top of all complete PDOM trees is a L object. It represents a complete file of Perl source code as you might find it on disk. There are some specialised types of document, such as L and L but for the purposes of the PDOM they are all just considered to be the same thing. Each Document will contain a number of B, B and B. A L is any series of Tokens and Structures that are treated as a single contiguous statement by perl itself. You should note that a Statement is as close as PPI can get to "parsing" the code in the sense that perl-itself parses Perl code when it is building the op-tree. Because of the isolation and Perl's syntax, it is provably impossible for PPI to accurately determine precedence of operators or which tokens are implicit arguments to a sub call. So rather than lead you on with a bad guess that has a strong chance of being wrong, PPI does not attempt to determine precedence or sub parameters at all. At a fundamental level, it only knows that this series of elements represents a single Statement as perl sees it, but it can do so with enough certainty that it can be trusted. However, for specific Statement types the PDOM is able to derive additional useful information about their meaning. For the best, most useful, and most heavily used example, see L. A L is any series of tokens contained within matching braces. This includes code blocks, conditions, function argument braces, anonymous array and hash constructors, lists, scoping braces and all other syntactic structures represented by a matching pair of braces, including (although it may not seem obvious at first) CREADLINEE> braces. Each Structure contains none, one, or many Tokens and Structures (the rules for which vary for the different Structure subclasses) Under the PDOM structure rules, a Statement can B directly contain another child Statement, a Structure can B directly contain another child Structure, and a Document can B contain another Document anywhere in the tree. Aside from these three rules, the PDOM tree is extremely flexible. =head2 The PDOM at Work To demonstrate the PDOM in use lets start with an example showing how the tree might look for the following chunk of simple Perl code. #!/usr/bin/perl print( "Hello World!" ); exit(); Translated into a PDOM tree it would have the following structure (as shown via the included L). PPI::Document PPI::Token::Comment '#!/usr/bin/perl\n' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ) PPI::Token::Whitespace ' ' PPI::Statement::Expression PPI::Token::Quote::Double '"Hello World!"' PPI::Token::Whitespace ' ' PPI::Token::Structure ';' PPI::Token::Whitespace '\n' PPI::Token::Whitespace '\n' PPI::Statement PPI::Token::Word 'exit' PPI::Structure::List ( ... ) PPI::Token::Structure ';' PPI::Token::Whitespace '\n' Please note that in this example, strings are only listed for the B L that contains that string. Structures are listed with the type of brace characters they represent noted. The L module can be used to generate similar trees yourself. We can make that PDOM dump a little easier to read if we strip out all the whitespace. Here it is again, sans the distracting whitespace tokens. PPI::Document PPI::Token::Comment '#!/usr/bin/perl\n' PPI::Statement PPI::Token::Word 'print' PPI::Structure::List ( ... ) PPI::Statement::Expression PPI::Token::Quote::Double '"Hello World!"' PPI::Token::Structure ';' PPI::Statement PPI::Token::Word 'exit' PPI::Structure::List ( ... ) PPI::Token::Structure ';' As you can see, the tree can get fairly deep at time, especially when every isolated token in a bracket becomes its own statement. This is needed to allow anything inside the tree the ability to grow. It also makes the search and analysis algorithms much more flexible. Because of the depth and complexity of PDOM trees, a vast number of very easy to use methods have been added wherever possible to help people working with PDOM trees do normal tasks relatively quickly and efficiently. =head2 Overview of the Primary Classes The main PPI classes, and links to their own documentation, are listed here in alphabetical order. =over 4 =item L The Document object, the root of the PDOM. =item L A cohesive fragment of a larger Document. Although not of any real current use, it is needed for use in certain internal tree manipulation algorithms. For example, doing things like cut/copy/paste etc. Very similar to a L, but has some additional methods and does not represent a lexical scope boundary. A document fragment is also non-serializable, and so cannot be written out to a file. =item L A simple class for dumping readable debugging versions of PDOM structures, such as in the demonstration above. =item L The Element class is the abstract base class for all objects within the PDOM =item L Implements an instantiable object form of a PDOM tree search. =item L The PPI Lexer. Converts Token streams into PDOM trees. =item L The Node object, the abstract base class for all PDOM objects that can contain other Elements, such as the Document, Statement and Structure objects. =item L The base class for all Perl statements. Generic "evaluate for side-effects" statements are of this actual type. Other more interesting statement types belong to one of its children. See its own documentation for a longer description and list of all of the different statement types and sub-classes. =item L The abstract base class for all structures. A Structure is a language construct consisting of matching braces containing a set of other elements. See the L documentation for a description and list of all of the different structure types and sub-classes. =item L A token is the basic unit of content. At its most basic, a Token is just a string tagged with metadata (its class, and some additional flags in some cases). =item L The L and L classes provide abstract base classes for the many and varied types of quote and quote-like things in Perl. However, much of the actual quote logic is implemented in a separate quote engine, based at L. Classes that inherit from L, L and L are generally parsed only by the Quote Engine. =item L The PPI Tokenizer. One Tokenizer consumes a chunk of text and provides access to a stream of L objects. The Tokenizer is very very complicated, to the point where even the author treads carefully when working with it. Most of the complication is the result of optimizations which have tripled the tokenization speed, at the expense of maintainability. We cope with the spaghetti by heavily commenting everything. =item L The Perl Document Transformation API. Provides a standard interface and abstract base class for objects and classes that manipulate Documents. =back =head1 INSTALLING The core PPI distribution is pure Perl and has been kept as tight as possible and with as few dependencies as possible. It should download and install normally on any platform from within the CPAN and CPANPLUS applications, or directly using the distribution tarball. If installing by hand, you may need to install a few small utility modules first. The exact ones will depend on your version of perl. There are no special install instructions for PPI, and the normal C, C, C, C instructions apply. =head1 EXTENDING The PPI namespace itself is reserved for use by PPI itself. You are recommended to use the PPIx:: namespace for PPI-specific modifications or prototypes thereof, or Perl:: for modules which provide a general Perl language-related functions. If what you wish to implement looks like it fits into the PPIx:: namespace, you should consider contacting the PPI maintainers on GitHub first, as what you want may already be in progress, or you may wish to consider contributing to PPI itself. =head1 TO DO - Many more analysis and utility methods for PDOM classes - Creation of a PPI::Tutorial document - Add many more key functions to PPI::XS - We can B write more and better unit tests - Complete the full implementation of -Eliteral (1.200) - Full understanding of scoping (due 1.300) =head1 SUPPORT The most recent version of PPI is available at the following address. L PPI source is maintained in a GitHub repository at the following address. L Contributions via GitHub pull request are welcome. Bug fixes in the form of pull requests or bug reports with new (failing) unit tests have the best chance of being addressed by busy maintainers, and are B encouraged. If you cannot provide a test or fix, or don't have time to do so, then regular bug reports are still accepted and appreciated via the GitHub bug tracker. L The C utility that is part of the L distribution is a useful tool for demonstrating how PPI is parsing (or misparsing) small code snippets, and for providing information for bug reports. For other issues, questions, or commercial or media-related enquiries, contact the author. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 ACKNOWLEDGMENTS A huge thank you to Phase N Australia (L) for permitting the original open sourcing and release of this distribution from what was originally several thousand hours of commercial work. Another big thank you to The Perl Foundation (L) for funding for the final big refactoring and completion run. Also, to the various co-maintainers that have contributed both large and small with tests and patches and especially to those rare few who have deep-dived into the guts to (gasp) add a feature. - Dan Brook : PPIx::XPath, Acme::PerlML - Audrey Tang : "Line Noise" Testing - Arjen Laarhoven : Three-element ->location support - Elliot Shank : Perl 5.10 support, five-element ->location And finally, thanks to those brave ( and foolish :) ) souls willing to dive in and use, test drive and provide feedback on PPI before version 1.000, in some cases before it made it to beta quality, and still did extremely distasteful things (like eating 50 meg of RAM a second). I owe you all a beer. Corner me somewhere and collect at your convenience. If I missed someone who wasn't in my email history, thank you too :) # In approximate order of appearance - Claes Jacobsson - Michael Schwern - Jeff T. Parsons - CPAN Author "CHOCOLATEBOY" - Robert Rotherberg - CPAN Author "PODMASTER" - Richard Soderberg - Nadim ibn Hamouda el Khemir - Graciliano M. P. - Leon Brocard - Jody Belka - Curtis Ovid - Yuval Kogman - Michael Schilli - Slaven Rezic - Lars Thegler - Tony Stubblebine - Tatsuhiko Miyagawa - CPAN Author "CHROMATIC" - Matisse Enzer - Roy Fulbright - Dan Brook - Johnny Lee - Johan Lindstrom And to single one person out, thanks go to Randal Schwartz who spent a great number of hours in IRC over a critical 6 month period explaining why Perl is impossibly unparsable and constantly shoving evil and ugly corner cases in my face. He remained a tireless devil's advocate, and without his support this project genuinely could never have been completed. So for my schooling in the Deep Magiks, you have my deepest gratitude Randal. =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut 16_xml.t100644000000000000 175413511127601 14325 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More 0.86 tests => 16 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; ##################################################################### # Begin Tests my $code = 'print "Hello World";'; my $document = new_ok( 'PPI::Document' => [ \$code ] ); my @elements = $document->elements; push @elements, $elements[0]->elements; my @expected = ( [ 'statement', {}, '' ], [ 'token_word', {}, 'print' ], [ 'token_whitespace', {}, ' ' ], [ 'token_quote_double', {}, '"Hello World"' ], [ 'token_structure', {}, ';' ], ); my $i = 0; foreach my $expect ( @expected ) { is( $elements[$i]->_xml_name, $expect->[0], "Got _xml_name '$expect->[0]' as expected", ); is_deeply( $elements[$i]->_xml_attr, $expect->[1], "Got _xml_attr as expected", ); is( $elements[$i]->_xml_content, $expect->[2], "Got _xml_content '$expect->[2]' as expected", ); $i++; } 26_bom.t100644000000000000 43613511127601 14257 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 20 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI::Test::Run; ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir(qw{ t data 26_bom }); 11_util.t100644000000000000 266013511127601 14472 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Test the PPI::Util package use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 10 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; use PPI::Util qw{_Document _slurp}; # Execute the tests my $testfile = catfile( 't', 'data', '11_util', 'test.pm' ); my $testsource = 'print "Hello World!\n"'; my $slurpfile = catfile( 't', 'data', 'basic.pl' ); my $slurpcode = <<'END_FILE'; #!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } 1; END_FILE ##################################################################### # Test PPI::Util::_Document my $Document = PPI::Document->new( \$testsource ); isa_ok( $Document, 'PPI::Document' ); # Good things foreach my $thing ( $testfile, \$testsource, $Document, [] ) { isa_ok( _Document( $thing ), 'PPI::Document' ); } # Bad things ### erm... # Evil things foreach my $thing ( {}, sub () { 1 } ) { is( _Document( $thing ), undef, '_Document(evil) returns undef' ); } ##################################################################### # Test PPI::Util::_slurp my $source = _slurp( $slurpfile ); is_deeply( $source, \$slurpcode, '_slurp loads file as expected' ); ##################################################################### # Check the capability flags my $have_unicode = PPI::Util::HAVE_UNICODE(); ok( defined $have_unicode, 'HAVE_UNICODE defined' ); is( $have_unicode, !! $have_unicode, 'HAVE_UNICODE is a boolean' ); 13_data.t100644000000000000 163013511127601 14424 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Tests functionality relating to __DATA__ sections of files use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 7 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; my $module = catfile('t', 'data', '13_data', 'Foo.pm'); ok( -f $module, 'Test file exists' ); my $Document = PPI::Document->new( $module ); isa_ok( $Document, 'PPI::Document' ); # Get the data token my $Token = $Document->find_first( 'Token::Data' ); isa_ok( $Token, 'PPI::Token::Data' ); # Get the handle my $handle = $Token->handle; isa_ok( $handle, 'IO::String' ); # Try to read a line off the handle my $line = <$handle>; is( $line, "This is data\n", "Reading off a handle works as expected" ); # Print to the handle ok( $handle->print("Foo bar\n"), "handle->print returns ok" ); is( $Token->content, "This is data\nFoo bar\nis\n", "handle->print modifies the content as expected" ); 23_file.t100644000000000000 115613511127601 14436 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Testing of PPI::Document::File use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 4 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI::Document::File; ##################################################################### # Creating Documents SCOPE: { # From a specific file my $file = catfile('t', 'data', 'basic.pl'); ok( -f $file, 'Found test file' ); # Load from the file my $doc = PPI::Document::File->new( $file ); isa_ok( $doc, 'PPI::Document::File' ); isa_ok( $doc, 'PPI::Document' ); is( $doc->filename, $file, '->filename ok' ); } author.t100644000000000000 76713511127601 14674 0ustar00unknownunknown000000000000PPI-1.270/xt#!/usr/bin/perl use strict; BEGIN { $| = 1; $^W = 1; } my $MODULE = 'Test::Pod 1.44'; # Don't run tests for installs use Test::More; unless ( $ENV{AUTOMATED_TESTING} or $ENV{RELEASE_TESTING} ) { plan( skip_all => "Author tests not required for installation" ); } # Load the testing module if ( !eval "use $MODULE; 1" ) { $ENV{RELEASE_TESTING} ? die( "Failed to load required release-testing module $MODULE" ) : plan( skip_all => "$MODULE not available for testing" ); } all_pod_files_ok(); Makefile.PL100644000000000000 707113511127601 14537 0ustar00unknownunknown000000000000PPI-1.270# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. use strict; use warnings; use 5.006; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Parse, Analyze and Manipulate Perl (without perl)", "AUTHOR" => "Adam Kennedy ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "PPI", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.006", "NAME" => "PPI", "PREREQ_PM" => { "Carp" => 0, "Clone" => "0.30", "Digest::MD5" => "2.35", "Exporter" => 0, "File::Path" => 0, "File::Spec" => 0, "IO::String" => "1.07", "List::Util" => "1.33", "Params::Util" => "1.00", "Scalar::Util" => 0, "Storable" => "2.17", "Task::Weaken" => 0, "constant" => 0, "overload" => 0, "strict" => 0 }, "TEST_REQUIRES" => { "B" => 0, "Class::Inspector" => "1.22", "Encode" => 0, "ExtUtils::MakeMaker" => 0, "File::Copy" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "File::Spec::Unix" => 0, "File::Temp" => 0, "Test::Deep" => 0, "Test::More" => "0.88", "Test::NoWarnings" => 0, "Test::Object" => "0.07", "Test::SubCalls" => "1.07", "if" => 0, "lib" => 0, "utf8" => 0, "warnings" => 0 }, "VERSION" => "1.270", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "B" => 0, "Carp" => 0, "Class::Inspector" => "1.22", "Clone" => "0.30", "Digest::MD5" => "2.35", "Encode" => 0, "Exporter" => 0, "ExtUtils::MakeMaker" => 0, "File::Copy" => 0, "File::Path" => 0, "File::Spec" => 0, "File::Spec::Functions" => 0, "File::Spec::Unix" => 0, "File::Temp" => 0, "IO::String" => "1.07", "List::Util" => "1.33", "Params::Util" => "1.00", "Scalar::Util" => 0, "Storable" => "2.17", "Task::Weaken" => 0, "Test::Deep" => 0, "Test::More" => "0.88", "Test::NoWarnings" => 0, "Test::Object" => "0.07", "Test::SubCalls" => "1.07", "constant" => 0, "if" => 0, "lib" => 0, "overload" => 0, "strict" => 0, "utf8" => 0, "warnings" => 0 ); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.034 requires('File::Spec', is_os('MSWin32') ? '3.2701' : '0.84'); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); # inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.034 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; warn "$module already exists in $mm_key (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $WriteMakefileArgs{$mm_key}{$module} and $WriteMakefileArgs{$mm_key}{$module} ne '0' and $WriteMakefileArgs{$mm_key}{$module} ne $version_or_range; warn "$module already exists in FallbackPrereqs (at version $WriteMakefileArgs{$mm_key}{$module}) -- need to do a sane metamerge!" if exists $FallbackPrereqs{$module} and $FallbackPrereqs{$module} ne '0' and $FallbackPrereqs{$module} ne $version_or_range; $WriteMakefileArgs{$mm_key}{$module} = $FallbackPrereqs{$module} = $version_or_range; return; } sub is_os { foreach my $os (@_) { return 1 if $os eq $^O; } return 0; } sub requires { goto &runtime_requires } sub runtime_requires { my ($module, $version_or_range) = @_; _add_prereq(PREREQ_PM => $module, $version_or_range); } 05_lexer.t100644000000000000 70113511127601 14611 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Compare a large number of specific code samples (.code) # with the expected Lexer dumps (.dump). use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 236 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI::Lexer; use PPI::Test::Run; ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir( catdir( 't', 'data', '05_lexer' ) ); 07_token.t100644000000000000 1663113511127601 14665 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Formal unit tests for specific PPI::Token classes sub warns_on_misplaced_underscore { $] >= 5.006 and $] < 5.008 } sub dies_on_incomplete_bx { $] >= 5.031002 } use if !(-e 'META.yml'), "Test::InDistDir"; use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 588 + (warns_on_misplaced_underscore() ? 2 : 0 ) + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; use PPI::Test::Run; ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir( catdir( 't', 'data', '07_token' ) ); ##################################################################### # PPI::Token::Number Unit Tests SCOPE: { my @examples = ( # code => base | '10f' | '10e' '0' => 10, '1' => 10, '10' => 10, '1_0' => 10, '.0' => '10f', '.0_0' => '10f', '-.0' => '10f', '0.' => '10f', '0.0' => '10f', '0.0_0' => '10f', '1_0.' => '10f', '.0e0' => '10e', '-.0e0' => '10e', '0.e1' => '10e', '0.0e-1' => '10e', '0.0e+1' => '10e', '0.0e-10' => '10e', '0.0e+10' => '10e', '0.0e100' => '10e', '1_0e1_0' => '10e', '1e00' => '10e', '1e+00' => '10e', '1e-00' => '10e', '1e00000' => '10e', '0b' => 2, '0b0' => 2, '0b10' => 2, '0b1_0' => 2, '00' => 8, '01' => 8, '010' => 8, '01_0' => 8, '0x' => 16, '0x0' => 16, '0x10' => 16, '0x1_0' => 16, '0.0.0' => 256, '.0.0' => 256, '127.0.0.1' => 256, '1.1.1.1.1.1' => 256, ); while ( @examples ) { my $code = shift @examples; my $base = shift @examples; if ( warns_on_misplaced_underscore() and ($code eq '1_0e1_0' or $code eq '1_0' or $code eq '1_0.') ) { SKIP: { skip( 'Ignoring known-bad cases on Perl 5.6.2', 5 ); } next; } my $is_exp = $base =~ s/e//; my $is_float = $is_exp || $base =~ s/f//; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; is("$token", $code, "'$code' is a single token"); is($token->base, $base, "base of '$code' is $base"); is($token->isa('PPI::Token::Number::Float'), $is_float, "'$code' ".($is_float ? "is" : "not")." ::Float"); is($token->isa('PPI::Token::Number::Exp'), $is_exp, "'$code' ".($is_float ? "is" : "not")." ::Exp"); next if $base == 256; $^W = 0; my $underscore_incompatible = warns_on_misplaced_underscore() && $code =~ /^1_0[.]?$/; my $incomplete_incompatible = dies_on_incomplete_bx() && $code =~ /^0[bx]$/; my $literal = eval $code; my $err = $@; $literal = undef if $underscore_incompatible || $incomplete_incompatible; warning_is { $literal = eval $code } "Misplaced _ in number", "$] warns about misplaced underscore" if $underscore_incompatible; like($err, qr/No digits found for (binary|hexadecimal) literal/, "$] dies on incomplete binary/hexadecimal literals") if $underscore_incompatible; cmp_ok($token->literal, '==', $err ? undef : $literal, "literal('$code'), eval error: " . ($err || "none")); } } for my $code ( '1.0._0' ) { my $token = PPI::Tokenizer->new( \$code )->get_token; isnt("$token", $code, 'tokenize bad version'); } for my $code ( '1.0.0.0_0' ) { my $token = PPI::Tokenizer->new( \$code )->get_token; is("$token", $code, 'tokenize good version'); } foreach my $code ( '08', '09', '0778', '0779' ) { my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Octal'); is("$token", $code, "tokenize bad octal '$code'"); ok($token->{_error} && $token->{_error} =~ m/octal/i, 'invalid octal number should trigger parse error'); is($token->literal, undef, "literal('$code') is undef"); } BINARY: { my @tests = ( # Good binary numbers { code => '0b0', error => 0, value => 0 }, { code => '0b1', error => 0, value => 1 }, { code => '0B1', error => 0, value => 1 }, { code => '0b101', error => 0, value => 5 }, { code => '0b1_1', error => 0, value => 3 }, { code => '0b1__1', error => 0, value => 3 }, # perl warns, but parses it { code => '0b1__1_', error => 0, value => 3 }, # perl warns, but parses it # Bad binary numbers { code => '0b2', error => 1, value => 0 }, { code => '0B2', error => 1, value => 0 }, { code => '0b012', error => 1, value => 0 }, { code => '0B012', error => 1, value => 0 }, { code => '0B0121', error => 1, value => 0 }, ); foreach my $test ( @tests ) { my $code = $test->{code}; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Binary'); if ( $test->{error} ) { ok($token->{_error} && $token->{_error} =~ m/binary/i, 'invalid binary number should trigger parse error'); is($token->literal, undef, "literal('$code') is undef"); } else { ok(!$token->{_error}, "no error for '$code'"); is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } is($token->content, $code, "parsed everything"); } } HEX: { my @tests = ( # Good hex numbers--entire thing goes in the token { code => '0x0', parsed => '0x0', value => 0 }, { code => '0X1', parsed => '0X1', value => 1 }, { code => '0x1', parsed => '0x1', value => 1 }, { code => '0x_1', parsed => '0x_1', value => 1 }, { code => '0x__1', parsed => '0x__1', value => 1 }, # perl warns, but parses it { code => '0x__1_', parsed => '0x__1_', value => 1 }, # perl warns, but parses it { code => '0X1', parsed => '0X1', value => 1 }, { code => '0xc', parsed => '0xc', value => 12 }, { code => '0Xc', parsed => '0Xc', value => 12 }, { code => '0XC', parsed => '0XC', value => 12 }, { code => '0xbeef', parsed => '0xbeef', value => 48879 }, { code => '0XbeEf', parsed => '0XbeEf', value => 48879 }, { code => '0x0e', parsed => '0x0e', value => 14 }, { code => '0x00000e', parsed => '0x00000e', value => 14 }, { code => '0x000_00e', parsed => '0x000_00e', value => 14 }, { code => '0x000__00e', parsed => '0x000__00e', value => 14 }, # perl warns, but parses it # Bad hex numbers--tokenizing stops when bad digit seen { code => '0x', parsed => '0x', value => 0 }, { code => '0X', parsed => '0X', value => 0 }, { code => '0xg', parsed => '0x', value => 0 }, { code => '0Xg', parsed => '0X', value => 0 }, { code => '0XG', parsed => '0X', value => 0 }, { code => '0x0g', parsed => '0x0', value => 0 }, { code => '0X0g', parsed => '0X0', value => 0 }, { code => '0X0G', parsed => '0X0', value => 0 }, { code => '0x1g', parsed => '0x1', value => 1 }, { code => '0x1g2', parsed => '0x1', value => 1 }, { code => '0x1_g', parsed => '0x1_', value => 1 }, ); foreach my $test ( @tests ) { my $code = $test->{code}; my $T = PPI::Tokenizer->new( \$code ); my $token = $T->get_token; isa_ok($token, 'PPI::Token::Number::Hex'); ok(!$token->{_error}, "no error for '$code' even on invalid digits"); is($token->content, $test->{parsed}, "correctly parsed everything expected"); is($token->literal, $test->{value}, "literal('$code') is $test->{value}"); } } 18_cache.t100644000000000000 1200313511127601 14577 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Test PPI::Cache use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 40 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Unix; use File::Spec::Functions ':ALL'; use File::Temp 'tempdir'; use Scalar::Util 'refaddr'; use PPI::Document (); use PPI::Cache (); use Test::SubCalls 1.07 (); use constant VMS => !! ( $^O eq 'VMS' ); use constant FILE => VMS ? 'File::Spec::Unix' : 'File::Spec'; my $this_file = FILE->catdir( 't', 'data', '03_document', 'test.dat' ); my $cache_dir = tempdir(CLEANUP => 1); ok( -d $cache_dir, 'Verified the cache path exists' ); ok( -w $cache_dir, 'Can write to the cache path' ); my $sample_document = \'print "Hello World!\n";'; ##################################################################### # Basic Testing # Create a basic cache object my $Cache = PPI::Cache->new( path => $cache_dir, ); isa_ok( $Cache, 'PPI::Cache' ); is( scalar($Cache->path), $cache_dir, '->path returns the original path' ); is( scalar($Cache->readonly), '', '->readonly returns false by default' ); # Create a test document my $doc = PPI::Document->new( $sample_document ); isa_ok( $doc, 'PPI::Document' ); my $doc_md5 = '64568092e7faba16d99fa04706c46517'; is( $doc->hex_id, $doc_md5, '->hex_id specifically matches the UNIX newline md5' ); my $doc_file = catfile($cache_dir, '6', '64', '64568092e7faba16d99fa04706c46517.ppi'); my $bad_md5 = 'abcdef1234567890abcdef1234567890'; my $bad_file = catfile($cache_dir, 'a', 'ab', 'abcdef1234567890abcdef1234567890.ppi'); # Save to an arbitrary location ok( $Cache->_store($bad_md5, $doc), '->_store returns true' ); ok( -f $bad_file, 'Created file where expected' ); my $loaded = $Cache->_load($bad_md5); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->_load loads the same document back in' ); # Store the test document in the cache in its proper place is( scalar( $Cache->store_document($doc) ), 1, '->store_document(Document) returns true' ); ok( -f $doc_file, 'The document was stored in the expected location' ); # Check the _md5hex method is( PPI::Cache->_md5hex($sample_document), $doc_md5, '->_md5hex returns as expected for sample document' ); is( PPI::Cache->_md5hex($doc_md5), $doc_md5, '->_md5hex null transform works as expected' ); is( $Cache->_md5hex($sample_document), $doc_md5, '->_md5hex returns as expected for sample document' ); is( $Cache->_md5hex($doc_md5), $doc_md5, '->_md5hex null transform works as expected' ); # Retrieve the Document by content $loaded = $Cache->get_document( $sample_document ); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->get_document(\$source) loads the same document back in' ); # Retrieve the Document by md5 directly $loaded = $Cache->get_document( $doc_md5 ); isa_ok( $loaded, 'PPI::Document' ); is_deeply( $doc, $loaded, '->get_document($md5hex) loads the same document back in' ); ##################################################################### # Empiric Testing # Load a test document twice, and see how many tokenizer objects get # created internally. is( PPI::Document->get_cache, undef, 'PPI::Document cache initially undef' ); ok( PPI::Document->set_cache( $Cache ), 'PPI::Document->set_cache returned true' ); isa_ok( PPI::Document->get_cache, 'PPI::Cache' ); is( refaddr($Cache), refaddr(PPI::Document->get_cache), '->get_cache returns the same cache object' ); SCOPE: { # Set the tracking on the Tokenizer constructor ok( Test::SubCalls::sub_track( 'PPI::Tokenizer::new' ), 'Tracking calls to PPI::Tokenizer::new' ); Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0 ); my $doc1 = PPI::Document->new( $this_file ); my $doc2 = PPI::Document->new( $this_file ); isa_ok( $doc1, 'PPI::Document' ); isa_ok( $doc2, 'PPI::Document' ); unless ( $doc1 and $doc2 ) { skip( "Skipping due to previous failures", 3 ); } Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 1, 'Two calls to PPI::Document->new results in one Tokenizer object creation' ); ok( refaddr($doc1) != refaddr($doc2), 'PPI::Document->new with cache enabled does NOT return the same object' ); is_deeply( $doc1, $doc2, 'PPI::Document->new with cache enabled returns two identical objects' ); } SCOPE: { # Done now, can we clear the cache? is( PPI::Document->set_cache(undef), 1, '->set_cache(undef) returns true' ); is( PPI::Document->get_cache, undef, '->get_cache returns undef' ); # Next, test the import mechanism is( eval "use PPI::Cache path => '$cache_dir'; 1", 1, 'use PPI::Cache path => ...; succeeded' ); isa_ok( PPI::Document->get_cache, 'PPI::Cache' ); is( scalar(PPI::Document->get_cache->path), $cache_dir, '->path returns the original path' ); is( scalar(PPI::Document->get_cache->readonly), '', '->readonly returns false by default' ); # Does it still keep the previously cached documents Test::SubCalls::sub_reset( 'PPI::Tokenizer::new' ); my $doc3 = PPI::Document->new( $this_file ); isa_ok( $doc3, 'PPI::Document' ); Test::SubCalls::sub_calls( 'PPI::Tokenizer::new', 0, 'Tokenizer was not created. Previous cache used ok' ); } 1; ppi_node.t100644000000000000 213513511127601 15006 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Node use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 6 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; PRUNE: { # Avoids a bug in old Perls relating to the detection of scripts # Known to occur in ActivePerl 5.6.1 and at least one 5.6.2 install. my $hashbang = reverse 'lrep/nib/rsu/!#'; my $document = PPI::Document->new( \<<"END_PERL" ); $hashbang use strict; sub one { 1 } sub two { 2 } sub three { 3 } print one; print "\n"; print three; print "\n"; exit; END_PERL isa_ok( $document, 'PPI::Document' ); ok( defined($document->prune ('PPI::Statement::Sub')), 'Pruned multiple subs ok' ); } REMOVE_CHILD: { my $document = PPI::Document->new( \"1, 2, 3," ); eval { $document->child }; like $@->message, qr/method child\(\) needs an index/; undef $@; eval { $document->child("a") }; like $@->message, qr/method child\(\) needs an index/; my $node = $document->child(0); my $del1 = $node->child(7); is $node->remove_child($del1), $del1; my $fake = bless { content => 3 }, "PPI::Token::Number"; is $node->remove_child($fake), undef; } dev_notes.txt100644000000000000 236013511127601 15310 0ustar00unknownunknown000000000000PPI-1.270prove -l -v t | grep '^^[ \t]*ok.*TODO' prove -l -v t | grep '^^not ok' prove -vl t\ppi_token_unknown.t | grep '^^[ \t]*ok.*TODO' prove -vl t\ppi_token_unknown.t | grep '^^not ok' prove -l -j 9 t https://github.com/wolfsage/p5-distribution-smoke D:\cpan\p5-distribution-smoke>perl -Ilib bin\p5-distribution-smoke -b new -a Perl::Critic ../PPI D:\cpan\p5-distribution-smoke>perl -Ilib bin\p5-distribution-smoke -b new -r ../PPI perl -Ilib bin/p5-distribution-smoke -r -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -a Perl::Critic::* -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -a Perl::Critic::* -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -d 2 -b new -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI perl -Ilib bin/p5-distribution-smoke -r -d 2 -b old -n PPI -s MooseX::amine -s ^Task:: -s Apache2::PPI::HTML ../PPI ppi_version change 1.221_02 1.222 dmake clean perl Makefile.PL && dmake && dmake manifest && dmake dist 09_normal.t100644000000000000 415013511127601 15010 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Testing of the normalization functions. # (only very basic at this point) use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 17 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; use PPI::Singletons '%LAYER'; ##################################################################### # Creation and Manipulation SCOPE: { my $Document = PPI::Document->new(\'my $foo = bar();'); isa_ok( $Document, 'PPI::Document' ); my $Normal = $Document->normalized; isa_ok( $Normal, 'PPI::Document::Normalized' ); is( $Normal->version, $PPI::Normal::VERSION, '->version matches $VERSION' ); my $functions = $Normal->functions; is( ref $functions, 'ARRAY', '->functions returns an array ref' ); ok( scalar(@$functions), '->functions returns at least 1 function' ); } ##################################################################### # Basic Empiric Tests # Basic empiric testing SCOPE: { # The following should be equivalent my $Document1 = PPI::Document->new( \'my $foo = 1; # comment' ); my $Document2 = PPI::Document->new( \'my $foo=1 ;# different comment' ); my $Document3 = PPI::Document->new( \'sub foo { print "Hello World!\n"; }' ); isa_ok( $Document1, 'PPI::Document' ); isa_ok( $Document2, 'PPI::Document' ); isa_ok( $Document3, 'PPI::Document' ); my $Normal1 = $Document1->normalized; my $Normal2 = $Document2->normalized; my $Normal3 = $Document3->normalized; isa_ok( $Normal1, 'PPI::Document::Normalized' ); isa_ok( $Normal2, 'PPI::Document::Normalized' ); isa_ok( $Normal3, 'PPI::Document::Normalized' ); is( $Normal1->equal( $Normal2 ), 1, '->equal returns true for equivalent code' ); is( $Normal1->equal( $Normal3 ), '', '->equal returns false for different code' ); } NO_DOUBLE_REG: { sub just_a_test_sub { "meep" } ok( PPI::Normal->register( "main::just_a_test_sub", 2 ), "can add subs" ); is $LAYER{2}[-1], "main::just_a_test_sub", "and find subs at right layer"; my $size = @{ $LAYER{2} }; ok( PPI::Normal->register( "main::just_a_test_sub", 2 ), "can add subs again" ); is scalar @{ $LAYER{2} }, $size, "but sub isn't added twice"; } ppi_lexer.t100644000000000000 1267213511127601 15227 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Lexer use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 46 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; UNMATCHED_BRACE: { my $token = new_ok( 'PPI::Token::Structure' => [ ')' ] ); my $brace = new_ok( 'PPI::Statement::UnmatchedBrace' => [ $token ] ); is( $brace->content, ')', '->content ok' ); } _CURLY: { my $document = PPI::Document->new(\<<'END_PERL'); use constant { One => 1 }; use constant 1 { One => 1 }; $foo->{bar}; $foo[1]{bar}; $foo{bar}; sub {1}; grep { $_ } 0 .. 2; map { $_ => 1 } 0 .. 2; sort { $b <=> $a } 0 .. 2; do {foo}; $foo = { One => 1 }; $foo ||= { One => 1 }; 1, { One => 1 }; One => { Two => 2 }; {foo, bar}; {foo => bar}; {}; +{foo, bar}; {; => bar}; @foo{'bar', 'baz'}; @{$foo}{'bar', 'baz'}; ${$foo}{bar}; return { foo => 'bar' }; bless { foo => 'bar' }; $foo &&= { One => 1 }; $foo //= { One => 1 }; $foo //= { 'a' => 1, 'b' => 2 }; 0 || { One => 1 }; 1 && { One => 1 }; undef // { One => 1 }; $x ? {a=>1} : 1; $x ? 1 : {a=>1}; $x ? {a=>1} : {b=>1}; END_PERL isa_ok( $document, 'PPI::Document' ); $document->index_locations(); my @statements; foreach my $elem ( @{ $document->find( 'PPI::Statement' ) || [] } ) { $statements[ $elem->line_number() - 1 ] ||= $elem; } is( scalar(@statements), 33, 'Found 33 statements' ); isa_ok( $statements[0]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[0]); isa_ok( $statements[1]->schild(3), 'PPI::Structure::Constructor', 'The curly in ' . $statements[1]); isa_ok( $statements[2]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[2]); isa_ok( $statements[3]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[3]); isa_ok( $statements[4]->schild(1), 'PPI::Structure::Subscript', 'The curly in ' . $statements[4]); isa_ok( $statements[5]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[5]); isa_ok( $statements[6]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[6]); isa_ok( $statements[7]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[7]); isa_ok( $statements[8]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[8]); isa_ok( $statements[9]->schild(1), 'PPI::Structure::Block', 'The curly in ' . $statements[9]); isa_ok( $statements[10]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[10]); isa_ok( $statements[11]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[11]); isa_ok( $statements[12]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[12]); isa_ok( $statements[13]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[13]); isa_ok( $statements[14]->schild(0), 'PPI::Structure::Block', 'The curly in ' . $statements[14]); isa_ok( $statements[15]->schild(0), 'PPI::Structure::Constructor', 'The curly in ' . $statements[15]); isa_ok( $statements[16]->schild(0), 'PPI::Structure::Constructor', 'The curly in ' . $statements[16]); isa_ok( $statements[17]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[17]); isa_ok( $statements[18]->schild(0), 'PPI::Structure::Block', 'The curly in ' . $statements[18]); isa_ok( $statements[19]->schild(1), 'PPI::Structure::Subscript', 'The curly in ' . $statements[19]); isa_ok( $statements[20]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[20]); isa_ok( $statements[21]->schild(2), 'PPI::Structure::Subscript', 'The curly in ' . $statements[21]); isa_ok( $statements[22]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[22]); isa_ok( $statements[23]->schild(1), 'PPI::Structure::Constructor', 'The curly in ' . $statements[23]); isa_ok( $statements[24]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[24]); isa_ok( $statements[25]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[25]); isa_ok( $statements[26]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[26]); isa_ok( $statements[27]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[27]); isa_ok( $statements[28]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[28]); isa_ok( $statements[29]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[29]); isa_ok( $statements[30]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[30]); isa_ok( $statements[31]->schild(4), 'PPI::Structure::Constructor', 'The curly in ' . $statements[31]); # Check two things in the same statement isa_ok( $statements[32]->schild(2), 'PPI::Structure::Constructor', 'The curly in ' . $statements[32]); isa_ok( $statements[32]->schild(4), 'PPI::Structure::Constructor', 'The curly in ' . $statements[32]); } LEX_STRUCTURE: { # Validate the creation of a null statement SCOPE: { my $token = new_ok( 'PPI::Token::Structure' => [ ';' ] ); my $null = new_ok( 'PPI::Statement::Null' => [ $token ] ); is( $null->content, ';', '->content ok' ); } # Validate the creation of an empty statement new_ok( 'PPI::Statement' => [ ] ); } ERROR_HANDLING: { my $test_lexer = PPI::Lexer->new; is $test_lexer->errstr, "", "errstr is an empty string at the start"; is $test_lexer->lex_file( undef ), undef, "lex_file fails without a filename"; is( PPI::Lexer->errstr, "Did not pass a filename to PPI::Lexer::lex_file", "error can be gotten from class attribute" ); } ppi_token.t100644000000000000 70613511127601 15163 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 5 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; MODIFICATION: { my $one = PPI::Token->new( "" ); is $one->length, 0, "empty token has no length"; ok $one->add_content( "abcde" ), "can add strings"; is $one->length, 5, "adding actually adds"; ok $one->set_content( "abc" ), "can set content"; is $one->length, 3, "setting overwrites"; } 01_compile.t100644000000000000 63313511127601 15122 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # This test script only tests that the tree compiles use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0); # Do the modules load use_all_ok( qw{ PPI PPI::Tokenizer PPI::Lexer PPI::Dumper PPI::Find PPI::Normal PPI::Util PPI::Cache } ); sub use_all_ok { use_ok $_ for @_ } ok( ! $PPI::XS::VERSION, 'PPI::XS is correctly NOT loaded' ); 04_element.t100644000000000000 5132713511127601 15174 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Formal testing for PPI # This does an empiric test that when we try to parse something, # something ( anything ) comes out the other side. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 220 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; use Scalar::Util 'refaddr'; use PPI::Test 'pause'; use PPI::Singletons '%_PARENT'; my $RE_IDENTIFIER = qr/[^\W\d]\w*/; sub is_object { my ($left, $right, $message) = @_; $message ||= "Objects match"; my $condition = ( defined $left and ref $left, and defined $right, and ref $right, and refaddr($left) == refaddr($right) ); ok( $condition, $message ); } sub omethod_fails { my $object = ref($_[0])->isa('UNIVERSAL') ? shift : die "Failed to pass method_fails test an object"; my $method = (defined $_[0] and $_[0] =~ /$RE_IDENTIFIER/o) ? shift : die "Failed to pass method_fails an identifier"; my $arg_set = ( ref $_[0] eq 'ARRAY' and scalar(@{$_[0]}) ) ? shift : die "Failed to pass method_fails a set of arguments"; foreach my $args ( @$arg_set ) { is( $object->$method( $args ), undef, ref($object) . "->$method fails correctly" ); } } ##################################################################### # Miscellaneous # Confirm that C< weaken( $hash{scalar} = $object ) > works as expected, # adding a weak reference to the has index. use Scalar::Util (); SCOPE: { my %hash; my $counter = 0; SCOPE: { my $object1 = bless { }, 'My::WeakenTest'; my $object2 = bless { }, 'My::WeakenTest'; my $object3 = bless { }, 'My::WeakenTest'; isa_ok( $object1, 'My::WeakenTest' ); isa_ok( $object2, 'My::WeakenTest' ); isa_ok( $object3, 'My::WeakenTest' ); # Do nothing for object1. # Add object2 to a has index normally $hash{foo} = $object2; # Add object2 and weaken Scalar::Util::weaken($hash{bar} = $object3); ok( Scalar::Util::isweak( $hash{bar} ), 'index entry is weak' ); ok( ! Scalar::Util::isweak( $object3 ), 'original is not weak' ); pause(); # Do all the objects still exist isa_ok( $object1, 'My::WeakenTest' ); isa_ok( $object2, 'My::WeakenTest' ); isa_ok( $object3, 'My::WeakenTest' ); isa_ok( $hash{foo}, 'My::WeakenTest' ); isa_ok( $hash{bar}, 'My::WeakenTest' ); } pause(); # Two of the three should have destroyed is( $counter, 2, 'Counter increments as expected normally' ); # foo should still be there isa_ok( $hash{foo}, 'My::WeakenTest' ); # bar should ->exists, but be undefined ok( exists $hash{bar}, 'weakened object hash slot exists' ); ok( ! defined $hash{bar}, 'weakened object hash slot is undefined' ); package My::WeakenTest; sub DESTROY { $counter++; } } # Test interaction between weaken and Clone SCOPE: { my $object = { a => undef }; # my $object = bless { a => undef }, 'Foo'; my $object2 = $object; Scalar::Util::weaken($object2); my $clone = Clone::clone($object); is_deeply( $clone, $object, 'Object is cloned OK when a different reference is weakened' ); } ##################################################################### # Prepare # Build a basic source tree to test with my $source = 'my@foo = (1, 2);'; my $Document = PPI::Lexer->lex_source( $source ); isa_ok( $Document, 'PPI::Document' ); is( $Document->content, $source, "Document round-trips ok" ); is( scalar($Document->tokens), 12, "Basic source contains the correct number of tokens" ); is( scalar(@{$Document->{children}}), 1, "Document contains one element" ); my $Statement = $Document->{children}->[0]; isa_ok( $Statement, 'PPI::Statement' ); isa_ok( $Statement, 'PPI::Statement::Variable' ); is( scalar(@{$Statement->{children}}), 7, "Statement contains the correct number of elements" ); my $Token1 = $Statement->{children}->[0]; my $Token2 = $Statement->{children}->[1]; my $Token3 = $Statement->{children}->[2]; my $Braces = $Statement->{children}->[5]; my $Token7 = $Statement->{children}->[6]; isa_ok( $Token1, 'PPI::Token::Word' ); isa_ok( $Token2, 'PPI::Token::Symbol' ); isa_ok( $Token3, 'PPI::Token::Whitespace' ); isa_ok( $Braces, 'PPI::Structure::List' ); isa_ok( $Token7, 'PPI::Token::Structure' ); ok( ($Token1->isa('PPI::Token::Word') and $Token1->content eq 'my'), 'First token is correct' ); ok( ($Token2->isa('PPI::Token::Symbol') and $Token2->content eq '@foo'), 'Second token is correct' ); ok( ($Token3->isa('PPI::Token::Whitespace') and $Token3->content eq ' '), 'Third token is correct' ); is( $Braces->braces, '()', 'Braces seem correct' ); ok( ($Token7->isa('PPI::Token::Structure') and $Token7->content eq ';'), 'Seventh token is correct' ); isa_ok( $Braces->start, 'PPI::Token::Structure' ); ok( ($Braces->start->isa('PPI::Token::Structure') and $Braces->start->content eq '('), 'Start brace token matches expected' ); isa_ok( $Braces->finish, 'PPI::Token::Structure' ); ok( ($Braces->finish->isa('PPI::Token::Structure') and $Braces->finish->content eq ')'), 'Finish brace token matches expected' ); ##################################################################### # Testing of PPI::Element basic information methods # Testing the ->content method is( $Document->content, $source, "Document content is correct" ); is( $Statement->content, $source, "Statement content is correct" ); is( $Token1->content, 'my', "Token content is correct" ); is( $Token2->content, '@foo', "Token content is correct" ); is( $Token3->content, ' ', "Token content is correct" ); is( $Braces->content, '(1, 2)', "Token content is correct" ); is( $Token7->content, ';', "Token content is correct" ); # Testing the ->tokens method is( scalar($Document->tokens), 12, "Document token count is correct" ); is( scalar($Statement->tokens), 12, "Statement token count is correct" ); isa_ok( $Token1->tokens, 'PPI::Token', "Token token count is correct" ); isa_ok( $Token2->tokens, 'PPI::Token', "Token token count is correct" ); isa_ok( $Token3->tokens, 'PPI::Token', "Token token count is correct" ); is( scalar($Braces->tokens), 6, "Token token count is correct" ); isa_ok( $Token7->tokens, 'PPI::Token', "Token token count is correct" ); # Testing the ->significant method is( $Document->significant, 1, 'Document is significant' ); is( $Statement->significant, 1, 'Statement is significant' ); is( $Token1->significant, 1, 'Token is significant' ); is( $Token2->significant, 1, 'Token is significant' ); is( $Token3->significant, '', 'Token is significant' ); is( $Braces->significant, 1, 'Token is significant' ); is( $Token7->significant, 1, 'Token is significant' ); ##################################################################### # Testing of PPI::Element navigation # Test the ->parent method is( $Document->parent, undef, "Document does not have a parent" ); is_object( $Statement->parent, $Document, "Statement sees document as parent" ); is_object( $Token1->parent, $Statement, "Token sees statement as parent" ); is_object( $Token2->parent, $Statement, "Token sees statement as parent" ); is_object( $Token3->parent, $Statement, "Token sees statement as parent" ); is_object( $Braces->parent, $Statement, "Braces sees statement as parent" ); is_object( $Token7->parent, $Statement, "Token sees statement as parent" ); # Test the special case of parents for the Braces opening and closing braces is_object( $Braces->start->parent, $Braces, "Start brace sees the PPI::Structure as its parent" ); is_object( $Braces->finish->parent, $Braces, "Finish brace sees the PPI::Structure as its parent" ); # Test the ->top method is_object( $Document->top, $Document, "Document sees itself as top" ); is_object( $Statement->top, $Document, "Statement sees document as top" ); is_object( $Token1->top, $Document, "Token sees document as top" ); is_object( $Token2->top, $Document, "Token sees document as top" ); is_object( $Token3->top, $Document, "Token sees document as top" ); is_object( $Braces->top, $Document, "Braces sees document as top" ); is_object( $Token7->top, $Document, "Token sees document as top" ); # Test the ->document method is_object( $Document->document, $Document, "Document sees itself as document" ); is_object( $Statement->document, $Document, "Statement sees document correctly" ); is_object( $Token1->document, $Document, "Token sees document correctly" ); is_object( $Token2->document, $Document, "Token sees document correctly" ); is_object( $Token3->document, $Document, "Token sees document correctly" ); is_object( $Braces->document, $Document, "Braces sees document correctly" ); is_object( $Token7->document, $Document, "Token sees document correctly" ); # Test the ->next_sibling method is( $Document->next_sibling, '', "Document returns false for next_sibling" ); is( $Statement->next_sibling, '', "Statement returns false for next_sibling" ); is_object( $Token1->next_sibling, $Token2, "First token sees second token as next_sibling" ); is_object( $Token2->next_sibling, $Token3, "Second token sees third token as next_sibling" ); is_object( $Braces->next_sibling, $Token7, "Braces sees seventh token as next_sibling" ); is( $Token7->next_sibling, '', 'Last token returns false for next_sibling' ); # More extensive test for next_sibling SCOPE: { my $doc = PPI::Document->new( \"sub foo { bar(); }" ); my $end = $doc->last_token; isa_ok( $end, 'PPI::Token::Structure' ); is( $end->content, '}', 'Got end token' ); is( $end->next_sibling, '', '->next_sibling for an end closing brace returns false' ); my $braces = $doc->find_first( sub { $_[1]->isa('PPI::Structure') and $_[1]->braces eq '()' } ); isa_ok( $braces, 'PPI::Structure' ); isa_ok( $braces->next_token, 'PPI::Token::Structure' ); is( $braces->next_token->content, ';', 'Got the correct next_token for structure' ); } # Test the ->previous_sibling method is( $Document->previous_sibling, '', "Document returns false for previous_sibling" ); is( $Statement->previous_sibling, '', "Statement returns false for previous_sibling" ); is( $Token1->previous_sibling, '', "First token returns false for previous_sibling" ); is_object( $Token2->previous_sibling, $Token1, "Second token sees first token as previous_sibling" ); is_object( $Token3->previous_sibling, $Token2, "Third token sees second token as previous_sibling" ); is_object( $Token7->previous_sibling, $Braces, "Last token sees braces as previous_sibling" ); # More extensive test for next_sibling SCOPE: { my $doc = PPI::Document->new( \"{ no strict; bar(); }" ); my $start = $doc->first_token; isa_ok( $start, 'PPI::Token::Structure' ); is( $start->content, '{', 'Got start token' ); is( $start->previous_sibling, '', '->previous_sibling for a start opening brace returns false' ); my $braces = $doc->find_first( sub { $_[1]->isa('PPI::Structure') and $_[1]->braces eq '()' } ); isa_ok( $braces, 'PPI::Structure' ); isa_ok( $braces->previous_token, 'PPI::Token::Word' ); is( $braces->previous_token->content, 'bar', 'Got the correct previous_token for structure' ); } # Test the ->snext_sibling method my $Token4 = $Statement->{children}->[3]; is( $Document->snext_sibling, '', "Document returns false for snext_sibling" ); is( $Statement->snext_sibling, '', "Statement returns false for snext_sibling" ); is_object( $Token1->snext_sibling, $Token2, "First token sees second token as snext_sibling" ); is_object( $Token2->snext_sibling, $Token4, "Second token sees third token as snext_sibling" ); is_object( $Braces->snext_sibling, $Token7, "Braces sees seventh token as snext_sibling" ); is( $Token7->snext_sibling, '', 'Last token returns false for snext_sibling' ); # Test the ->sprevious_sibling method is( $Document->sprevious_sibling, '', "Document returns false for sprevious_sibling" ); is( $Statement->sprevious_sibling, '', "Statement returns false for sprevious_sibling" ); is( $Token1->sprevious_sibling, '', "First token returns false for sprevious_sibling" ); is_object( $Token2->sprevious_sibling, $Token1, "Second token sees first token as sprevious_sibling" ); is_object( $Token3->sprevious_sibling, $Token2, "Third token sees second token as sprevious_sibling" ); is_object( $Token7->sprevious_sibling, $Braces, "Last token sees braces as sprevious_sibling" ); # Test snext_sibling and sprevious_sibling cases when inside a parent block SCOPE: { my $cpan13454 = PPI::Document->new( \'{ 1 }' ); isa_ok( $cpan13454, 'PPI::Document' ); my $num = $cpan13454->find_first('Token::Number'); isa_ok( $num, 'PPI::Token::Number' ); my $prev = $num->sprevious_sibling; is( $prev, '', '->sprevious_sibling returns false' ); my $next = $num->snext_sibling; is( $next, '', '->snext_sibling returns false' ); } ##################################################################### # Test the PPI::Element and PPI::Node analysis methods # Test the find method SCOPE: { is( $Document->find('PPI::Token::End'), '', '->find returns false if nothing found' ); isa_ok( $Document->find('PPI::Structure')->[0], 'PPI::Structure' ); my $found = $Document->find('PPI::Token::Number'); ok( $found, 'Multiple find succeeded' ); is( ref $found, 'ARRAY', '->find returned an array' ); is( scalar(@$found), 2, 'Multiple find returned expected number of items' ); # Test for the ability to shorten the names $found = $Document->find('Token::Number'); ok( $found, 'Multiple find succeeded' ); is( ref $found, 'ARRAY', '->find returned an array' ); is( scalar(@$found), 2, 'Multiple find returned expected number of items' ); } # Test for CPAN #7799 - Unsupported element types are accepted by find # # The correct behaviour for a bad string is a warning, and return C SCOPE: { local $^W = 0; is( $Document->find(undef), undef, '->find(undef) failed' ); is( $Document->find([]), undef, '->find([]) failed' ); is( $Document->find('Foo'), undef, '->find(BAD) failed' ); } # Test the find_first method SCOPE: { is( $Document->find_first('PPI::Token::End'), '', '->find_first returns false if nothing found' ); isa_ok( $Document->find_first('PPI::Structure'), 'PPI::Structure' ); my $found = $Document->find_first('PPI::Token::Number'); ok( $found, 'Multiple find_first succeeded' ); isa_ok( $found, 'PPI::Token::Number' ); # Test for the ability to shorten the names $found = $Document->find_first('Token::Number'); ok( $found, 'Multiple find_first succeeded' ); isa_ok( $found, 'PPI::Token::Number' ); } # Test the find_any method SCOPE: { is( $Document->find_any('PPI::Token::End'), '', '->find_any returns false if nothing found' ); is( $Document->find_any('PPI::Structure'), 1, '->find_any returns true is something found' ); is( $Document->find_any('PPI::Token::Number'), 1, '->find_any returns true for multiple find' ); is( $Document->find_any('Token::Number'), 1, '->find_any returns true for shortened multiple find' ); } # Test the contains method SCOPE: { omethod_fails( $Document, 'contains', [ undef, '', 1, [], bless( {}, 'Foo') ] ); my $found = $Document->find('PPI::Element'); is( ref $found, 'ARRAY', '(preparing for contains tests) ->find returned an array' ); is( scalar(@$found), 15, '(preparing for contains tests) ->find returns correctly for all elements' ); foreach my $Element ( @$found ) { is( $Document->contains( $Element ), 1, 'Document contains ' . ref($Element) . ' known to be in it' ); } shift @$found; foreach my $Element ( @$found ) { is( $Document->contains( $Element ), 1, 'Statement contains ' . ref($Element) . ' known to be in it' ); } } ##################################################################### # Test the PPI::Element manipulation methods # Cloning an Element/Node SCOPE: { my $Doc2 = $Document->clone; isa_ok( $Doc2, 'PPI::Document' ); isa_ok( $Doc2->schild(0), 'PPI::Statement' ); is_object( $Doc2->schild(0)->parent, $Doc2, 'Basic parent links stay intact after ->clone' ); is_object( $Doc2->schild(0)->schild(3)->start->document, $Doc2, 'Clone goes deep, and Structure braces get relinked properly' ); isnt( refaddr($Document), refaddr($Doc2), 'Cloned Document has a different memory location' ); isnt( refaddr($Document->schild(0)), refaddr($Doc2->schild(0)), 'Cloned Document has children at different memory locations' ); } # Delete the second token ok( $Token2->delete, "Deletion of token 2 returns true" ); is( $Document->content, 'my = (1, 2);', "Content is modified correctly" ); is( scalar($Document->tokens), 11, "Modified source contains the correct number of tokens" ); ok( ! defined $Token2->parent, "Token 2 is detached from parent" ); # Delete the braces ok( $Braces->delete, "Deletion of braces returns true" ); is( $Document->content, 'my = ;', "Content is modified correctly" ); is( scalar($Document->tokens), 5, "Modified source contains the correct number of tokens" ); ok( ! defined $Braces->parent, "Braces are detached from parent" ); ##################################################################### # Test DESTROY # Start with DESTROY for an element that never has a parent SCOPE: { my $Token = PPI::Token::Whitespace->new( ' ' ); my $k1 = scalar keys %_PARENT; $Token->DESTROY; my $k2 = scalar keys %_PARENT; is( $k1, $k2, '_PARENT key count remains unchanged after naked Element DESTROY' ); } # Next, a single element within a parent SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $Token = PPI::Token::Number->new( '1' ); my $Statement = PPI::Statement->new; $Statement->add_element( $Token ); $k2 = scalar keys %_PARENT; is( $k2, $k1 + 1, 'PARENT keys increases after adding element' ); $Statement->DESTROY; } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on DESTROY' ); } # Repeat for an entire (large) file SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $NodeDocument = PPI::Document->new( $INC{"PPI/Node.pm"} ); isa_ok( $NodeDocument, 'PPI::Document' ); $k2 = scalar keys %_PARENT; ok( $k2 > ($k1 + 3000), 'PARENT keys increases after loading document' ); $NodeDocument->DESTROY; } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on explicit Document DESTROY' ); } # Repeat again, but with an implicit DESTROY SCOPE: { my $k1 = scalar keys %_PARENT; my $k2; my $k3; SCOPE: { my $NodeDocument = PPI::Document->new( $INC{"PPI/Node.pm"} ); isa_ok( $NodeDocument, 'PPI::Document' ); $k2 = scalar keys %_PARENT; ok( $k2 > ($k1 + 3000), 'PARENT keys increases after loading document' ); } pause(); $k3 = scalar keys %_PARENT; is( $k3, $k1, 'PARENT keys returns to original on implicit Document DESTROY' ); } ##################################################################### # Token-related methods # Test first_token, last_token, next_token and previous_token SCOPE: { my $code = <<'END_PERL'; my $foo = bar(); sub foo { my ($foo, $bar, undef) = ('a', shift(@_), 'bar'); return [ $foo, $bar ]; } END_PERL # Trim off the trailing newline to test last_token better $code =~ s/\s+$//s; # Create the document my $doc = PPI::Document->new( \$code ); isa_ok( $doc, 'PPI::Document' ); # Basic first_token and last_token using a single non-trival sample ### FIXME - Make this more thorough my $first_token = $doc->first_token; isa_ok( $first_token, 'PPI::Token::Word' ); is( $first_token->content, 'my', '->first_token works as expected' ); my $last_token = $doc->last_token; isa_ok( $last_token, 'PPI::Token::Structure' ); is( $last_token->content, '}', '->last_token works as expected' ); # Test next_token is( $last_token->next_token, '', 'last->next_token returns false' ); is( $doc->next_token, '', 'doc->next_token returns false' ); my $next_token = $first_token->next_token; isa_ok( $next_token, 'PPI::Token::Whitespace' ); is( $next_token->content, ' ', 'Trivial ->next_token works as expected' ); my $counter = 1; my $token = $first_token; while ( $token = $token->next_token ) { $counter++; } is( $counter, scalar($doc->tokens), '->next_token iterated the expected number of times for a sample document' ); # Test previous_token is( $first_token->previous_token, '', 'last->previous_token returns false' ); is( $doc->previous_token, '', 'doc->previous_token returns false' ); my $previous_token = $last_token->previous_token; isa_ok( $previous_token, 'PPI::Token::Whitespace' ); is( $previous_token->content, "\n", 'Trivial ->previous_token works as expected' ); $counter = 1; $token = $last_token; while ( $token = $token->previous_token ) { $counter++; } is( $counter, scalar($doc->tokens), '->previous_token iterated the expected number of times for a sample document' ); } ##################################################################### # Simple overload tests # Make sure the 'use overload' is working on Element subclasses SCOPE: { my $source = '1;'; my $Document = PPI::Lexer->lex_source( $source ); isa_ok( $Document, 'PPI::Document' ); ok($Document eq $source, 'overload eq'); ok($Document ne 'foo', 'overload ne'); ok($Document == $Document, 'overload =='); ok($Document != $Document->schild(0), 'overload !='); } ppi_normal.t100644000000000000 473113511127601 15355 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Normal use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 27 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; NEW: { # Check we actually set the layer at creation my $layer_1 = PPI::Normal->new; isa_ok( $layer_1, 'PPI::Normal' ); is( $layer_1->layer, 1, '->new creates a layer 1' ); my $layer_1a = PPI::Normal->new(1); isa_ok( $layer_1a, 'PPI::Normal' ); is( $layer_1a->layer, 1, '->new(1) creates a layer 1' ); my $layer_2 = PPI::Normal->new(2); isa_ok( $layer_2, 'PPI::Normal' ); is( $layer_2->layer, 2, '->new(2) creates a layer 2' ); } BAD: { # Test bad things is( PPI::Normal->new(3), undef, '->new only allows up to layer 2' ); is( PPI::Normal->new(undef), undef, '->new(evil) returns undef' ); is( PPI::Normal->new("foo"), undef, '->new(evil) returns undef' ); is( PPI::Normal->new(\"foo"), undef, '->new(evil) returns undef' ); is( PPI::Normal->new([]), undef, '->new(evil) returns undef' ); is( PPI::Normal->new({}), undef, '->new(evil) returns undef' ); } PROCESS: { my $doc1 = PPI::Document->new(\'print "Hello World!\n";'); isa_ok( $doc1, 'PPI::Document' ); my $doc2 = \'print "Hello World!\n";'; my $doc3 = \' print "Hello World!\n"; # comment'; my $doc4 = \'print "Hello World!\n"'; # Normalize them at level 1 my $layer1 = PPI::Normal->new(1); isa_ok( $layer1, 'PPI::Normal' ); my $nor11 = $layer1->process($doc1->clone); my $nor12 = $layer1->process($doc2); my $nor13 = $layer1->process($doc3); isa_ok( $nor11, 'PPI::Document::Normalized' ); isa_ok( $nor12, 'PPI::Document::Normalized' ); isa_ok( $nor13, 'PPI::Document::Normalized' ); # The first 3 should be the same, the second not is_deeply( { %$nor11 }, { %$nor12 }, 'Layer 1: 1 and 2 match' ); is_deeply( { %$nor11 }, { %$nor13 }, 'Layer 1: 1 and 3 match' ); # Normalize them at level 2 my $layer2 = PPI::Normal->new(2); isa_ok( $layer2, 'PPI::Normal' ); my $nor21 = $layer2->process($doc1); my $nor22 = $layer2->process($doc2); my $nor23 = $layer2->process($doc3); my $nor24 = $layer2->process($doc4); isa_ok( $nor21, 'PPI::Document::Normalized' ); isa_ok( $nor22, 'PPI::Document::Normalized' ); isa_ok( $nor23, 'PPI::Document::Normalized' ); isa_ok( $nor24, 'PPI::Document::Normalized' ); # The first 3 should be the same, the second not is_deeply( { %$nor21 }, { %$nor22 }, 'Layer 2: 1 and 2 match' ); is_deeply( { %$nor21 }, { %$nor23 }, 'Layer 2: 1 and 3 match' ); is_deeply( { %$nor21 }, { %$nor24 }, 'Layer 2: 1 and 4 match' ); } PPI000755000000000000 013511127601 13616 5ustar00unknownunknown000000000000PPI-1.270/libFind.pm100644000000000000 2141413511127601 15216 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Find; =pod =head1 NAME PPI::Find - Object version of the Element->find method =head1 SYNOPSIS # Create the Find object my $Find = PPI::Find->new( \&wanted ); # Return all matching Elements as a list my @found = $Find->in( $Document ); # Can we find any matching Elements if ( $Find->any_matches($Document) ) { print "Found at least one matching Element"; } # Use the object as an iterator $Find->start($Document) or die "Failed to execute search"; while ( my $token = $Find->match ) { ... } =head1 DESCRIPTION PPI::Find is the primary PDOM searching class in the core PPI package. =head2 History It became quite obvious during the development of PPI that many of the modules that would be built on top of it were going to need large numbers of saved, storable or easily creatable search objects that could be reused a number of times. Although the internal ->find method provides a basic ability to search, it is by no means thorough. PPI::Find attempts to resolve this problem. =head2 Structure and Style PPI::Find provides a similar API to the popular L module for file searching, but without the ability to assemble queries. The implementation of a separate PPI::Find::Rule sub-class that does provide this ability is left as an exercise for the reader. =head2 The &wanted function At the core of each PPI::Find object is a "wanted" function that is passed a number of arguments and returns a value which controls the flow of the search. As the search executes, each Element will be passed to the wanted function in depth-first order. It will be provided with two arguments. The current Element to test as $_[0], and the top-level Element of the search as $_[1]. The &wanted function is expected to return 1 (positive) if the Element matches the condition, 0 (false) if it does not, and undef (undefined) if the condition does not match, and the Find search should not descend to any of the current Element's children. Errors should be reported from the &wanted function via die, which will be caught by the Find object and returned as an error. =head1 METHODS =cut use strict; use Params::Util qw{_INSTANCE}; our $VERSION = '1.270'; # VERSION ##################################################################### # Constructor =pod =head2 new &wanted The C constructor takes a single argument of the &wanted function, as described above and creates a new search. Returns a new PPI::Find object, or C if not passed a CODE reference. =cut sub new { my $class = ref $_[0] ? ref shift : shift; my $wanted = ref $_[0] eq 'CODE' ? shift : return undef; # Create the object my $self = bless { wanted => $wanted, }, $class; $self; } =pod =head2 clone The C method creates another instance of the same Find object. The cloning is done safely, so if your existing Find object is in the middle of an iteration, the cloned Find object will not also be in the iteration and can be safely used independently. Returns a duplicate PPI::Find object. =cut sub clone { my $self = ref $_[0] ? shift : die "->clone can only be called as an object method"; my $class = ref $self; # Create the object my $clone = bless { wanted => $self->{wanted}, }, $class; $clone; } #################################################################### # Search Execution Methods =pod =head2 in $Document [, array_ref => 1 ] The C method starts and completes a full run of the search. It takes as argument a single L object which will serve as the top of the search process. Returns a list of PPI::Element objects that match the condition described by the &wanted function, or the null list on error. You should check the ->errstr method for any errors if you are returned the null list, which may also mean simply that no Elements were found that matched the condition. Because of this need to explicitly check for errors, an alternative return value mechanism is provide. If you pass the C<< array_ref => 1 >> parameter to the method, it will return the list of matched Elements as a reference to an ARRAY. The method will return false if no elements were matched, or C on error. The ->errstr method can still be used to get the error message as normal. =cut sub in { my $self = shift; my $Element = shift; my %params = @_; delete $self->{errstr}; # Are we already acting as an iterator if ( $self->{in} ) { return $self->_error('->in called while another search is in progress', %params); } # Get the root element for the search unless ( _INSTANCE($Element, 'PPI::Element') ) { return $self->_error('->in was not passed a PPI::Element object', %params); } # Prepare the search $self->{in} = $Element; $self->{matches} = []; # Execute the search if ( !eval { $self->_execute; 1 } ) { my $errstr = $@; $errstr =~ s/\s+at\s+line\s+.+$//; return $self->_error("Error while searching: $errstr", %params); } # Clean up and return delete $self->{in}; if ( $params{array_ref} ) { if ( @{$self->{matches}} ) { return delete $self->{matches}; } delete $self->{matches}; return ''; } # Return as a list my $matches = delete $self->{matches}; @$matches; } =pod =head2 start $Element The C method lets the Find object act as an iterator. The method is passed the parent PPI::Element object as for the C method, but does not accept any parameters. To simplify error handling, the entire search is done at once, with the results cached and provided as-requested. Returns true if the search completes, and false on error. =cut sub start { my $self = shift; my $Element = shift; delete $self->{errstr}; # Are we already acting as an iterator if ( $self->{in} ) { return $self->_error('->in called while another search is in progress'); } # Get the root element for the search unless ( _INSTANCE($Element, 'PPI::Element') ) { return $self->_error('->in was not passed a PPI::Element object'); } # Prepare the search $self->{in} = $Element; $self->{matches} = []; # Execute the search if ( !eval { $self->_execute; 1 } ) { my $errstr = $@; $errstr =~ s/\s+at\s+line\s+.+$//; $self->_error("Error while searching: $errstr"); return undef; } 1; } =pod =head2 match The C method returns the next matching Element in the iteration. Returns a PPI::Element object, or C if there are no remaining Elements to be returned. =cut sub match { my $self = shift; return undef unless $self->{matches}; # Fetch and return the next match my $match = shift @{$self->{matches}}; return $match if $match; $self->finish; undef; } =pod =head2 finish The C method provides a mechanism to end iteration if you wish to stop the iteration prematurely. It resets the Find object and allows it to be safely reused. A Find object will be automatically finished when C returns false. This means you should only need to call C when you stop iterating early. You may safely call this method even when not iterating and it will return without failure. Always returns true =cut sub finish { my $self = shift; delete $self->{in}; delete $self->{matches}; delete $self->{errstr}; 1; } ##################################################################### # Support Methods and Error Handling sub _execute { my $self = shift; my $wanted = $self->{wanted}; my @queue = ( $self->{in} ); # Pull entries off the queue and hand them off to the wanted function while ( my $Element = shift @queue ) { my $rv = &$wanted( $Element, $self->{in} ); # Add to the matches if returns true push @{$self->{matches}}, $Element if $rv; # Continue and don't descend if it returned undef # or if it doesn't have children next unless defined $rv; next unless $Element->isa('PPI::Node'); # Add the children to the head of the queue if ( $Element->isa('PPI::Structure') ) { unshift @queue, $Element->finish if $Element->finish; unshift @queue, $Element->children; unshift @queue, $Element->start if $Element->start; } else { unshift @queue, $Element->children; } } 1; } =pod =head2 errstr The C method returns the error messages when a given PPI::Find object fails any action. Returns a string, or C if there is no error. =cut sub errstr { shift->{errstr}; } sub _error { my $self = shift; $self->{errstr} = shift; my %params = @_; $params{array_ref} ? undef : (); } 1; =pod =head1 TO DO - Implement the L class =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Node.pm100644000000000000 4730513511127601 15232 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Node; =pod =head1 NAME PPI::Node - Abstract PPI Node class, an Element that can contain other Elements =head1 INHERITANCE PPI::Node isa PPI::Element =head1 SYNOPSIS # Create a typical node (a Document in this case) my $Node = PPI::Document->new; # Add an element to the node( in this case, a token ) my $Token = PPI::Token::Word->new('my'); $Node->add_element( $Token ); # Get the elements for the Node my @elements = $Node->children; # Find all the barewords within a Node my $barewords = $Node->find( 'PPI::Token::Word' ); # Find by more complex criteria my $my_tokens = $Node->find( sub { $_[1]->content eq 'my' } ); # Remove all the whitespace $Node->prune( 'PPI::Token::Whitespace' ); # Remove by more complex criteria $Node->prune( sub { $_[1]->content eq 'my' } ); =head1 DESCRIPTION The C class provides an abstract base class for the Element classes that are able to contain other elements L, L, and L. As well as those listed below, all of the methods that apply to L objects also apply to C objects. =head1 METHODS =cut use strict; use Carp (); use Scalar::Util qw{refaddr}; use List::Util (); use Params::Util qw{_INSTANCE _CLASS _CODELIKE _NUMBER}; use PPI::Element (); use PPI::Singletons '%_PARENT'; our $VERSION = '1.270'; # VERSION our @ISA = "PPI::Element"; ##################################################################### # The basic constructor sub new { my $class = ref $_[0] || $_[0]; bless { children => [] }, $class; } ##################################################################### # PDOM Methods =pod =head2 scope The C method returns true if the node represents a lexical scope boundary, or false if it does not. =cut ### XS -> PPI/XS.xs:_PPI_Node__scope 0.903+ sub scope() { '' } =pod =head2 add_element $Element The C method adds a L object to the end of a C. Because Elements maintain links to their parent, an Element can only be added to a single Node. Returns true if the L was added. Returns C if the Element was already within another Node, or the method is not passed a L object. =cut sub add_element { my $self = shift; # Check the element my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; $_PARENT{refaddr $Element} and return undef; # Add the argument to the elements push @{$self->{children}}, $Element; Scalar::Util::weaken( $_PARENT{refaddr $Element} = $self ); 1; } # In a typical run profile, add_element is the number 1 resource drain. # This is a highly optimised unsafe version, for internal use only. sub __add_element { Scalar::Util::weaken( $_PARENT{refaddr $_[1]} = $_[0] ); push @{$_[0]->{children}}, $_[1]; } =pod =head2 elements The C method accesses all child elements B within the C object. Note that in the base of the L classes, this C include the brace tokens at either end of the structure. Returns a list of zero or more L objects. Alternatively, if called in the scalar context, the C method returns a count of the number of elements. =cut sub elements { if ( wantarray ) { return @{$_[0]->{children}}; } else { return scalar @{$_[0]->{children}}; } } =pod =head2 first_element The C method accesses the first element structurally within the C object. As for the C method, this does include the brace tokens for L objects. Returns a L object, or C if for some reason the C object does not contain any elements. =cut # Normally the first element is also the first child sub first_element { $_[0]->{children}->[0]; } =pod =head2 last_element The C method accesses the last element structurally within the C object. As for the C method, this does include the brace tokens for L objects. Returns a L object, or C if for some reason the C object does not contain any elements. =cut # Normally the last element is also the last child sub last_element { $_[0]->{children}->[-1]; } =pod =head2 children The C method accesses all child elements lexically within the C object. Note that in the case of the L classes, this does B include the brace tokens at either end of the structure. Returns a list of zero of more L objects. Alternatively, if called in the scalar context, the C method returns a count of the number of lexical children. =cut # In the default case, this is the same as for the elements method sub children { wantarray ? @{$_[0]->{children}} : scalar @{$_[0]->{children}}; } =pod =head2 schildren The C method is really just a convenience, the significant-only variation of the normal C method. In list context, returns a list of significant children. In scalar context, returns the number of significant children. =cut sub schildren { return grep { $_->significant } @{$_[0]->{children}} if wantarray; my $count = 0; foreach ( @{$_[0]->{children}} ) { $count++ if $_->significant; } return $count; } =pod =head2 child $index The C method accesses a child L object by its position within the Node. Returns a L object, or C if there is no child element at that node. =cut sub child { my ( $self, $index ) = @_; PPI::Exception->throw( "method child() needs an index" ) if not defined _NUMBER $index; $self->{children}->[$index]; } =pod =head2 schild $index The lexical structure of the Perl language ignores 'insignificant' items, such as whitespace and comments, while L treats these items as valid tokens so that it can reassemble the file at any time. Because of this, in many situations there is a need to find an Element within a Node by index, only counting lexically significant Elements. The C method returns a child Element by index, ignoring insignificant Elements. The index of a child Element is specified in the same way as for a normal array, with the first Element at index 0, and negative indexes used to identify a "from the end" position. =cut sub schild { my $self = shift; my $idx = 0 + shift; my $el = $self->{children}; if ( $idx < 0 ) { my $cursor = 0; while ( exists $el->[--$cursor] ) { return $el->[$cursor] if $el->[$cursor]->significant and ++$idx >= 0; } } else { my $cursor = -1; while ( exists $el->[++$cursor] ) { return $el->[$cursor] if $el->[$cursor]->significant and --$idx < 0; } } undef; } =pod =head2 contains $Element The C method is used to determine if another L object is logically "within" a C. For the special case of the brace tokens at either side of a L object, they are generally considered "within" a L object, even if they are not actually in the elements for the L. Returns true if the L is within us, false if not, or C on error. =cut sub contains { my $self = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; # Iterate up the Element's parent chain until we either run out # of parents, or get to ourself. while ( $Element = $Element->parent ) { return 1 if refaddr($self) == refaddr($Element); } ''; } =pod =head2 find $class | \&wanted The C method is used to search within a code tree for L objects that meet a particular condition. To specify the condition, the method can be provided with either a simple class name (full or shortened), or a C/function reference. # Find all single quotes in a Document (which is a Node) $Document->find('PPI::Quote::Single'); # The same thing with a shortened class name $Document->find('Quote::Single'); # Anything more elaborate, we go with the sub $Document->find( sub { # At the top level of the file... $_[1]->parent == $_[0] and ( # ...find all comments and POD $_[1]->isa('PPI::Token::Pod') or $_[1]->isa('PPI::Token::Comment') ) } ); The function will be passed two arguments, the top-level C you are searching in and the current L that the condition is testing. The anonymous function should return one of three values. Returning true indicates a condition match, defined-false (C<0> or C<''>) indicates no-match, and C indicates no-match and no-descend. In the last case, the tree walker will skip over anything below the C-returning element and move on to the next element at the same level. To halt the entire search and return C immediately, a condition function should throw an exception (i.e. C). Note that this same wanted logic is used for all methods documented to have a C<\&wanted> parameter, as this one does. The C method returns a reference to an array of L objects that match the condition, false (but defined) if no Elements match the condition, or C if you provide a bad condition, or an error occurs during the search process. In the case of a bad condition, a warning will be emitted as well. =cut sub find { my $self = shift; my $wanted = $self->_wanted(shift) or return undef; # Use a queue based search, rather than a recursive one my @found; my @queue = @{$self->{children}}; my $ok = eval { while ( @queue ) { my $Element = shift @queue; my $rv = &$wanted( $self, $Element ); push @found, $Element if $rv; # Support "don't descend on undef return" next unless defined $rv; # Skip if the Element doesn't have any children next unless $Element->isa('PPI::Node'); # Depth-first keeps the queue size down and provides a # better logical order. if ( $Element->isa('PPI::Structure') ) { unshift @queue, $Element->finish if $Element->finish; unshift @queue, @{$Element->{children}}; unshift @queue, $Element->start if $Element->start; } else { unshift @queue, @{$Element->{children}}; } } 1; }; if ( !$ok ) { # Caught exception thrown from the wanted function return undef; } @found ? \@found : ''; } =pod =head2 find_first $class | \&wanted If the normal C method is like a grep, then C is equivalent to the L C function. Given an element class or a wanted function, it will search depth-first through a tree until it finds something that matches the condition, returning the first Element that it encounters. See the C method for details on the format of the search condition. Returns the first L object that matches the condition, false if nothing matches the condition, or C if given an invalid condition, or an error occurs. =cut sub find_first { my $self = shift; my $wanted = $self->_wanted(shift) or return undef; # Use the same queue-based search as for ->find my @queue = @{$self->{children}}; my $rv; my $ok = eval { # The defined() here prevents a ton of calls to PPI::Util::TRUE while ( @queue ) { my $Element = shift @queue; my $element_rv = $wanted->( $self, $Element ); if ( $element_rv ) { $rv = $Element; last; } # Support "don't descend on undef return" next if !defined $element_rv; # Skip if the Element doesn't have any children next if !$Element->isa('PPI::Node'); # Depth-first keeps the queue size down and provides a # better logical order. if ( $Element->isa('PPI::Structure') ) { unshift @queue, $Element->finish if defined($Element->finish); unshift @queue, @{$Element->{children}}; unshift @queue, $Element->start if defined($Element->start); } else { unshift @queue, @{$Element->{children}}; } } 1; }; if ( !$ok ) { # Caught exception thrown from the wanted function return undef; } $rv or ''; } =pod =head2 find_any $class | \&wanted The C method is a short-circuiting true/false method that behaves like the normal C method, but returns true as soon as it finds any Elements that match the search condition. See the C method for details on the format of the search condition. Returns true if any Elements that match the condition can be found, false if not, or C if given an invalid condition, or an error occurs. =cut sub find_any { my $self = shift; my $rv = $self->find_first(@_); $rv ? 1 : $rv; # false or undef } =pod =head2 remove_child $Element If passed a L object that is a direct child of the Node, the C method will remove the C intact, along with any of its children. As such, this method acts essentially as a 'cut' function. If successful, returns the removed element. Otherwise, returns C. =cut sub remove_child { my $self = shift; my $child = _INSTANCE(shift, 'PPI::Element') or return undef; # Find the position of the child my $key = refaddr $child; my $p = List::Util::first { refaddr $self->{children}[$_] == $key } 0..$#{$self->{children}}; return undef unless defined $p; # Splice it out, and remove the child's parent entry splice( @{$self->{children}}, $p, 1 ); delete $_PARENT{refaddr $child}; $child; } =pod =head2 prune $class | \&wanted The C method is used to strip L objects out of a code tree. The argument is the same as for the C method, either a class name, or an anonymous subroutine which returns true/false. Any Element that matches the class|wanted will be deleted from the code tree, along with any of its children. The C method returns the number of C objects that matched and were removed, B. This might also be zero, so avoid a simple true/false test on the return false of the C method. It returns C on error, which you probably B test for. =cut sub prune { my $self = shift; my $wanted = $self->_wanted(shift) or return undef; # Use a depth-first queue search my $pruned = 0; my @queue = $self->children; my $ok = eval { while ( my $element = shift @queue ) { my $rv = &$wanted( $self, $element ); if ( $rv ) { # Delete the child $element->delete or return undef; $pruned++; next; } # Support the undef == "don't descend" next unless defined $rv; if ( _INSTANCE($element, 'PPI::Node') ) { # Depth-first keeps the queue size down unshift @queue, $element->children; } } 1; }; if ( !$ok ) { # Caught exception thrown from the wanted function return undef; } $pruned; } # This method is likely to be very heavily used, so take # it slowly and carefully. ### NOTE: Renaming this function or changing either to self will probably ### break File::Find::Rule::PPI sub _wanted { my $either = shift; my $it = defined($_[0]) ? shift : do { Carp::carp('Undefined value passed as search condition') if $^W; return undef; }; # Has the caller provided a wanted function directly return $it if _CODELIKE($it); if ( ref $it ) { # No other ref types are supported Carp::carp('Illegal non-CODE reference passed as search condition') if $^W; return undef; } # The first argument should be an Element class, possibly in shorthand $it = "PPI::$it" unless substr($it, 0, 5) eq 'PPI::'; unless ( _CLASS($it) and $it->isa('PPI::Element') ) { # We got something, but it isn't an element Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W; return undef; } # Create the class part of the wanted function my $wanted_class = "\n\treturn '' unless \$_[1]->isa('$it');"; # Have we been given a second argument to check the content my $wanted_content = ''; if ( defined $_[0] ) { my $content = shift; if ( ref $content eq 'Regexp' ) { $content = "$content"; } elsif ( ref $content ) { # No other ref types are supported Carp::carp("Cannot create search condition for '$it': Not a PPI::Element") if $^W; return undef; } else { $content = quotemeta $content; } # Complete the content part of the wanted function $wanted_content .= "\n\treturn '' unless defined \$_[1]->{content};"; $wanted_content .= "\n\treturn '' unless \$_[1]->{content} =~ /$content/;"; } # Create the complete wanted function my $code = "sub {" . $wanted_class . $wanted_content . "\n\t1;" . "\n}"; # Compile the wanted function $code = eval $code; (ref $code eq 'CODE') ? $code : undef; } #################################################################### # PPI::Element overloaded methods sub tokens { map { $_->tokens } @{$_[0]->{children}}; } ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+ sub content { join '', map { $_->content } @{$_[0]->{children}}; } # Clone as normal, but then go down and relink all the _PARENT entries sub clone { my $self = shift; my $clone = $self->SUPER::clone; $clone->__link_children; $clone; } sub location { my $self = shift; my $first = $self->{children}->[0] or return undef; $first->location; } ##################################################################### # Internal Methods sub DESTROY { local $_; if ( $_[0]->{children} ) { my @queue = $_[0]; while ( defined($_ = shift @queue) ) { unshift @queue, @{delete $_->{children}} if $_->{children}; # Remove all internal/private weird crosslinking so that # the cascading DESTROY calls will get called properly. %$_ = (); } } # Remove us from our parent node as normal delete $_PARENT{refaddr $_[0]}; } # Find the position of a child sub __position { my $key = refaddr $_[1]; List::Util::first { refaddr $_[0]{children}[$_] == $key } 0..$#{$_[0]{children}}; } # Insert one or more elements before a child sub __insert_before_child { my $self = shift; my $key = refaddr shift; my $p = List::Util::first { refaddr $self->{children}[$_] == $key } 0..$#{$self->{children}}; foreach ( @_ ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } splice( @{$self->{children}}, $p, 0, @_ ); 1; } # Insert one or more elements after a child sub __insert_after_child { my $self = shift; my $key = refaddr shift; my $p = List::Util::first { refaddr $self->{children}[$_] == $key } 0..$#{$self->{children}}; foreach ( @_ ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } splice( @{$self->{children}}, $p + 1, 0, @_ ); 1; } # Replace a child sub __replace_child { my $self = shift; my $key = refaddr shift; my $p = List::Util::first { refaddr $self->{children}[$_] == $key } 0..$#{$self->{children}}; foreach ( @_ ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } splice( @{$self->{children}}, $p, 1, @_ ); 1; } # Create PARENT links for an entire tree. # Used when cloning or thawing. sub __link_children { my $self = shift; # Relink all our children ( depth first ) my @queue = ( $self ); while ( my $Node = shift @queue ) { # Link our immediate children foreach my $Element ( @{$Node->{children}} ) { Scalar::Util::weaken( $_PARENT{refaddr($Element)} = $Node ); unshift @queue, $Element if $Element->isa('PPI::Node'); } # If it's a structure, relink the open/close braces next unless $Node->isa('PPI::Structure'); Scalar::Util::weaken( $_PARENT{refaddr($Node->start)} = $Node ) if $Node->start; Scalar::Util::weaken( $_PARENT{refaddr($Node->finish)} = $Node ) if $Node->finish; } 1; } 1; =pod =head1 TO DO - Move as much as possible to L =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Util.pm100644000000000000 350313511127601 15232 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Util; # Provides some common utility functions that can be imported use strict; use Exporter (); use Digest::MD5 (); use Params::Util qw{_INSTANCE _SCALAR0 _ARRAY0}; our $VERSION = '1.270'; # VERSION our @ISA = 'Exporter'; our @EXPORT_OK = qw{ _Document _slurp }; # 5.8.7 was the first version to resolve the notorious # "unicode length caching" bug. use constant HAVE_UNICODE => !! ( $] >= 5.008007 ); # Common reusable true and false functions # This makes it easy to upgrade many places in PPI::XS sub TRUE () { 1 } sub FALSE () { '' } ##################################################################### # Functions # Allows a sub that takes a L to handle the full range # of different things, including file names, SCALAR source, etc. sub _Document { shift if @_ > 1; return undef unless defined $_[0]; require PPI::Document; return PPI::Document->new(shift) unless ref $_[0]; return PPI::Document->new(shift) if _SCALAR0($_[0]); return PPI::Document->new(shift) if _ARRAY0($_[0]); return shift if _INSTANCE($_[0], 'PPI::Document'); return undef; } # Provide a simple _slurp implementation sub _slurp { my $file = shift; local $/ = undef; local *FILE; open( FILE, '<', $file ) or return "open($file) failed: $!"; my $source = ; close( FILE ) or return "close($file) failed: $!"; return \$source; } # Provides a version of Digest::MD5's md5hex that explicitly # works on the unix-newlined version of the content. sub md5hex { my $string = shift; $string =~ s/(?:\015{1,2}\012|\015|\012)/\015/gs; Digest::MD5::md5_hex($string); } # As above but slurps and calculates the id for a file by name sub md5hex_file { my $file = shift; my $content = _slurp($file); return undef unless ref $content; $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs; md5hex($$content); } 1; 03_document.t100644000000000000 337413511127601 15337 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # PPI::Document tests use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 13 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use PPI; ##################################################################### # Test a basic document # Parse a simple document in all possible ways NEW: { my $file = catfile(qw{ t data 03_document test.dat }); ok( -f $file, 'Found test.dat' ); my $doc1 = PPI::Document->new( $file ); isa_ok( $doc1, 'PPI::Document' ); # Test script my $script = <<'END_PERL'; #!/usr/bin/perl # A simple test script print "Hello World!\n"; END_PERL my $doc2 = PPI::Document->new( \$script ); isa_ok( $doc2, 'PPI::Document' ); my $doc3 = PPI::Document->new( [ "#!/usr/bin/perl", "", "# A simple test script", "", "print \"Hello World!\\n\";", ] ); isa_ok( $doc3, 'PPI::Document' ); # Compare the three forms is_deeply( $doc1, $doc2, 'Stringref form matches file form' ); is_deeply( $doc1, $doc3, 'Arrayref form matches file form' ); } # Repeat the above with a null document NEW_EMPTY: { my $empty = catfile(qw{ t data 03_document empty.dat }); ok( -f $empty, 'Found empty.dat' ); my $doc1 = PPI::Document->new( $empty ); isa_ok( $doc1, 'PPI::Document' ); my $doc2 = PPI::Document->new( \'' ); isa_ok( $doc2, 'PPI::Document' ); my $doc3 = PPI::Document->new( [ ] ); isa_ok( $doc3, 'PPI::Document' ); # Compare the three forms is_deeply( $doc1, $doc2, 'Stringref form matches file form' ); is_deeply( $doc1, $doc3, 'Arrayref form matches file form' ); # Make sure the null document round-trips my $string = $doc1->serialize; is( $string, '', '->serialize ok' ); # Check for warnings on null document index_locations { local $^W = 1; $doc1->index_locations(); } } 12_location.t100644000000000000 2307013511127601 15344 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Tests the accuracy and features for location functionality use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 682 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; my $test_source = <<'END_PERL'; my $foo = 'bar'; # comment sub foo { my ($this, $that) = (<<'THIS', <<"THAT"); foo bar baz THIS foo bar THAT } sub baz { # sub baz contains *tabs* my ($one, $other) = ("one", "other"); # contains 4 tabs foo() ; } sub bar { baz(); #Note that there are leading 4 x space, not 1 x tab in the sub bar bas(); } =head2 fluzz() Print "fluzz". Return 1. =cut sub fluzz { print "fluzz";# line 300 not_at_start_of_line } #line 400 $a # line 500 $b #line600 $c #line 700 filename $d #line 800another-filename $e #line 900 yet-another-filename $f #line 1000"quoted-filename" $g =pod #line 1100 =cut $h =pod #line 1200 =cut $i =pod # line 1300 =cut $j =pod #line1400 =cut $k =pod #line 1500 filename =cut $l =pod #line 1600another-filename =cut $m =pod #line 1700 yet-another-filename =cut $n =pod #line 1800"quoted-filename" =cut $o 1; END_PERL my @test_locations = ( [ 1, 1, 1, 1, undef ], # my [ 1, 3, 3, 1, undef ], # ' ' [ 1, 4, 4, 1, undef ], # $foo [ 1, 8, 8, 1, undef ], # ' ' [ 1, 9, 9, 1, undef ], # = [ 1, 10, 10, 1, undef ], # ' ' [ 1, 11, 11, 1, undef ], # 'bar' [ 1, 16, 16, 1, undef ], # ; [ 1, 17, 17, 1, undef ], # \n [ 2, 1, 1, 2, undef ], # \n [ 3, 1, 1, 3, undef ], # # comment [ 4, 1, 1, 4, undef ], # sub [ 4, 4, 4, 4, undef ], # ' ' [ 4, 5, 5, 4, undef ], # foo [ 4, 8, 8, 4, undef ], # ' ' [ 4, 9, 9, 4, undef ], # { [ 4, 10, 10, 4, undef ], # \n [ 5, 1, 1, 5, undef ], # ' ' [ 5, 5, 5, 5, undef ], # my [ 5, 7, 7, 5, undef ], # ' ' [ 5, 8, 8, 5, undef ], # ( [ 5, 9, 9, 5, undef ], # $this [ 5, 14, 14, 5, undef ], # , [ 5, 15, 15, 5, undef ], # ' ' [ 5, 16, 16, 5, undef ], # $that [ 5, 21, 21, 5, undef ], # ) [ 5, 22, 22, 5, undef ], # ' ' [ 5, 23, 23, 5, undef ], # = [ 5, 24, 24, 5, undef ], # ' ' [ 5, 25, 25, 5, undef ], # ( [ 5, 26, 26, 5, undef ], # <<'THIS' [ 5, 34, 34, 5, undef ], # , [ 5, 35, 35, 5, undef ], # ' ' [ 5, 36, 36, 5, undef ], # <<"THAT" [ 5, 44, 44, 5, undef ], # ) [ 5, 45, 45, 5, undef ], # ; [ 5, 46, 46, 5, undef ], # \n [ 13, 1, 1, 13, undef ], # } [ 13, 2, 2, 13, undef ], # \n [ 14, 1, 1, 14, undef ], # \n [ 15, 1, 1, 15, undef ], # sub [ 15, 4, 4, 15, undef ], # ' ' [ 15, 5, 5, 15, undef ], # baz [ 15, 8, 8, 15, undef ], # ' ' [ 15, 9, 9, 15, undef ], # { [ 15, 10, 10, 15, undef ], # \n [ 16, 1, 1, 16, undef ], # tab# sub baz contains *tabs* [ 17, 1, 1, 17, undef ], # tab [ 17, 2, 5, 17, undef ], # my [ 17, 4, 7, 17, undef ], # ' ' [ 17, 5, 8, 17, undef ], # ( [ 17, 6, 9, 17, undef ], # $one [ 17, 10, 13, 17, undef ], # , [ 17, 11, 14, 17, undef ], # ' ' [ 17, 12, 15, 17, undef ], # $other [ 17, 18, 21, 17, undef ], # ) [ 17, 19, 22, 17, undef ], # ' ' [ 17, 20, 23, 17, undef ], # = [ 17, 21, 24, 17, undef ], # ' tab' [ 17, 23, 29, 17, undef ], # ( [ 17, 24, 30, 17, undef ], # "one" [ 17, 29, 35, 17, undef ], # , [ 17, 30, 36, 17, undef ], # tab [ 17, 31, 37, 17, undef ], # "other" [ 17, 38, 44, 17, undef ], # ) [ 17, 39, 45, 17, undef ], # ; [ 17, 40, 46, 17, undef ], # tab [ 17, 41, 49, 17, undef ], # # contains 3 tabs [ 17, 58, 66, 17, undef ], # \n [ 18, 1, 1, 18, undef ], # \n\t [ 19, 2, 5, 19, undef ], # foo [ 19, 5, 8, 19, undef ], # ( [ 19, 6, 9, 19, undef ], # ) [ 19, 7, 10, 19, undef ], # tab [ 19, 8, 13, 19, undef ], # ; [ 19, 9, 14, 19, undef ], # \n [ 20, 1, 1, 20, undef ], # { [ 20, 2, 2, 20, undef ], # \n [ 21, 1, 1, 21, undef ], # \n [ 22, 1, 1, 22, undef ], # sub [ 22, 4, 4, 22, undef ], # ' ' [ 22, 5, 5, 22, undef ], # bar [ 22, 8, 8, 22, undef ], # ' ' [ 22, 9, 9, 22, undef ], # { [ 22, 10, 10, 22, undef ], # \n [ 23, 1, 1, 23, undef ], # ' ' [ 23, 5, 5, 23, undef ], # baz [ 23, 8, 8, 23, undef ], # ( [ 23, 9, 9, 23, undef ], # ) [ 23, 10, 10, 23, undef ], # ; [ 23, 11, 11, 23, undef ], # \n [ 24, 1, 1, 24, undef ], # \n [ 25, 1, 1, 25, undef ], # #Note that there are leading 4 x space, ... [ 26, 1, 1, 26, undef ], # '\n ' [ 27, 5, 5, 27, undef ], # bas [ 27, 8, 8, 27, undef ], # ( [ 27, 9, 9, 27, undef ], # ) [ 27, 10, 10, 27, undef ], # ; [ 27, 11, 11, 27, undef ], # \n [ 28, 1, 1, 28, undef ], # } [ 28, 2, 2, 28, undef ], # \n [ 29, 1, 1, 29, undef ], # \n [ 30, 1, 1, 30, undef ], # =head2 fluzz() ... [ 35, 1, 1, 35, undef ], # sub [ 35, 4, 4, 35, undef ], # ' ' [ 35, 5, 5, 35, undef ], # fluzz [ 35, 10, 10, 35, undef ], # ' ' [ 35, 11, 11, 35, undef ], # { [ 35, 12, 12, 35, undef ], # \n [ 36, 1, 1, 36, undef ], # ' ' [ 36, 5, 5, 36, undef ], # print [ 36, 10, 10, 36, undef ], # ' ' [ 36, 11, 11, 36, undef ], # "fluzz" [ 36, 18, 18, 36, undef ], # ; [ 36, 19, 19, 36, undef ], # # line 300 not_at_start_of_line [ 36, 50, 50, 36, undef ], # \n [ 37, 1, 1, 37, undef ], # } [ 37, 2, 2, 37, undef ], # \n [ 38, 1, 1, 38, undef ], # \n [ 39, 1, 1, 39, undef ], # #line 400 [ 40, 1, 1, 400, undef ], # $a [ 40, 3, 3, 400, undef ], # \n [ 41, 1, 1, 401, undef ], # # line 500 [ 42, 1, 1, 500, undef ], # $b [ 42, 3, 3, 500, undef ], # \n # No space between "line" and number causes it to not work. [ 43, 1, 1, 501, undef ], # #line600 [ 44, 1, 1, 502, undef ], # $c [ 44, 3, 3, 502, undef ], # \n [ 45, 1, 1, 503, undef ], # #line 700 filename [ 46, 1, 1, 700, 'filename' ], # $d [ 46, 3, 3, 700, 'filename' ], # \n [ 47, 1, 1, 701, 'filename' ], # #line 800another-filename [ 48, 1, 1, 800, 'another-filename' ], # $e [ 48, 3, 3, 800, 'another-filename' ], # \n [ 49, 1, 1, 801, 'another-filename' ], # #line 900 yet-another-filename [ 50, 1, 1, 900, 'yet-another-filename' ], # $f [ 50, 3, 3, 900, 'yet-another-filename' ], # \n [ 51, 1, 1, 901, 'yet-another-filename' ], # #line 1000"quoted-filename" [ 52, 1, 1, 1000, 'quoted-filename' ], # $g [ 52, 3, 3, 1000, 'quoted-filename' ], # \n [ 53, 1, 1, 1001, 'quoted-filename' ], # \n [ 54, 1, 1, 1002, 'quoted-filename' ], # =pod #line 1100 (not in column 1) [ 59, 1, 1, 1007, 'quoted-filename' ], # $h [ 59, 3, 3, 1007, 'quoted-filename' ], # \n [ 60, 1, 1, 1008, 'quoted-filename' ], # =pod #line 1200 [ 65, 1, 1, 1202, 'quoted-filename' ], # $i [ 65, 3, 3, 1202, 'quoted-filename' ], # \n [ 66, 1, 1, 1203, 'quoted-filename' ], # =pod # line 1300 [ 71, 1, 1, 1302, 'quoted-filename' ], # $j [ 71, 3, 3, 1302, 'quoted-filename' ], # \n # No space between "line" and number causes it to not work. [ 72, 1, 1, 1303, 'quoted-filename' ], # =pod #line1400 [ 77, 1, 1, 1308, 'quoted-filename' ], # $k [ 77, 3, 3, 1308, 'quoted-filename' ], # \n [ 78, 1, 1, 1309, 'quoted-filename' ], # =pod #line 1500 filename [ 83, 1, 1, 1502, 'filename' ], # $l [ 83, 3, 3, 1502, 'filename' ], # \n [ 84, 1, 1, 1503, 'filename' ], # =pod #line 1600another-filename [ 89, 1, 1, 1602, 'another-filename' ], # $m [ 89, 3, 3, 1602, 'another-filename' ], # \n [ 90, 1, 1, 1603, 'another-filename' ], # =pod #line 1700 yet-another-filename [ 95, 1, 1, 1702, 'yet-another-filename' ], # $n [ 95, 3, 3, 1702, 'yet-another-filename' ], # \n [ 96, 1, 1, 1703, 'yet-another-filename' ], # =pod #line 1800"quoted-filename" [ 101, 1, 1, 1802, 'quoted-filename' ], # $o [ 101, 3, 3, 1802, 'quoted-filename' ], # \n [ 102, 1, 1, 1803, 'quoted-filename' ], # \n [ 103, 1, 1, 1804, 'quoted-filename' ], # 1 [ 103, 2, 2, 1804, 'quoted-filename' ], # ; [ 103, 3, 3, 1804, 'quoted-filename' ], # \n ); ##################################################################### # Test the locations of everything in the test code # Prepare my $Document = PPI::Document->new( \$test_source ); isa_ok( $Document, 'PPI::Document' ); $Document->tab_width(4); is($Document->tab_width, 4, 'Tab width set correctly'); ok( $Document->index_locations, '->index_locations returns true' ); # Now check the locations of every token my @tokens = $Document->tokens; is( scalar(@tokens), scalar(@test_locations), 'Number of tokens matches expected' ); foreach my $i ( 0 .. $#test_locations ) { my $location = $tokens[$i]->location; is( ref($location), 'ARRAY', "Token $i: ->location returns an ARRAY ref" ); is( scalar(@$location), 5, "Token $i: ->location returns a 5 element ARRAY ref" ); ok( ( $location->[0] > 0 and $location->[1] > 0 and $location->[2] > 0 and $location->[3] > 0 ), "Token $i: ->location returns four positive positions" ); is_deeply( $tokens[$i]->location, $test_locations[$i], "Token $i: ->location matches expected", ); } ok( $Document->flush_locations, '->flush_locations returns true' ); is( scalar(grep { defined $_->{_location} } $Document->tokens), 0, 'All _location attributes removed' ); 14_charsets.t100644000000000000 502113511127601 15326 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More; BEGIN { if ($] < 5.008007) { Test::More->import( skip_all => "Unicode support requires perl 5.8.7" ); exit(0); } plan( tests => 16 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); } use utf8; # perl version check above says this is okay use Params::Util qw{_INSTANCE}; use PPI; sub good_ok { my $source = shift; my $message = shift; my $doc = PPI::Document->new( \$source ); ok( _INSTANCE($doc, 'PPI::Document'), $message ); if ( ! _INSTANCE($doc, 'PPI::Document') ) { diag($PPI::Document::errstr); } } ##################################################################### # Begin Tests # We cannot reliably support Unicode on anything less than 5.8.5 SKIP: { # In some (weird) cases with custom locales, things aren't words # that should be unless ( "ä" =~ /\w/ ) { skip( "Unicode-incompatible locale in use (apparently)", 11 ); } # Notorious test case. # In 1.203 this test case causes a memory leaking infinite loop # that consumes all available memory and then crashes the process. good_ok( '一();', "Function with Chinese characters" ); # Byte order mark with no unicode content good_ok( "\xef\xbb\xbf1;\n", "BOM without actual unicode content" ); # Testing accented characters in UTF-8 good_ok( 'sub func { }', "Parsed code without accented chars" ); good_ok( 'rätselhaft();', "Function with umlaut" ); good_ok( 'ätselhaft()', "Starting with umlaut" ); good_ok( '"rätselhaft"', "In double quotes" ); good_ok( "'rätselhaft'", "In single quotes" ); good_ok( 'sub func { s/a/ä/g; }', "Regex with umlaut" ); good_ok( 'sub func { $ä=1; }', "Variable with umlaut" ); good_ok( '$一 = "壹";', "Variables with Chinese characters" ); good_ok( '$a=1; # ä is an umlaut', "Comment with umlaut" ); good_ok( <<'END_CODE', "POD with umlaut" ); sub func { } =pod =head1 Umlauts like ä } END_CODE ok(utf8::is_utf8('κλειδί'), "utf8 flag set on source string"); good_ok( 'my %h = ( κλειδί => "Clé" );', "Hash with greek key in character string" ); use Encode; my $bytes = Encode::encode('utf8', 'use utf8; my %h = ( κλειδί => "Clé" );'); ok(!utf8::is_utf8($bytes), "utf8 flag not set on byte string"); { local $TODO = "Fix CRASH"; good_ok( $bytes, "Hash with greek key in bytes string" ); } } 17_storable.t100644000000000000 250213511127601 15331 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Test compatibility with Storable use lib 't/lib'; use PPI::Test::pragmas; use Test::More; BEGIN { # Is Storable installed? if ( eval { require Storable; 1 } ) { plan( tests => 9 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); } else { plan( 'skip_all' ); exit(0); } } use Scalar::Util 'refaddr'; use PPI; ##################################################################### # Test freeze/thaw of PPI::Document objects SCOPE: { # Create a document with various example package statements my $Document = PPI::Lexer->lex_source( <<'END_PERL' ); package Foo; @ISA = (qw/File::Spec/); 1; END_PERL Test::More::isa_ok( $Document, 'PPI::Document' ); { my $isa = $Document->find_first(sub { $_[1] eq '@ISA'; }); Test::More::ok( $isa, "Found ISA var"); Test::More::is( $isa->parent, q|@ISA = (qw/File::Spec/);|, "Got parent ok"); } my $clone = Storable::dclone($Document); Test::More::ok($clone, "dclone ok"); Test::More::isnt( refaddr($Document), refaddr($clone), "Not the same object" ); Test::More::is(ref($Document), ref($clone), "Same class"); Test::More::is_deeply( $Document, $clone, "Deeply equal" ); { my $isa = $clone->find_first(sub { $_[1] eq '@ISA'; }); Test::More::ok($isa, "Found ISA var"); Test::More::is($isa->parent, q|@ISA = (qw/File::Spec/);|, "Got parent ok"); # <-- this one fails } } 22_readonly.t100644000000000000 177013511127601 15335 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Testing of readonly functionality use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI::Document; ##################################################################### # Creating Documents SCOPE: { # Blank document my $empty = PPI::Document->new; isa_ok( $empty, 'PPI::Document' ); is( $empty->readonly, '', '->readonly is false for blank' ); # From source my $source = 'print "Hello World!\n"'; my $doc1 = PPI::Document->new( \$source ); isa_ok( $doc1, 'PPI::Document' ); is( $doc1->readonly, '', '->readonly is false by default' ); # With explicit false my $doc2 = PPI::Document->new( \$source, readonly => undef, ); isa_ok( $doc2, 'PPI::Document' ); is( $doc2->readonly, '', '->readonly is false for explicit false' ); # With explicit true my $doc3 = PPI::Document->new( \$source, readonly => 2, ); isa_ok( $doc3, 'PPI::Document' ); is( $doc3->readonly, 1, '->readonly is true for explicit true' ); } 27_complete.t100644000000000000 204313511127601 15327 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Testing for the PPI::Document ->complete method use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use File::Spec::Functions ':ALL'; use PPI; use PPI::Test 'find_files'; # This test uses a series of ordered files, containing test code. # The letter after the number acts as a boolean yes/no answer to # "Is this code complete" my @files = find_files( catdir( 't', 'data', '27_complete' ) ); my $tests = (scalar(@files) * 2) + 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0); plan( tests => $tests ); ##################################################################### # Resource Location ok( scalar(@files), 'Found at least one ->complete test file' ); foreach my $file ( @files ) { # Load the document my $document = PPI::Document->new( $file ); isa_ok( $document, 'PPI::Document' ); # Test if complete or not my $got = !! ($document->complete); my $expected = !! ($file =~ /\d+y\w+\.code$/); my $isnot = ($got == $expected) ? 'is' : 'is NOT'; is( $got, $expected, "File $file $isnot complete" ); } data000755000000000000 013511127601 13574 5ustar00unknownunknown000000000000PPI-1.270/tbasic.pl100644000000000000 7413511127601 15313 0ustar00unknownunknown000000000000PPI-1.270/t/data#!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } 1; interactive.t100644000000000000 117313511127601 15527 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Script used to temporarily test the most recent parser bug. # Testing it here is much more efficient than having to trace # down through the entire set of regression tests. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 2 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; # Define the test code my $code = 'sub f:f('; ##################################################################### # Run the actual tests my $document = eval { PPI::Document->new(\$code) }; $DB::single = $DB::single = 1 if $@; # Catch exceptions is( $@, '', 'Parsed without error' ); isa_ok( $document, 'PPI::Document' ); lib000755000000000000 013511127601 13431 5ustar00unknownunknown000000000000PPI-1.270/tHelper.pm100644000000000000 51613511127601 15330 0ustar00unknownunknown000000000000PPI-1.270/t/libpackage Helper; use strict; use warnings; use Exporter (); our @ISA = "Exporter"; our @EXPORT_OK = qw( check_with ); sub check_with { my ( $code, $checker ) = @_; my $Document = PPI::Document->new( \$code ); is( PPI::Document->errstr, undef ) if PPI::Document->errstr; local $_ = $Document; $checker->(); } 1; ppi_element.t100644000000000000 1370713511127601 15541 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Element use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 57 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; __INSERT_AFTER: { my $Document = PPI::Document->new( \"print 'Hello World';" ); isa_ok( $Document, 'PPI::Document' ); my $string = $Document->find_first('Token::Quote'); isa_ok( $string, 'PPI::Token::Quote' ); is( $string->content, "'Hello World'", 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $string->__insert_after( $foo ); is( $Document->serialize, "print 'Hello World'foo;", '__insert_after actually inserts' ); } __INSERT_BEFORE: { my $Document = PPI::Document->new( \"print 'Hello World';" ); isa_ok( $Document, 'PPI::Document' ); my $semi = $Document->find_first('Token::Structure'); isa_ok( $semi, 'PPI::Token::Structure' ); is( $semi->content, ';', 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $semi->__insert_before( $foo ); is( $Document->serialize, "print 'Hello World'foo;", '__insert_before actually inserts' ); } ANCESTOR_OF: { my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' ); isa_ok( $Document, 'PPI::Document' ); ok( $Document->ancestor_of($Document), 'Document is an ancestor of itself.', ); my $words = $Document->find('Token::Word'); is(scalar @{$words}, 1, 'Document contains 1 Word.'); my $word = $words->[0]; ok( $word->ancestor_of($word), 'Word is an ancestor of itself.', ); ok( ! $word->ancestor_of($Document), 'Word is not an ancestor of the Document.', ); ok( $Document->ancestor_of($word), 'Document is an ancestor of the Word.', ); my $symbols = $Document->find('Token::Symbol'); is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); my $symbol = $symbols->[0]; ok( ! $word->ancestor_of($symbol), 'Word is not an ancestor the Symbol.', ); ok( ! $symbol->ancestor_of($word), 'Symbol is not an ancestor the Word.', ); } COLUMN_NUMBER: { my $document = PPI::Document->new(\<<'END_PERL'); foo END_PERL isa_ok( $document, 'PPI::Document' ); my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->column_number, 4, 'Got correct column number.' ); } DESCENDANT_OF: { my $Document = PPI::Document->new( \'( [ thingy ] ); $blarg = 1' ); isa_ok( $Document, 'PPI::Document' ); ok( $Document->descendant_of($Document), 'Document is a descendant of itself.', ); my $words = $Document->find('Token::Word'); is(scalar @{$words}, 1, 'Document contains 1 Word.'); my $word = $words->[0]; ok( $word->descendant_of($word), 'Word is a descendant of itself.', ); ok( $word->descendant_of($Document), 'Word is a descendant of the Document.', ); ok( ! $Document->descendant_of($word), 'Document is not a descendant of the Word.', ); my $symbols = $Document->find('Token::Symbol'); is(scalar @{$symbols}, 1, 'Document contains 1 Symbol.'); my $symbol = $symbols->[0]; ok( ! $word->descendant_of($symbol), 'Word is not a descendant the Symbol.', ); ok( ! $symbol->descendant_of($word), 'Symbol is not a descendant the Word.', ); } INSERT_AFTER: { my $Document = PPI::Document->new( \"print 'Hello World';" ); isa_ok( $Document, 'PPI::Document' ); my $string = $Document->find_first('Token::Quote'); isa_ok( $string, 'PPI::Token::Quote' ); is( $string->content, "'Hello World'", 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $string->insert_after( $foo ); is( $Document->serialize, "print 'Hello World'foo;", 'insert_after actually inserts' ); } INSERT_BEFORE: { my $Document = PPI::Document->new( \"print 'Hello World';" ); isa_ok( $Document, 'PPI::Document' ); my $semi = $Document->find_first('Token::Structure'); isa_ok( $semi, 'PPI::Token::Structure' ); is( $semi->content, ';', 'Got expected token' ); my $foo = PPI::Token::Word->new('foo'); isa_ok( $foo, 'PPI::Token::Word' ); is( $foo->content, 'foo', 'Created Word token' ); $semi->insert_before( $foo ); is( $Document->serialize, "print 'Hello World'foo;", 'insert_before actually inserts' ); } LINE_NUMBER: { my $document = PPI::Document->new(\<<'END_PERL'); foo END_PERL isa_ok( $document, 'PPI::Document' ); my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->line_number, 3, 'Got correct line number.' ); } LOGICAL_FILENAME: { # Double quoted so that we don't really have a "#line" at the beginning and # errors in this file itself aren't affected by this. my $document = PPI::Document->new(\<<"END_PERL"); \#line 1 test-file foo END_PERL isa_ok( $document, 'PPI::Document' ); my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->logical_filename, 'test-file', 'Got correct logical line number.', ); } LOGICAL_LINE_NUMBER: { # Double quoted so that we don't really have a "#line" at the beginning and # errors in this file itself aren't affected by this. my $document = PPI::Document->new(\<<"END_PERL"); \#line 1 test-file foo END_PERL isa_ok( $document, 'PPI::Document' ); my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->logical_line_number, 1, 'Got correct logical line number.' ); } VISUAL_COLUMN_NUMBER: { my $document = PPI::Document->new(\<<"END_PERL"); \t foo END_PERL isa_ok( $document, 'PPI::Document' ); my $tab_width = 5; $document->tab_width($tab_width); # don't use a "usual" value. my $words = $document->find('PPI::Token::Word'); is( scalar @{$words}, 1, 'Found expected word token.' ); is( $words->[0]->visual_column_number, $tab_width + 2, 'Got correct visual column number.', ); } Cache.pm100644000000000000 1422613511127601 15344 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Cache; =pod =head1 NAME PPI::Cache - The PPI Document Caching Layer =head1 SYNOPSIS # Set the cache use PPI::Cache path => '/var/cache/ppi-cache'; # Manually create a cache my $Cache = PPI::Cache->new( path => '/var/cache/perl/class-PPI', readonly => 1, ); =head1 DESCRIPTION C provides the default caching functionality for L. It integrates automatically with L itself. Once enabled, any attempt to load a document from the filesystem will be cached via cache. Please note that creating a L from raw source or something other object will B be cached. =head2 Using PPI::Cache The most common way of using C is to provide parameters to the C statement at the beginning of your program. # Load the class but do not set a cache use PPI::Cache; # Use a fairly normal cache location use PPI::Cache path => '/var/cache/ppi-cache'; Any of the arguments that can be provided to the C constructor can also be provided to C. =head1 METHODS =cut use strict; use Carp (); use File::Spec (); use File::Path (); use Storable 2.17 (); use Digest::MD5 2.35 (); use Params::Util qw{_INSTANCE _SCALAR}; use PPI::Document (); our $VERSION = '1.270'; # VERSION use constant VMS => !! ( $^O eq 'VMS' ); sub import { my $class = ref $_[0] ? ref shift : shift; return 1 unless @_; # Create a cache from the params provided my $cache = $class->new(@_); # Make PPI::Document use it unless ( PPI::Document->set_cache( $cache ) ) { Carp::croak("Failed to set cache in PPI::Document"); } 1; } ##################################################################### # Constructor and Accessors =pod =head2 new param => $value, ... The C constructor creates a new standalone cache object. It takes a number of parameters to control the cache. =over =item path The C param sets the base directory for the cache. It must already exist, and must be writable. =item readonly The C param is a true/false flag that allows the use of an existing cache by a less-privileged user (such as the web user). Existing documents will be retrieved from the cache, but new documents will not be written to it. =back Returns a new C object, or dies on error. =cut sub new { my $class = shift; my %params = @_; # Path should exist and be usable my $path = $params{path} or Carp::croak("Cannot create PPI::Cache, no path provided"); unless ( -d $path ) { Carp::croak("Cannot create PPI::Cache, path does not exist"); } unless ( -r $path and -x $path ) { Carp::croak("Cannot create PPI::Cache, no read permissions for path"); } if ( ! $params{readonly} and ! -w $path ) { Carp::croak("Cannot create PPI::Cache, no write permissions for path"); } # Create the basic object my $self = bless { path => $path, readonly => !! $params{readonly}, }, $class; $self; } =pod =head2 path The C accessor returns the path on the local filesystem that is the root of the cache. =cut sub path { $_[0]->{path} } =pod =head2 readonly The C accessor returns true if documents should not be written to the cache. =cut sub readonly { $_[0]->{readonly} } ##################################################################### # PPI::Cache Methods =pod =head2 get_document $md5sum | \$source The C method checks to see if a Document is stored in the cache and retrieves it if so. =cut sub get_document { my $self = ref $_[0] ? shift : Carp::croak('PPI::Cache::get_document called as static method'); my $md5hex = $self->_md5hex(shift) or return undef; $self->_load($md5hex); } =pod =head2 store_document $Document The C method takes a L as argument and explicitly adds it to the cache. Returns true if saved, or C (or dies) on error. FIXME (make this return either one or the other, not both) =cut sub store_document { my $self = shift; my $Document = _INSTANCE(shift, 'PPI::Document') or return undef; # Shortcut if we are readonly return 1 if $self->readonly; # Find the filename to save to my $md5hex = $Document->hex_id or return undef; # Store the file $self->_store( $md5hex, $Document ); } ##################################################################### # Support Methods # Store an arbitrary PPI::Document object (using Storable) to a particular # path within the cache filesystem. sub _store { my ($self, $md5hex, $object) = @_; my ($dir, $file) = $self->_paths($md5hex); # Save the file File::Path::mkpath( $dir, 0, 0755 ) unless -d $dir; if ( VMS ) { Storable::lock_nstore( $object, $file ); } else { Storable::nstore( $object, $file ); } } # Load an arbitrary object (using Storable) from a particular # path within the cache filesystem. sub _load { my ($self, $md5hex) = @_; my (undef, $file) = $self->_paths($md5hex); # Load the file return '' unless -f $file; my $object = VMS ? Storable::retrieve( $file ) : Storable::lock_retrieve( $file ); # Security check unless ( _INSTANCE($object, 'PPI::Document') ) { Carp::croak("Security Violation: Object in '$file' is not a PPI::Document"); } $object; } # Convert a md5 to a dir and file name sub _paths { my $self = shift; my $md5hex = lc shift; my $dir = File::Spec->catdir( $self->path, substr($md5hex, 0, 1), substr($md5hex, 0, 2) ); my $file = File::Spec->catfile( $dir, $md5hex . '.ppi' ); return ($dir, $file); } # Check a md5hex param sub _md5hex { my $either = shift; my $it = _SCALAR($_[0]) ? PPI::Util::md5hex(${$_[0]}) : $_[0]; return (defined $it and ! ref $it and $it =~ /^[[:xdigit:]]{32}\z/s) ? lc $it : undef; } 1; =pod =head1 TO DO - Finish the basic functionality - Add support for use PPI::Cache auto-setting $PPI::Document::CACHE =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2005 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Lexer.pm100644000000000000 12122413511127601 15435 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Lexer; =pod =head1 NAME PPI::Lexer - The PPI Lexer =head1 SYNOPSIS use PPI; # Create a new Lexer my $Lexer = PPI::Lexer->new; # Build a PPI::Document object from a Token stream my $Tokenizer = PPI::Tokenizer->load('My/Module.pm'); my $Document = $Lexer->lex_tokenizer($Tokenizer); # Build a PPI::Document object for some raw source my $source = "print 'Hello World!'; kill(Humans->all);"; $Document = $Lexer->lex_source($source); # Build a PPI::Document object for a particular file name $Document = $Lexer->lex_file('My/Module.pm'); =head1 DESCRIPTION The is the L Lexer. In the larger scheme of things, its job is to take token streams, in a variety of forms, and "lex" them into nested structures. Pretty much everything in this module happens behind the scenes at this point. In fact, at the moment you don't really need to instantiate the lexer at all, the three main methods will auto-instantiate themselves a C object as needed. All methods do a one-shot "lex this and give me a L object". In fact, if you are reading this, what you B want to do is to just "load a document", in which case you can do this in a much more direct and concise manner with one of the following. use PPI; $Document = PPI::Document->load( $filename ); $Document = PPI::Document->new( $string ); See L for more details. For more unusual tasks, by all means forge onwards. =head1 METHODS =cut use strict; use Scalar::Util (); use Params::Util qw{_STRING _INSTANCE}; use PPI (); use PPI::Exception (); use PPI::Singletons '%_PARENT'; our $VERSION = '1.270'; # VERSION our $errstr = ""; # Keyword -> Structure class maps my %ROUND = ( # Conditions 'if' => 'PPI::Structure::Condition', 'elsif' => 'PPI::Structure::Condition', 'unless' => 'PPI::Structure::Condition', 'while' => 'PPI::Structure::Condition', 'until' => 'PPI::Structure::Condition', # For(each) 'for' => 'PPI::Structure::For', 'foreach' => 'PPI::Structure::For', ); # Opening brace to refining method my %RESOLVE = ( '(' => '_round', '[' => '_square', '{' => '_curly', ); # Allows for experimental overriding of the tokenizer our $X_TOKENIZER = "PPI::Tokenizer"; sub X_TOKENIZER { $X_TOKENIZER } ##################################################################### # Constructor =pod =head2 new The C constructor creates a new C object. The object itself is merely used to hold various buffers and state data during the lexing process, and holds no significant data between -Elex_xxxxx calls. Returns a new C object =cut sub new { my $class = shift->_clear; bless { Tokenizer => undef, # Where we store the tokenizer for a run buffer => [], # The input token buffer delayed => [], # The "delayed insignificant tokens" buffer }, $class; } ##################################################################### # Main Lexing Methods =pod =head2 lex_file $filename The C method takes a filename as argument. It then loads the file, creates a L for the content and lexes the token stream produced by the tokenizer. Basically, a sort of all-in-one method for getting a L object from a file name. Returns a L object, or C on error. =cut sub lex_file { my $self = ref $_[0] ? shift : shift->new; my $file = _STRING(shift); unless ( defined $file ) { return $self->_error("Did not pass a filename to PPI::Lexer::lex_file"); } # Create the Tokenizer my $Tokenizer = eval { X_TOKENIZER->new($file); }; if ( _INSTANCE($@, 'PPI::Exception') ) { return $self->_error( $@->message ); } elsif ( $@ ) { return $self->_error( $errstr ); } $self->lex_tokenizer( $Tokenizer ); } =pod =head2 lex_source $string The C method takes a normal scalar string as argument. It creates a L object for the string, and then lexes the resulting token stream. Returns a L object, or C on error. =cut sub lex_source { my $self = ref $_[0] ? shift : shift->new; my $source = shift; unless ( defined $source and not ref $source ) { return $self->_error("Did not pass a string to PPI::Lexer::lex_source"); } # Create the Tokenizer and hand off to the next method my $Tokenizer = eval { X_TOKENIZER->new(\$source); }; if ( _INSTANCE($@, 'PPI::Exception') ) { return $self->_error( $@->message ); } elsif ( $@ ) { return $self->_error( $errstr ); } $self->lex_tokenizer( $Tokenizer ); } =pod =head2 lex_tokenizer $Tokenizer The C takes as argument a L object. It lexes the token stream from the tokenizer into a L object. Returns a L object, or C on error. =cut sub lex_tokenizer { my $self = ref $_[0] ? shift : shift->new; my $Tokenizer = _INSTANCE(shift, 'PPI::Tokenizer'); return $self->_error( "Did not pass a PPI::Tokenizer object to PPI::Lexer::lex_tokenizer" ) unless $Tokenizer; # Create the empty document my $Document = PPI::Document->new; # Lex the token stream into the document $self->{Tokenizer} = $Tokenizer; if ( !eval { $self->_lex_document($Document); 1 } ) { # If an error occurs DESTROY the partially built document. undef $Document; if ( _INSTANCE($@, 'PPI::Exception') ) { return $self->_error( $@->message ); } else { return $self->_error( $errstr ); } } return $Document; } ##################################################################### # Lex Methods - Document Object sub _lex_document { my ($self, $Document) = @_; # my $self = shift; # my $Document = _INSTANCE(shift, 'PPI::Document') or return undef; # Start the processing loop my $Token; while ( ref($Token = $self->_get_token) ) { # Add insignificant tokens directly beneath us unless ( $Token->significant ) { $self->_add_element( $Document, $Token ); next; } if ( $Token->content eq ';' ) { # It's a semi-colon on its own. # We call this a null statement. $self->_add_element( $Document, PPI::Statement::Null->new($Token), ); next; } # Handle anything other than a structural element unless ( ref $Token eq 'PPI::Token::Structure' ) { # Determine the class for the Statement, and create it my $Statement = $self->_statement($Document, $Token)->new($Token); # Move the lexing down into the statement $self->_add_delayed( $Document ); $self->_add_element( $Document, $Statement ); $self->_lex_statement( $Statement ); next; } # Is this the opening of a structure? if ( $Token->__LEXER__opens ) { # This should actually have a Statement instead $self->_rollback( $Token ); my $Statement = PPI::Statement->new; $self->_add_element( $Document, $Statement ); $self->_lex_statement( $Statement ); next; } # Is this the close of a structure. if ( $Token->__LEXER__closes ) { # Because we are at the top of the tree, this is an error. # This means either a mis-parsing, or a mistake in the code. # To handle this, we create a "Naked Close" statement $self->_add_element( $Document, PPI::Statement::UnmatchedBrace->new($Token) ); next; } # Shouldn't be able to get here PPI::Exception->throw('Lexer reached an illegal state'); } # Did we leave the main loop because of a Tokenizer error? unless ( defined $Token ) { my $errstr = $self->{Tokenizer} ? $self->{Tokenizer}->errstr : ''; $errstr ||= 'Unknown Tokenizer Error'; PPI::Exception->throw($errstr); } # No error, it's just the end of file. # Add any insignificant trailing tokens. $self->_add_delayed( $Document ); # If the Tokenizer has any v6 blocks to attach, do so now. # Checking once at the end is faster than adding a special # case check for every statement parsed. my $perl6 = $self->{Tokenizer}->{'perl6'}; if ( @$perl6 ) { my $includes = $Document->find( 'PPI::Statement::Include::Perl6' ); foreach my $include ( @$includes ) { unless ( @$perl6 ) { PPI::Exception->throw('Failed to find a perl6 section'); } $include->{perl6} = shift @$perl6; } } return 1; } ##################################################################### # Lex Methods - Statement Object # Keyword -> Statement Subclass my %STATEMENT_CLASSES = ( # Things that affect the timing of execution 'BEGIN' => 'PPI::Statement::Scheduled', 'CHECK' => 'PPI::Statement::Scheduled', 'UNITCHECK' => 'PPI::Statement::Scheduled', 'INIT' => 'PPI::Statement::Scheduled', 'END' => 'PPI::Statement::Scheduled', # Special subroutines for which 'sub' is optional 'AUTOLOAD' => 'PPI::Statement::Sub', 'DESTROY' => 'PPI::Statement::Sub', # Loading and context statement 'package' => 'PPI::Statement::Package', # 'use' => 'PPI::Statement::Include', 'no' => 'PPI::Statement::Include', 'require' => 'PPI::Statement::Include', # Various declarations 'my' => 'PPI::Statement::Variable', 'local' => 'PPI::Statement::Variable', 'our' => 'PPI::Statement::Variable', 'state' => 'PPI::Statement::Variable', # Statements starting with 'sub' could be any one of... # 'sub' => 'PPI::Statement::Sub', # 'sub' => 'PPI::Statement::Scheduled', # 'sub' => 'PPI::Statement', # Compound statement 'if' => 'PPI::Statement::Compound', 'unless' => 'PPI::Statement::Compound', 'for' => 'PPI::Statement::Compound', 'foreach' => 'PPI::Statement::Compound', 'while' => 'PPI::Statement::Compound', 'until' => 'PPI::Statement::Compound', # Switch statement 'given' => 'PPI::Statement::Given', 'when' => 'PPI::Statement::When', 'default' => 'PPI::Statement::When', # Various ways of breaking out of scope 'redo' => 'PPI::Statement::Break', 'next' => 'PPI::Statement::Break', 'last' => 'PPI::Statement::Break', 'return' => 'PPI::Statement::Break', 'goto' => 'PPI::Statement::Break', # Special sections of the file '__DATA__' => 'PPI::Statement::Data', '__END__' => 'PPI::Statement::End', ); sub _statement { my ($self, $Parent, $Token) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # my $Token = _INSTANCE(shift, 'PPI::Token') or die "Bad param 2"; # Check for things like ( parent => ... ) if ( $Parent->isa('PPI::Structure::List') or $Parent->isa('PPI::Structure::Constructor') ) { if ( $Token->isa('PPI::Token::Word') ) { # Is the next significant token a => # Read ahead to the next significant token my $Next; while ( $Next = $self->_get_token ) { unless ( $Next->significant ) { push @{$self->{delayed}}, $Next; # $self->_delay_element( $Next ); next; } # Got the next token if ( $Next->isa('PPI::Token::Operator') and $Next->content eq '=>' ) { # Is an ordinary expression $self->_rollback( $Next ); return 'PPI::Statement::Expression'; } else { last; } } # Rollback and continue $self->_rollback( $Next ); } } my $is_lexsub = 0; # Is it a token in our known classes list my $class = $STATEMENT_CLASSES{$Token->content}; if ( $class ) { # Is the next significant token a => # Read ahead to the next significant token my $Next; while ( $Next = $self->_get_token ) { if ( !$Next->significant ) { push @{$self->{delayed}}, $Next; next; } # Lexical subroutine if ( $Token->content =~ /^(?:my|our|state)$/ and $Next->isa( 'PPI::Token::Word' ) and $Next->content eq 'sub' ) { # This should be PPI::Statement::Sub rather than PPI::Statement::Variable $class = undef; $is_lexsub = 1; last; } last if !$Next->isa( 'PPI::Token::Operator' ) or $Next->content ne '=>'; # Got the next token # Is an ordinary expression $self->_rollback( $Next ); return 'PPI::Statement'; } # Rollback and continue $self->_rollback( $Next ); } # Handle potential barewords for subscripts if ( $Parent->isa('PPI::Structure::Subscript') ) { # Fast obvious case, just an expression unless ( $class and $class->isa('PPI::Statement::Expression') ) { return 'PPI::Statement::Expression'; } # This is something like "my" or "our" etc... more subtle. # Check if the next token is a closing curly brace. # This means we are something like $h{my} my $Next; while ( $Next = $self->_get_token ) { unless ( $Next->significant ) { push @{$self->{delayed}}, $Next; # $self->_delay_element( $Next ); next; } # Found the next significant token. # Is it a closing curly brace? if ( $Next->content eq '}' ) { $self->_rollback( $Next ); return 'PPI::Statement::Expression'; } else { $self->_rollback( $Next ); return $class; } } # End of file... this means it is something like $h{our # which is probably going to be $h{our} ... I think $self->_rollback( $Next ); return 'PPI::Statement::Expression'; } # If it's a token in our list, use that class return $class if $class; # Handle the more in-depth sub detection if ( $is_lexsub || $Token->content eq 'sub' ) { # Read ahead to the next significant token my $Next; while ( $Next = $self->_get_token ) { unless ( $Next->significant ) { push @{$self->{delayed}}, $Next; # $self->_delay_element( $Next ); next; } # Got the next significant token my $sclass = $STATEMENT_CLASSES{$Next->content}; if ( $sclass and $sclass eq 'PPI::Statement::Scheduled' ) { $self->_rollback( $Next ); return 'PPI::Statement::Scheduled'; } if ( $Next->isa('PPI::Token::Word') ) { $self->_rollback( $Next ); return 'PPI::Statement::Sub'; } ### Comment out these two, as they would return PPI::Statement anyway # if ( $content eq '{' ) { # Anonymous sub at start of statement # return 'PPI::Statement'; # } # # if ( $Next->isa('PPI::Token::Prototype') ) { # Anonymous sub at start of statement # return 'PPI::Statement'; # } # PPI::Statement is the safest fall-through $self->_rollback( $Next ); return 'PPI::Statement'; } # End of file... PPI::Statement::Sub is the most likely $self->_rollback( $Next ); return 'PPI::Statement::Sub'; } if ( $Token->content eq 'use' ) { # Add a special case for "use v6" lines. my $Next; while ( $Next = $self->_get_token ) { unless ( $Next->significant ) { push @{$self->{delayed}}, $Next; # $self->_delay_element( $Next ); next; } # Found the next significant token. if ( $Next->isa('PPI::Token::Operator') and $Next->content eq '=>' ) { # Is an ordinary expression $self->_rollback( $Next ); return 'PPI::Statement'; # Is it a v6 use? } elsif ( $Next->content eq 'v6' ) { $self->_rollback( $Next ); return 'PPI::Statement::Include::Perl6'; } else { $self->_rollback( $Next ); return 'PPI::Statement::Include'; } } # End of file... this means it is an incomplete use # line, just treat it as a normal include. $self->_rollback( $Next ); return 'PPI::Statement::Include'; } # If our parent is a Condition, we are an Expression if ( $Parent->isa('PPI::Structure::Condition') ) { return 'PPI::Statement::Expression'; } # If our parent is a List, we are also an expression if ( $Parent->isa('PPI::Structure::List') ) { return 'PPI::Statement::Expression'; } # Switch statements use expressions, as well. if ( $Parent->isa('PPI::Structure::Given') or $Parent->isa('PPI::Structure::When') ) { return 'PPI::Statement::Expression'; } if ( _INSTANCE($Token, 'PPI::Token::Label') ) { return 'PPI::Statement::Compound'; } # Beyond that, I have no idea for the moment. # Just keep adding more conditions above this. return 'PPI::Statement'; } sub _lex_statement { my ($self, $Statement) = @_; # my $self = shift; # my $Statement = _INSTANCE(shift, 'PPI::Statement') or die "Bad param 1"; # Handle some special statements if ( $Statement->isa('PPI::Statement::End') ) { return $self->_lex_end( $Statement ); } # Begin processing tokens my $Token; while ( ref( $Token = $self->_get_token ) ) { # Delay whitespace and comment tokens unless ( $Token->significant ) { push @{$self->{delayed}}, $Token; # $self->_delay_element( $Token ); next; } # Structual closes, and __DATA__ and __END__ tags implicitly # end every type of statement if ( $Token->__LEXER__closes or $Token->isa('PPI::Token::Separator') ) { # Rollback and end the statement return $self->_rollback( $Token ); } # Normal statements never implicitly end unless ( $Statement->__LEXER__normal ) { # Have we hit an implicit end to the statement unless ( $self->_continues( $Statement, $Token ) ) { # Rollback and finish the statement return $self->_rollback( $Token ); } } # Any normal character just gets added unless ( $Token->isa('PPI::Token::Structure') ) { $self->_add_element( $Statement, $Token ); next; } # Handle normal statement terminators if ( $Token->content eq ';' ) { $self->_add_element( $Statement, $Token ); return 1; } # Which leaves us with a new structure # Determine the class for the structure and create it my $method = $RESOLVE{$Token->content}; my $Structure = $self->$method($Statement)->new($Token); # Move the lexing down into the Structure $self->_add_delayed( $Statement ); $self->_add_element( $Statement, $Structure ); $self->_lex_structure( $Structure ); } # Was it an error in the tokenizer? unless ( defined $Token ) { PPI::Exception->throw; } # No, it's just the end of the file... # Roll back any insignificant tokens, they'll get added at the Document level $self->_rollback; } sub _lex_end { my ($self, $Statement) = @_; # my $self = shift; # my $Statement = _INSTANCE(shift, 'PPI::Statement::End') or die "Bad param 1"; # End of the file, EVERYTHING is ours my $Token; while ( $Token = $self->_get_token ) { # Inlined $Statement->__add_element($Token); Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $Token} = $Statement ); push @{$Statement->{children}}, $Token; } # Was it an error in the tokenizer? unless ( defined $Token ) { PPI::Exception->throw; } # No, it's just the end of the file... # Roll back any insignificant tokens, they get added at the Document level $self->_rollback; } # For many statements, it can be difficult to determine the end-point. # This method takes a statement and the next significant token, and attempts # to determine if the there is a statement boundary between the two, or if # the statement can continue with the token. sub _continues { my ($self, $Statement, $Token) = @_; # my $self = shift; # my $Statement = _INSTANCE(shift, 'PPI::Statement') or die "Bad param 1"; # my $Token = _INSTANCE(shift, 'PPI::Token') or die "Bad param 2"; # Handle the simple block case # { print 1; } if ( $Statement->schildren == 1 and $Statement->schild(0)->isa('PPI::Structure::Block') ) { return ''; } # Alrighty then, there are six implied-end statement types: # ::Scheduled blocks, ::Sub declarations, ::Compound, ::Given, ::When, # and ::Package statements. return 1 if ref $Statement !~ /\b(?:Scheduled|Sub|Compound|Given|When|Package)$/; # Of these six, ::Scheduled, ::Sub, ::Given, and ::When follow the same # simple rule and can be handled first. The block form of ::Package # follows the rule, too. (The non-block form of ::Package # requires a statement terminator, and thus doesn't need to have # an implied end detected.) my @part = $Statement->schildren; my $LastChild = $part[-1]; # If the last significant element of the statement is a block, # then an implied-end statement is done, no questions asked. return !$LastChild->isa('PPI::Structure::Block') if !$Statement->isa('PPI::Statement::Compound'); # Now we get to compound statements, which kind of suck (to lex). # However, of them all, the 'if' type, which includes unless, are # relatively easy to handle compared to the others. my $type = $Statement->type; if ( $type eq 'if' ) { # This should be one of the following # if (EXPR) BLOCK # if (EXPR) BLOCK else BLOCK # if (EXPR) BLOCK elsif (EXPR) BLOCK ... else BLOCK # We only implicitly end on a block unless ( $LastChild->isa('PPI::Structure::Block') ) { # if (EXPR) ... # if (EXPR) BLOCK else ... # if (EXPR) BLOCK elsif (EXPR) BLOCK ... return 1; } # If the token before the block is an 'else', # it's over, no matter what. my $NextLast = $Statement->schild(-2); if ( $NextLast and $NextLast->isa('PPI::Token') and $NextLast->isa('PPI::Token::Word') and $NextLast->content eq 'else' ) { return ''; } # Otherwise, we continue for 'elsif' or 'else' only. if ( $Token->isa('PPI::Token::Word') and ( $Token->content eq 'else' or $Token->content eq 'elsif' ) ) { return 1; } return ''; } if ( $type eq 'label' ) { # We only have the label so far, could be any of # LABEL while (EXPR) BLOCK # LABEL while (EXPR) BLOCK continue BLOCK # LABEL for (EXPR; EXPR; EXPR) BLOCK # LABEL foreach VAR (LIST) BLOCK # LABEL foreach VAR (LIST) BLOCK continue BLOCK # LABEL BLOCK continue BLOCK # Handle cases with a word after the label if ( $Token->isa('PPI::Token::Word') and $Token->content =~ /^(?:while|until|for|foreach)$/ ) { return 1; } # Handle labelled blocks if ( $Token->isa('PPI::Token::Structure') && $Token->content eq '{' ) { return 1; } return ''; } # Handle the common "after round braces" case if ( $LastChild->isa('PPI::Structure') and $LastChild->braces eq '()' ) { # LABEL while (EXPR) ... # LABEL while (EXPR) ... # LABEL for (EXPR; EXPR; EXPR) ... # LABEL for VAR (LIST) ... # LABEL foreach VAR (LIST) ... # Only a block will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '{'; } if ( $type eq 'for' ) { # LABEL for (EXPR; EXPR; EXPR) BLOCK if ( $LastChild->isa('PPI::Token::Word') and $LastChild->content =~ /^for(?:each)?\z/ ) { # LABEL for ... if ( ( $Token->isa('PPI::Token::Structure') and $Token->content eq '(' ) or $Token->isa('PPI::Token::QuoteLike::Words') ) { return 1; } if ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) { # LABEL for VAR QW{} ... # LABEL foreach VAR QW{} ... # Only a block will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '{'; } # In this case, we can also behave like a foreach $type = 'foreach'; } elsif ( $LastChild->isa('PPI::Structure::Block') ) { # LABEL for (EXPR; EXPR; EXPR) BLOCK # That's it, nothing can continue return ''; } elsif ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) { # LABEL for VAR QW{} ... # LABEL foreach VAR QW{} ... # Only a block will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '{'; } } # Handle the common continue case if ( $LastChild->isa('PPI::Token::Word') and $LastChild->content eq 'continue' ) { # LABEL while (EXPR) BLOCK continue ... # LABEL foreach VAR (LIST) BLOCK continue ... # LABEL BLOCK continue ... # Only a block will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '{'; } # Handle the common continuable block case if ( $LastChild->isa('PPI::Structure::Block') ) { # LABEL while (EXPR) BLOCK # LABEL while (EXPR) BLOCK ... # LABEL for (EXPR; EXPR; EXPR) BLOCK # LABEL foreach VAR (LIST) BLOCK # LABEL foreach VAR (LIST) BLOCK ... # LABEL BLOCK ... # Is this the block for a continue? if ( _INSTANCE($part[-2], 'PPI::Token::Word') and $part[-2]->content eq 'continue' ) { # LABEL while (EXPR) BLOCK continue BLOCK # LABEL foreach VAR (LIST) BLOCK continue BLOCK # LABEL BLOCK continue BLOCK # That's it, nothing can continue this return ''; } # Only a continue will do return $Token->isa('PPI::Token::Word') && $Token->content eq 'continue'; } if ( $type eq 'block' ) { # LABEL BLOCK continue BLOCK # Every possible case is covered in the common cases above } if ( $type eq 'while' ) { # LABEL while (EXPR) BLOCK # LABEL while (EXPR) BLOCK continue BLOCK # LABEL until (EXPR) BLOCK # LABEL until (EXPR) BLOCK continue BLOCK # The only case not covered is the while ... if ( $LastChild->isa('PPI::Token::Word') and ( $LastChild->content eq 'while' or $LastChild->content eq 'until' ) ) { # LABEL while ... # LABEL until ... # Only a condition structure will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '('; } } if ( $type eq 'foreach' ) { # LABEL foreach VAR (LIST) BLOCK # LABEL foreach VAR (LIST) BLOCK continue BLOCK # The only two cases that have not been covered already are # 'foreach ...' and 'foreach VAR ...' if ( $LastChild->isa('PPI::Token::Symbol') ) { # LABEL foreach my $scalar ... # Open round brace, or a quotewords return 1 if $Token->isa('PPI::Token::Structure') && $Token->content eq '('; return 1 if $Token->isa('PPI::Token::QuoteLike::Words'); return ''; } if ( $LastChild->content eq 'foreach' or $LastChild->content eq 'for' ) { # There are three possibilities here if ( $Token->isa('PPI::Token::Word') and ( ($STATEMENT_CLASSES{ $Token->content } || '') eq 'PPI::Statement::Variable' ) ) { # VAR == 'my ...' return 1; } elsif ( $Token->content =~ /^\$/ ) { # VAR == '$scalar' return 1; } elsif ( $Token->isa('PPI::Token::Structure') and $Token->content eq '(' ) { return 1; } elsif ( $Token->isa('PPI::Token::QuoteLike::Words') ) { return 1; } else { return ''; } } if ( ($STATEMENT_CLASSES{ $LastChild->content } || '') eq 'PPI::Statement::Variable' ) { # LABEL foreach my ... # Only a scalar will do return $Token->content =~ /^\$/; } # Handle the rare for my $foo qw{bar} ... case if ( $LastChild->isa('PPI::Token::QuoteLike::Words') ) { # LABEL for VAR QW ... # LABEL foreach VAR QW ... # Only a block will do return $Token->isa('PPI::Token::Structure') && $Token->content eq '{'; } } # Something we don't know about... what could it be PPI::Exception->throw("Illegal state in '$type' compound statement"); } ##################################################################### # Lex Methods - Structure Object # Given a parent element, and a ( token to open a structure, determine # the class that the structure should be. sub _round { my ($self, $Parent) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # Get the last significant element in the parent my $Element = $Parent->schild(-1); if ( _INSTANCE($Element, 'PPI::Token::Word') ) { # Can it be determined because it is a keyword? my $rclass = $ROUND{$Element->content}; return $rclass if $rclass; } # If we are part of a for or foreach statement, we are a ForLoop if ( $Parent->isa('PPI::Statement::Compound') ) { if ( $Parent->type =~ /^for(?:each)?$/ ) { return 'PPI::Structure::For'; } } elsif ( $Parent->isa('PPI::Statement::Given') ) { return 'PPI::Structure::Given'; } elsif ( $Parent->isa('PPI::Statement::When') ) { return 'PPI::Structure::When'; } # Otherwise, it must be a list # If the previous element is -> then we mark it as a dereference if ( _INSTANCE($Element, 'PPI::Token::Operator') and $Element->content eq '->' ) { $Element->{_dereference} = 1; } 'PPI::Structure::List' } # Given a parent element, and a [ token to open a structure, determine # the class that the structure should be. sub _square { my ($self, $Parent) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # Get the last significant element in the parent my $Element = $Parent->schild(-1); # Is this a subscript, like $foo[1] or $foo{expr} if ( $Element ) { if ( $Element->isa('PPI::Token::Operator') and $Element->content eq '->' ) { # $foo->[] $Element->{_dereference} = 1; return 'PPI::Structure::Subscript'; } if ( $Element->isa('PPI::Structure::Subscript') ) { # $foo{}[] return 'PPI::Structure::Subscript'; } if ( $Element->isa('PPI::Token::Symbol') and $Element->content =~ /^(?:\$|\@)/ ) { # $foo[], @foo[] return 'PPI::Structure::Subscript'; } if ( $Element->isa('PPI::Token::Cast') and $Element->content =~ /^(?:\@|\%)/ ) { my $prior = $Parent->schild(-2); if ( $prior and $prior->isa('PPI::Token::Operator') and $prior->content eq '->' ) { # Postfix dereference: ->@[...] ->%[...] return 'PPI::Structure::Subscript'; } } # FIXME - More cases to catch } # Otherwise, we assume that it's an anonymous arrayref constructor 'PPI::Structure::Constructor'; } # Keyword -> Structure class maps my %CURLY_CLASSES = ( # Blocks 'sub' => 'PPI::Structure::Block', 'grep' => 'PPI::Structure::Block', 'map' => 'PPI::Structure::Block', 'sort' => 'PPI::Structure::Block', 'do' => 'PPI::Structure::Block', # rely on 'continue' + block being handled elsewhere # rely on 'eval' + block being handled elsewhere # Hash constructors 'scalar' => 'PPI::Structure::Constructor', '=' => 'PPI::Structure::Constructor', '||=' => 'PPI::Structure::Constructor', '&&=' => 'PPI::Structure::Constructor', '//=' => 'PPI::Structure::Constructor', '||' => 'PPI::Structure::Constructor', '&&' => 'PPI::Structure::Constructor', '//' => 'PPI::Structure::Constructor', '?' => 'PPI::Structure::Constructor', ':' => 'PPI::Structure::Constructor', ',' => 'PPI::Structure::Constructor', '=>' => 'PPI::Structure::Constructor', '+' => 'PPI::Structure::Constructor', # per perlref 'return' => 'PPI::Structure::Constructor', # per perlref 'bless' => 'PPI::Structure::Constructor', # pragmatic -- # perlfunc says first arg is a reference, and # bless {; ... } fails to compile. ); my @CURLY_LOOKAHEAD_CLASSES = ( {}, # not used { ';' => 'PPI::Structure::Block', # per perlref '}' => 'PPI::Structure::Constructor', }, { '=>' => 'PPI::Structure::Constructor', }, ); # Given a parent element, and a { token to open a structure, determine # the class that the structure should be. sub _curly { my ($self, $Parent) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # Get the last significant element in the parent my $Element = $Parent->schild(-1); my $content = $Element ? $Element->content : ''; # Is this a subscript, like $foo[1] or $foo{expr} if ( $Element ) { if ( $content eq '->' and $Element->isa('PPI::Token::Operator') ) { # $foo->{} $Element->{_dereference} = 1; return 'PPI::Structure::Subscript'; } if ( $Element->isa('PPI::Structure::Subscript') ) { # $foo[]{} return 'PPI::Structure::Subscript'; } if ( $content =~ /^(?:\$|\@)/ and $Element->isa('PPI::Token::Symbol') ) { # $foo{}, @foo{} return 'PPI::Structure::Subscript'; } if ( $Element->isa('PPI::Token::Cast') and $Element->content =~ /^(?:\@|\%|\*)/ ) { my $prior = $Parent->schild(-2); if ( $prior and $prior->isa('PPI::Token::Operator') and $prior->content eq '->' ) { # Postfix dereference: ->@{...} ->%{...} ->*{...} return 'PPI::Structure::Subscript'; } } if ( $Element->isa('PPI::Structure::Block') ) { # deference - ${$hash_ref}{foo} # or even ${burfle}{foo} # hash slice - @{$hash_ref}{'foo', 'bar'} if ( my $prior = $Parent->schild(-2) ) { my $prior_content = $prior->content(); $prior->isa( 'PPI::Token::Cast' ) and ( $prior_content eq '@' || $prior_content eq '$' ) and return 'PPI::Structure::Subscript'; } } # Are we the last argument of sub? # E.g.: 'sub foo {}', 'sub foo ($) {}' return 'PPI::Structure::Block' if $Parent->isa('PPI::Statement::Sub'); # Are we the second or third argument of package? # E.g.: 'package Foo {}' or 'package Foo v1.2.3 {}' return 'PPI::Structure::Block' if $Parent->isa('PPI::Statement::Package'); if ( $CURLY_CLASSES{$content} ) { # Known type return $CURLY_CLASSES{$content}; } } # Are we in a compound statement if ( $Parent->isa('PPI::Statement::Compound') ) { # We will only encounter blocks in compound statements return 'PPI::Structure::Block'; } # Are we the second or third argument of use if ( $Parent->isa('PPI::Statement::Include') ) { if ( $Parent->schildren == 2 || $Parent->schildren == 3 && $Parent->schild(2)->isa('PPI::Token::Number') ) { # This is something like use constant { ... }; return 'PPI::Structure::Constructor'; } } # Unless we are at the start of the statement, everything else should be a block ### FIXME This is possibly a bad choice, but will have to do for now. return 'PPI::Structure::Block' if $Element; if ( $Parent->isa('PPI::Statement') and _INSTANCE($Parent->parent, 'PPI::Structure::List') ) { my $function = $Parent->parent->parent->schild(-2); # Special case: Are we the param of a core function # i.e. map({ $_ => 1 } @foo) return 'PPI::Structure::Block' if $function and $function->content =~ /^(?:map|grep|sort|eval|do)$/; # If not part of a block print, list-embedded curlies are most likely constructors return 'PPI::Structure::Constructor' if not $function or $function->content !~ /^(?:print|say)$/; } # We need to scan ahead. my $Next; my $position = 0; my @delayed; while ( $Next = $self->_get_token ) { unless ( $Next->significant ) { push @delayed, $Next; next; } # If we are off the end of the lookahead array, if ( ++$position >= @CURLY_LOOKAHEAD_CLASSES ) { # default to block. $self->_buffer( splice(@delayed), $Next ); last; # If the content at this position is known } elsif ( my $class = $CURLY_LOOKAHEAD_CLASSES[$position] {$Next->content} ) { # return the associated class. $self->_buffer( splice(@delayed), $Next ); return $class; } # Delay and continue push @delayed, $Next; } # Hit the end of the document, or bailed out, go with block $self->_buffer( splice(@delayed) ); if ( ref $Parent eq 'PPI::Statement' ) { bless $Parent, 'PPI::Statement::Compound'; } return 'PPI::Structure::Block'; } sub _lex_structure { my ($self, $Structure) = @_; # my $self = shift; # my $Structure = _INSTANCE(shift, 'PPI::Structure') or die "Bad param 1"; # Start the processing loop my $Token; while ( ref($Token = $self->_get_token) ) { # Is this a direct type token unless ( $Token->significant ) { push @{$self->{delayed}}, $Token; # $self->_delay_element( $Token ); next; } # Anything other than a Structure starts a Statement unless ( $Token->isa('PPI::Token::Structure') ) { # Because _statement may well delay and rollback itself, # we need to add the delayed tokens early $self->_add_delayed( $Structure ); # Determine the class for the Statement and create it my $Statement = $self->_statement($Structure, $Token)->new($Token); # Move the lexing down into the Statement $self->_add_element( $Structure, $Statement ); $self->_lex_statement( $Statement ); next; } # Is this the opening of another structure directly inside us? if ( $Token->__LEXER__opens ) { # Rollback the Token, and recurse into the statement $self->_rollback( $Token ); my $Statement = PPI::Statement->new; $self->_add_element( $Structure, $Statement ); $self->_lex_statement( $Statement ); next; } # Is this the close of a structure ( which would be an error ) if ( $Token->__LEXER__closes ) { # Is this OUR closing structure if ( $Token->content eq $Structure->start->__LEXER__opposite ) { # Add any delayed tokens, and the finishing token (the ugly way) $self->_add_delayed( $Structure ); $Structure->{finish} = $Token; Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $Token} = $Structure ); # Confirm that ForLoop structures are actually so, and # aren't really a list. if ( $Structure->isa('PPI::Structure::For') ) { if ( 2 > scalar grep { $_->isa('PPI::Statement') } $Structure->children ) { bless($Structure, 'PPI::Structure::List'); } } return 1; } # Unmatched closing brace. # Either they typed the wrong thing, or haven't put # one at all. Either way it's an error we need to # somehow handle gracefully. For now, we'll treat it # as implicitly ending the structure. This causes the # least damage across the various reasons why this # might have happened. return $self->_rollback( $Token ); } # It's a semi-colon on its own, just inside the block. # This is a null statement. $self->_add_element( $Structure, PPI::Statement::Null->new($Token), ); } # Is this an error unless ( defined $Token ) { PPI::Exception->throw; } # No, it's just the end of file. # Add any insignificant trailing tokens. $self->_add_delayed( $Structure ); } ##################################################################### # Support Methods # Get the next token for processing, handling buffering sub _get_token { shift(@{$_[0]->{buffer}}) or $_[0]->{Tokenizer}->get_token; } # Old long version of the above # my $self = shift; # # First from the buffer # if ( @{$self->{buffer}} ) { # return shift @{$self->{buffer}}; # } # # # Then from the Tokenizer # $self->{Tokenizer}->get_token; # } # Delay the addition of insignificant elements. # This ended up being inlined. # sub _delay_element { # my $self = shift; # my $Element = _INSTANCE(shift, 'PPI::Element') or die "Bad param 1"; # push @{ $_[0]->{delayed} }, $_[1]; # } # Add an Element to a Node, including any delayed Elements sub _add_element { my ($self, $Parent, $Element) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # my $Element = _INSTANCE(shift, 'PPI::Element') or die "Bad param 2"; # Handle a special case, where a statement is not fully resolved if ( ref $Parent eq 'PPI::Statement' and my $first = $Parent->schild(0) ) { if ( $first->isa('PPI::Token::Label') and !(my $second = $Parent->schild(1)) ) { my $new_class = $STATEMENT_CLASSES{$second->content}; # It's a labelled statement bless $Parent, $new_class if $new_class; } } # Add first the delayed, from the front, then the passed element foreach my $el ( @{$self->{delayed}} ) { Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $el} = $Parent ); # Inlined $Parent->__add_element($el); } Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $Element} = $Parent ); push @{$Parent->{children}}, @{$self->{delayed}}, $Element; # Clear the delayed elements $self->{delayed} = []; } # Specifically just add any delayed tokens, if any. sub _add_delayed { my ($self, $Parent) = @_; # my $self = shift; # my $Parent = _INSTANCE(shift, 'PPI::Node') or die "Bad param 1"; # Add any delayed foreach my $el ( @{$self->{delayed}} ) { Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $el} = $Parent ); # Inlined $Parent->__add_element($el); } push @{$Parent->{children}}, @{$self->{delayed}}; # Clear the delayed elements $self->{delayed} = []; } # Rollback the delayed tokens, plus any passed. Once all the tokens # have been moved back on to the buffer, the order should be. # <--- @{$self->{delayed}}, @_, @{$self->{buffer}} <---- sub _rollback { my $self = shift; # First, put any passed objects back if ( @_ ) { unshift @{$self->{buffer}}, splice @_; } # Then, put back anything delayed if ( @{$self->{delayed}} ) { unshift @{$self->{buffer}}, splice @{$self->{delayed}}; } 1; } # Partial rollback, just return a single list to the buffer sub _buffer { my $self = shift; # Put any passed objects back if ( @_ ) { unshift @{$self->{buffer}}, splice @_; } 1; } ##################################################################### # Error Handling # Set the error message sub _error { $errstr = $_[1]; undef; } # Clear the error message. # Returns the object as a convenience. sub _clear { $errstr = ''; $_[0]; } =pod =head2 errstr For any error that occurs, you can use the C, as either a static or object method, to access the error message. If no error occurs for any particular action, C will return false. =cut sub errstr { $errstr; } ##################################################################### # PDOM Extensions # # This is something of a future expansion... ignore it for now :) # # use PPI::Statement::Sub (); # # sub PPI::Statement::Sub::__LEXER__normal { '' } 1; =pod =head1 TO DO - Add optional support for some of the more common source filters - Some additional checks for blessing things into various Statement and Structure subclasses. =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Token.pm100644000000000000 1323113511127601 15414 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Token; =pod =head1 NAME PPI::Token - A single token of Perl source code =head1 INHERITANCE PPI::Token isa PPI::Element =head1 DESCRIPTION C is the abstract base class for all Tokens. In PPI terms, a "Token" is a L that directly represents bytes of source code. =head1 METHODS =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Element (); use PPI::Exception (); our $VERSION = '1.270'; # VERSION our @ISA = 'PPI::Element'; # We don't load the abstracts, they are loaded # as part of the inheritance process. # Load the token classes use PPI::Token::BOM (); use PPI::Token::Whitespace (); use PPI::Token::Comment (); use PPI::Token::Pod (); use PPI::Token::Number (); use PPI::Token::Number::Binary (); use PPI::Token::Number::Octal (); use PPI::Token::Number::Hex (); use PPI::Token::Number::Float (); use PPI::Token::Number::Exp (); use PPI::Token::Number::Version (); use PPI::Token::Word (); use PPI::Token::DashedWord (); use PPI::Token::Symbol (); use PPI::Token::ArrayIndex (); use PPI::Token::Magic (); use PPI::Token::Quote::Single (); use PPI::Token::Quote::Double (); use PPI::Token::Quote::Literal (); use PPI::Token::Quote::Interpolate (); use PPI::Token::QuoteLike::Backtick (); use PPI::Token::QuoteLike::Command (); use PPI::Token::QuoteLike::Regexp (); use PPI::Token::QuoteLike::Words (); use PPI::Token::QuoteLike::Readline (); use PPI::Token::Regexp::Match (); use PPI::Token::Regexp::Substitute (); use PPI::Token::Regexp::Transliterate (); use PPI::Token::Operator (); use PPI::Token::Cast (); use PPI::Token::Structure (); use PPI::Token::Label (); use PPI::Token::HereDoc (); use PPI::Token::Separator (); use PPI::Token::Data (); use PPI::Token::End (); use PPI::Token::Prototype (); use PPI::Token::Attribute (); use PPI::Token::Unknown (); ##################################################################### # Constructor and Related sub new { bless { content => (defined $_[1] ? "$_[1]" : '') }, $_[0]; } sub set_class { my $self = shift; # @_ or throw Exception("No arguments to set_class"); my $class = substr( $_[0], 0, 12 ) eq 'PPI::Token::' ? shift : 'PPI::Token::' . shift; # Find out if the current and new classes are complex my $old_quote = (ref($self) =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; my $new_quote = ($class =~ /\b(?:Quote|Regex)\b/o) ? 1 : 0; # No matter what happens, we will have to rebless bless $self, $class; # If we are changing to or from a Quote style token, we # can't just rebless and need to do some extra thing # Otherwise, we have done enough return $class if ($old_quote - $new_quote) == 0; # Make a new token from the old content, and overwrite the current # token's attributes with the new token's attributes. my $token = $class->new( $self->{content} ); %$self = %$token; # Return the class as a convenience return $class; } ##################################################################### # PPI::Token Methods =pod =head2 set_content $string The C method allows you to set/change the string that the C object represents. Returns the string you set the Token to =cut sub set_content { $_[0]->{content} = $_[1]; } =pod =head2 add_content $string The C method allows you to add additional bytes of code to the end of the Token. Returns the new full string after the bytes have been added. =cut sub add_content { $_[0]->{content} .= $_[1] } =pod =head2 length The C method returns the length of the string in a Token. =cut sub length { CORE::length($_[0]->{content}) } ##################################################################### # Overloaded PPI::Element methods sub content { $_[0]->{content}; } # You can insert either a statement, or a non-significant token. sub insert_before { my $self = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; if ( $Element->isa('PPI::Structure') ) { return $self->__insert_before($Element); } elsif ( $Element->isa('PPI::Token') ) { return $self->__insert_before($Element); } ''; } # As above, you can insert a statement, or a non-significant token sub insert_after { my $self = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; if ( $Element->isa('PPI::Structure') ) { return $self->__insert_after($Element); } elsif ( $Element->isa('PPI::Token') ) { return $self->__insert_after($Element); } ''; } ##################################################################### # Tokenizer Methods sub __TOKENIZER__on_line_start() { 1 } sub __TOKENIZER__on_line_end() { 1 } sub __TOKENIZER__on_char() { 'Unknown' } ##################################################################### # Lexer Methods sub __LEXER__opens { ref($_[0]) eq 'PPI::Token::Structure' and $_[0]->{content} =~ /(?:\(|\[|\{)/ } sub __LEXER__closes { ref($_[0]) eq 'PPI::Token::Structure' and $_[0]->{content} =~ /(?:\)|\]|\})/ } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut 10_statement.t100644000000000000 135513511127601 15520 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Test the various PPI::Statement packages use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 5 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; ##################################################################### # Basic subroutine test SCOPE: { my $doc = PPI::Document->new( \"sub foo { 1 }" ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0), 'PPI::Statement::Sub' ); } ##################################################################### # Regression test, make sure utf8 is a pragma SCOPE: { my $doc = PPI::Document->new( \"use utf8;" ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0), 'PPI::Statement::Include' ); is( $doc->child(0)->pragma, 'utf8', 'use utf8 is a pragma' ); } 15_transform.t100644000000000000 675313511127601 15543 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl use lib 't/lib'; use PPI::Test::pragmas; use Test::More 0.86 tests => 24 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use File::Spec::Functions ':ALL'; use File::Temp 'tempdir'; use PPI; use PPI::Transform; use Scalar::Util 'refaddr'; use File::Copy; ##################################################################### # Begin Tests APPLY: { my $code = 'my $foo = "bar";'; my $rv = MyCleaner->apply( \$code ); ok( $rv, 'MyCleaner->apply( \$code ) returns true' ); is( $code, 'my$foo="bar";', 'MyCleaner->apply( \$code ) modifies code as expected' ); ok( PPI::Transform->register_apply_handler( 'Foo', \&Foo::get, \&Foo::set ), "register_apply_handler worked", ); $Foo::VALUE = 'my $foo = "bar";'; my $Foo = Foo->new; isa_ok( $Foo, 'Foo' ); ok( MyCleaner->apply( $Foo ), 'MyCleaner->apply( $Foo ) returns true' ); is( $Foo::VALUE, 'my$foo="bar";', 'MyCleaner->apply( $Foo ) modifies code as expected' ); } ##################################################################### # File transforms my $testdir = catdir( 't', 'data', '15_transform'); # Does the test directory exist? ok( (-e $testdir and -d $testdir and -r $testdir), "Test directory $testdir found" ); # Find the .pm test files opendir( TESTDIR, $testdir ) or die "opendir: $!"; my @files = sort grep { /\.pm$/ } readdir(TESTDIR); closedir( TESTDIR ) or die "closedir: $!"; ok( scalar @files, 'Found at least one .pm file' ); ##################################################################### # Testing my $tempdir = tempdir(CLEANUP => 1); foreach my $input ( @files ) { # Prepare my $copy = catfile($tempdir, "${input}_copy"); my $copy2 = catfile($tempdir, "${input}_copy2"); $input = catfile($testdir, $input); my $output = "${input}_out"; ok( copy( $input, $copy ), "Copied $input to $copy" ); my $Original = new_ok( 'PPI::Document' => [ $input ] ); my $Input = new_ok( 'PPI::Document' => [ $input ] ); my $Output = new_ok( 'PPI::Document' => [ $output ] ); # Process the file my $rv = MyCleaner->document( $Input ); isa_ok( $rv, 'PPI::Document' ); is( refaddr($rv), refaddr($Input), '->document returns original document' ); is_deeply( $Input, $Output, 'Transform works as expected' ); # Squish to another location ok( MyCleaner->file( $copy, $copy2 ), '->file returned true' ); my $Copy = new_ok( 'PPI::Document' => [ $copy ] ); is_deeply( $Copy, $Original, 'targeted transform leaves original unchanged' ); my $Copy2 = new_ok( 'PPI::Document' => [ $copy2 ] ); is_deeply( $Copy2, $Output, 'targeted transform works as expected' ); # Copy the file and process in-place ok( MyCleaner->file( $copy ), '->file returned true' ); $Copy = new_ok( 'PPI::Document' => [ $copy ] ); is_deeply( $Copy, $Output, 'In-place transform works as expected' ); } eval { PPI::Transform->document }; like $@, qr/PPI::Transform does not implement the required ->document method/, "transform classes need to implement ->document"; ##################################################################### # Support Code # Test Transform class package MyCleaner; use Params::Util qw{_INSTANCE}; use PPI::Transform (); our @ISA; BEGIN { @ISA = 'PPI::Transform'; # in a BEGIN block due to being an inline package } sub document { my $self = shift; my $Document = _INSTANCE(shift, 'PPI::Document') or return undef; $Document->prune( 'Token::Whitespace' ); $Document; } package Foo; sub new { bless { }, 'Foo'; } our $VALUE = ''; sub get { PPI::Document->new( \$VALUE ); } sub set { $VALUE = $_[1]->serialize; } 25_increment.t100644000000000000 107713511127601 15507 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Given that we know the regression tests represent potentially # broken locations in the code, process every single transitional # state between an empty document and the entire file to make sure # all of them parse as legal documents and don't crash the parser. use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8998 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; use PPI::Test::Run; ##################################################################### # Code/Dump Testing PPI::Test::Run->increment_testdir(qw{ t data 08_regression }); test2.txt100644000000000000 24513511127601 15517 0ustar00unknownunknown000000000000PPI-1.270/t/data#!/usr/bin/perl print "Hello World!\n"; =pod =head1 Foo This is the first pod section =cut print "Goodbye World!"; =head1 Bar This is the second pod section Dumper.pm100644000000000000 1545313511127601 15600 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Dumper; =pod =head1 NAME PPI::Dumper - Dumping of PDOM trees =head1 SYNOPSIS # Load a document my $Module = PPI::Document->new( 'MyModule.pm' ); # Create the dumper my $Dumper = PPI::Dumper->new( $Module ); # Dump the document $Dumper->print; =head1 DESCRIPTION The PDOM trees in PPI are quite complex, and getting a dump of their structure for development and debugging purposes is important. This module provides that functionality. The process is relatively simple. Create a dumper object with a particular set of options, and then call one of the dump methods to generate the dump content itself. =head1 METHODS =cut use strict; use Params::Util qw{_INSTANCE}; our $VERSION = '1.270'; # VERSION ##################################################################### # Constructor =pod =head2 new $Element, param => value, ... The C constructor creates a dumper, and takes as argument a single L object of any type to serve as the root of the tree to be dumped, and a number of key-Evalue parameters to control the output format of the Dumper. Details of the parameters are listed below. Returns a new C object, or C if the constructor is not passed a correct L root object. =over =item memaddr Should the dumper print the memory addresses of each PDOM element. True/false value, off by default. =item indent Should the structures being dumped be indented. This value is numeric, with the number representing the number of spaces to use when indenting the dumper output. Set to '2' by default. =item class Should the dumper print the full class for each element. True/false value, on by default. =item content Should the dumper show the content of each element. True/false value, on by default. =item whitespace Should the dumper show whitespace tokens. By not showing the copious numbers of whitespace tokens the structure of the code can often be made much clearer. True/false value, on by default. =item comments Should the dumper show comment tokens. In situations where you have a lot of comments, the code can often be made clearer by ignoring comment tokens. True/false value, on by default. =item locations Should the dumper show the location of each token. The values shown are [ line, rowchar, column ]. See L for a description of what these values really are. True/false value, off by default. =back =cut sub new { my $class = shift; my $Element = _INSTANCE(shift, 'PPI::Element') or return undef; # Create the object my $self = bless { root => $Element, display => { memaddr => '', # Show the refaddr of the item indent => 2, # Indent the structures class => 1, # Show the object class content => 1, # Show the object contents whitespace => 1, # Show whitespace tokens comments => 1, # Show comment tokens locations => 0, # Show token locations }, }, $class; # Handle the options my @options = map { lc $_ } @_; # strict hashpairs # https://github.com/adamkennedy/PPI/issues/201 my %options = @options; foreach ( keys %{$self->{display}} ) { if ( exists $options{$_} ) { if ( $_ eq 'indent' ) { $self->{display}->{indent} = $options{$_}; } else { $self->{display}->{$_} = !! $options{$_}; } } } $self->{indent_string} = join '', (' ' x $self->{display}->{indent}); $self; } ##################################################################### # Main Interface Methods =pod =head2 print The C method generates the dump and prints it to STDOUT. Returns as for the internal print function. =cut sub print { CORE::print(shift->string); } =pod =head2 string The C method generates the dump and provides it as a single string. Returns a string or undef if there is an error while generating the dump. =cut sub string { my $array_ref = shift->_dump or return undef; join '', map { "$_\n" } @$array_ref; } =pod =head2 list The C method generates the dump and provides it as a raw list, without trailing newlines. Returns a list or the null list if there is an error while generating the dump. =cut sub list { my $array_ref = shift->_dump or return (); @$array_ref; } ##################################################################### # Generation Support Methods sub _dump { my $self = ref $_[0] ? shift : shift->new(shift); my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root}; my $indent = shift || ''; my $output = shift || []; # Print the element if needed my $show = 1; if ( $Element->isa('PPI::Token::Whitespace') ) { $show = 0 unless $self->{display}->{whitespace}; } elsif ( $Element->isa('PPI::Token::Comment') ) { $show = 0 unless $self->{display}->{comments}; } push @$output, $self->_element_string( $Element, $indent ) if $show; # Recurse into our children if ( $Element->isa('PPI::Node') ) { my $child_indent = $indent . $self->{indent_string}; foreach my $child ( @{$Element->{children}} ) { $self->_dump( $child, $child_indent, $output ); } } $output; } sub _element_string { my $self = ref $_[0] ? shift : shift->new(shift); my $Element = _INSTANCE($_[0], 'PPI::Element') ? shift : $self->{root}; my $indent = shift || ''; my $string = ''; # Add the memory location if ( $self->{display}->{memaddr} ) { $string .= $Element->refaddr . ' '; } # Add the location if such exists if ( $self->{display}->{locations} ) { my $loc_string; if ( $Element->isa('PPI::Token') ) { my $location = $Element->location; if ($location) { $loc_string = sprintf("[ % 4d, % 3d, % 3d ] ", @$location); } } # Output location or pad with 20 spaces $string .= $loc_string || " " x 20; } # Add the indent if ( $self->{display}->{indent} ) { $string .= $indent; } # Add the class name if ( $self->{display}->{class} ) { $string .= ref $Element; } if ( $Element->isa('PPI::Token') ) { # Add the content if ( $self->{display}->{content} ) { my $content = $Element->content; $content =~ s/\n/\\n/g; $content =~ s/\t/\\t/g; $content =~ s/\f/\\f/g; $string .= " \t'$content'"; } } elsif ( $Element->isa('PPI::Structure') ) { # Add the content if ( $self->{display}->{content} ) { my $start = $Element->start ? $Element->start->content : '???'; my $finish = $Element->finish ? $Element->finish->content : '???'; $string .= " \t$start ... $finish"; } } $string; } 1; =pod =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut Normal.pm100644000000000000 1433713511127601 15574 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Normal; =pod =head1 NAME PPI::Normal - Normalize Perl Documents =head2 DESCRIPTION Perl Documents, as created by PPI, are typically filled with all sorts of mess such as whitespace and comments and other things that don't effect the actual meaning of the code. In addition, because there is more than one way to do most things, and the syntax of Perl itself is quite flexible, there are many ways in which the "same" code can look quite different. PPI::Normal attempts to resolve this by providing a variety of mechanisms and algorithms to "normalize" Perl Documents, and determine a sort of base form for them (although this base form will be a memory structure, and not something that can be turned back into Perl source code). The process itself is quite complex, and so for convenience and extensibility it has been separated into a number of layers. At a later point, it will be possible to write Plugin classes to insert additional normalization steps into the various different layers. In addition, you can choose to do the normalization only as deep as a particular layer, depending on aggressively you want the normalization process to be. =head1 METHODS =cut use strict; use Carp (); use List::Util 1.33 (); use PPI::Util '_Document'; use PPI::Document::Normalized (); use PPI::Normal::Standard (); use PPI::Singletons '%LAYER'; our $VERSION = '1.270'; # VERSION # With the registration mechanism in place, load in the main set of # normalization methods to initialize the store. PPI::Normal::Standard->import; ##################################################################### # Configuration =pod =head2 register $function => $layer, ... The C method is used by normalization method providers to tell the normalization engines which functions need to be run, and in which layer they apply. Provide a set of key/value pairs, where the key is the full name of the function (in string form), and the value is the layer (see description of the layers above) in which it should be run. Returns true if all functions are registered, or C on error. =cut sub register { my $class = shift; while ( @_ ) { # Check the function my $function = shift; SCOPE: { no strict 'refs'; defined $function and defined &{"$function"} or Carp::croak("Bad function name provided to PPI::Normal"); } # Has it already been added? if ( List::Util::any { $_ eq $function } map @{$_}, values %LAYER ) { return 1; } # Check the layer to add it to my $layer = shift; defined $layer and $layer =~ /^(?:1|2)$/ or Carp::croak("Bad layer provided to PPI::Normal"); # Add to the layer data store push @{ $LAYER{$layer} }, $function; } 1; } ##################################################################### # Constructor and Accessors =pod =head2 new my $level_1 = PPI::Normal->new; my $level_2 = PPI::Normal->new(2); Creates a new normalization object, to which Document objects can be passed to be normalized. Of course, what you probably REALLY want is just to call L's C method. Takes an optional single parameter of the normalisation layer to use, which at this time can be either "1" or "2". Returns a new C object, or C on error. =cut sub new { my $class = shift; my $layer = @_ ? (defined $_[0] and ! ref $_[0] and $_[0] =~ /^[12]$/) ? shift : return undef : 1; # Create the object my $object = bless { layer => $layer, }, $class; $object; } =pod =head1 layer The C accessor returns the normalisation layer of the object. =cut sub layer { $_[0]->{layer} } ##################################################################### # Main Methods =pod =head2 process The C method takes anything that can be converted to a L (object, SCALAR ref, filename), loads it and applies the normalisation process to the document. Returns a L object, or C on error. =cut sub process { my $self = ref $_[0] ? shift : shift->new; # PPI::Normal objects are reusable, but not re-entrant return undef if $self->{Document}; # Get or create the document $self->{Document} = _Document(shift) or return undef; # Work out what functions we need to call my @functions = map { @{ $LAYER{$_} } } ( 1 .. $self->layer ); # Execute each function foreach my $function ( @functions ) { no strict 'refs'; &{"$function"}( $self->{Document} ); } # Create the normalized Document object my $Normalized = PPI::Document::Normalized->new( Document => $self->{Document}, version => __PACKAGE__->VERSION, functions => \@functions, ) or return undef; # Done, clean up delete $self->{Document}; return $Normalized; } 1; =pod =head1 NOTES The following normalisation layers are implemented. When writing plugins, you should register each transformation function with the appropriate layer. =head2 Layer 1 - Insignificant Data Removal The basic step common to all normalization, layer 1 scans through the Document and removes all whitespace, comments, POD, and anything else that returns false for its C method. It also checks each Element and removes known-useless sub-element metadata such as the Element's physical position in the file. =head2 Layer 2 - Significant Element Removal After the removal of the insignificant data, Layer 2 removed larger, more complex, and superficially "significant" elements, that can be removed for the purposes of normalisation. Examples from this layer include pragmas, now-useless statement separators (since the PDOM tree is holding statement elements), and several other minor bits and pieces. =head2 Layer 3 - TO BE COMPLETED This version of the forward-port of the Perl::Compare functionality to the 0.900+ API of PPI only implements Layer 1 and 2 at this time. =head1 TO DO - Write the other 4-5 layers :) =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2005 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut 06_round_trip.t100644000000000000 500213511127601 15677 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Load ALL of the PPI files, lex them in, dump them # out, and verify that the code goes in and out cleanly. use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use File::Spec::Functions ':ALL'; use PPI; use PPI::Test 'find_files'; ##################################################################### # Prepare # Find all of the files to be checked my %tests = map { $_ => $INC{$_} } grep { ! /\bXS\.pm/ } grep { /^PPI\b/ } keys %INC; my @files = sort values %tests; unless ( @files ) { Test::More::plan( tests => ($ENV{AUTHOR_TESTING} ? 1 : 0) + 1 ); ok( undef, "Failed to find any files to test" ); exit(); } # Find all the testable perl files in t/data foreach my $dir ( '05_lexer', '07_token', '08_regression', '11_util', '13_data', '15_transform' ) { my @perl = find_files( catdir( 't', 'data', $dir ) ); push @files, @perl; } # Add the test scripts themselves push @files, find_files( 't' ); # Declare our plan Test::More::plan( tests => ($ENV{AUTHOR_TESTING} ? 1 : 0) + scalar(@files) * 9 ); ##################################################################### # Run the Tests foreach my $file ( @files ) { roundtrip_ok( $file ); } ##################################################################### # Test Functions sub roundtrip_ok { my $file = shift; local *FILE; my $rv = open( FILE, '<', $file ); ok( $rv, "$file: Found file " ); SKIP: { skip "No file to test", 7 unless $rv; my $source = do { local $/ = undef; }; close FILE; ok( length $source, "$file: Loaded cleanly" ); $source =~ s/(?:\015{1,2}\012|\015|\012)/\n/g; # Load the file as a Document SKIP: { skip( 'Ignoring 14_charset.t', 7 ) if $file =~ /14_charset/; my $Document = PPI::Document->new( $file ); ok( $Document, "$file: ->new returned true" ); isa_ok( $Document, 'PPI::Document' ); # Serialize it back out, and compare with the raw version skip( "Ignoring failed parse of $file", 5 ) unless defined $Document; my $content = $Document->serialize; ok( length($content), "$file: PPI::Document serializes" ); is( $content, $source, "$file: Round trip was successful" ); # Are there any unknown things? is( $Document->find_any('Token::Unknown'), '', "$file: Contains no PPI::Token::Unknown elements" ); is( $Document->find_any('Structure::Unknown'), '', "$file: Contains no PPI::Structure::Unknown elements" ); is( $Document->find_any('Statement::Unknown'), '', "$file: Contains no PPI::Statement::Unknown elements" ); } } } 08_regression.t100644000000000000 2423213511127601 15722 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # code/dump-style regression tests for known lexing problems. # Some other regressions tests are included here for simplicity. use if !(-e 'META.yml'), "Test::InDistDir"; use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 1015 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; use PPI::Test 'pause'; use PPI::Test::Run; use PPI::Singletons '%_PARENT'; ##################################################################### # Code/Dump Testing PPI::Test::Run->run_testdir(qw{ t data 08_regression }); ##################################################################### # Regression Test for rt.cpan.org #11522 # Check that objects created in a foreach don't leak circulars. foreach ( 1 .. 3 ) { pause(); is( scalar(keys(%_PARENT)), 0, "No parent links at start of loop $_" ); # Keep the document from going out of scope before the _PARENT test below. my $Document = PPI::Document->new(\q[print "Foo!"]); ## no critic ( Variables::ProhibitUnusedVarsStricter ) is( scalar(keys(%_PARENT)), 4, 'Correct number of keys created' ); } ##################################################################### # A number of things picked up during exhaustive testing I want to # watch for regressions on # Create a document with a complete braced regexp SCOPE: { my $Document = PPI::Document->new( \"s {foo} i" ); isa_ok( $Document, 'PPI::Document' ); my $stmt = $Document->first_element; isa_ok( $stmt, 'PPI::Statement' ); my $regexp = $stmt->first_element; isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); # Check the regexp matches what we would expect (specifically # the fine details about the sections. my $expected = { _sections => 2, braced => 1, content => 's {foo} i', modifiers => { i => 1 }, operator => 's', sections => [ { position => 3, size => 3, type => '{}', }, { position => 9, size => 3, type => '<>', } ], separator => undef, }; is_deeply( { %$regexp }, $expected, 'Complex regexp matches expected' ); } # Also test the handling of a screwed up single part multi-regexp SCOPE: { my $Document = PPI::Document->new( \"s {foo}_" ); isa_ok( $Document, 'PPI::Document' ); my $stmt = $Document->first_element; isa_ok( $stmt, 'PPI::Statement' ); my $regexp = $stmt->first_element; isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); # Check the internal details as before my $expected = { _sections => 2, _error => "No second section of regexp, or does not start with a balanced character", braced => 1, content => 's {foo}', modifiers => {}, operator => 's', sections => [ { position => 3, size => 3, type => '{}', }, { position => 7, size => 0, type => '', } ], separator => undef, }; is_deeply( { %$regexp }, $expected, 'Badly short regexp matches expected' ); } # Encode an assumption that the value of a zero-length substr one char # after the end of the string returns ''. This assumption is used to make # the decision on the sections->[1]->{position} value being one char after # the end of the current string is( substr('foo', 3, 0), '', 'substr one char after string end returns ""' ); # rt.cpan.org: Ticket #16671 $_ is not localized # Apparently I DID fix the localisation during parsing, but I forgot to # localise in PPI::Node::DESTROY (ack). $_ = 1234; is( $_, 1234, 'Set $_ to 1234' ); SCOPE: { my $Document = PPI::Document->new( \"print 'Hello World';"); isa_ok( $Document, 'PPI::Document' ); } is( $_, 1234, 'Remains after document creation and destruction' ); ##################################################################### # Bug 16815: location of Structure::List is not defined. SCOPE: { my $code = '@foo = (1,2)'; my $doc = PPI::Document->new(\$code); isa_ok( $doc, 'PPI::Document' ); ok( $doc->find_first('Structure::List')->location, '->location for a ::List returns true' ); } ##################################################################### # Bug 18413: PPI::Node prune() implementation broken SCOPE: { my $doc = PPI::Document->new( \<<'END_PERL' ); #!/usr/bin/perl use warnings; sub one { 1 } sub two { 2 } sub three { 3 } print one; print "\n"; print three; print "\n"; exit; END_PERL isa_ok( $doc, 'PPI::Document' ); ok( defined $doc->prune('PPI::Statement::Sub'), '->prune ok' ); } ##################################################################### # Bug 19883: 'package' bareword used as hash key is detected as package statement SCOPE: { my $doc = PPI::Document->new( \'(package => 123)' ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0)->child(0)->child(0), 'PPI::Statement' ); isa_ok( $doc->child(0)->child(0)->child(0), 'PPI::Statement::Expression' ); } ##################################################################### # Bug 19629: End of list mistakenly seen as end of statement SCOPE: { my $doc = PPI::Document->new( \'()' ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0), 'PPI::Statement' ); } SCOPE: { my $doc = PPI::Document->new( \'{}' ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0), 'PPI::Statement' ); } SCOPE: { my $doc = PPI::Document->new( \'[]' ); isa_ok( $doc, 'PPI::Document' ); isa_ok( $doc->child(0), 'PPI::Statement' ); } ##################################################################### # Bug 21575: PPI::Statement::Variable::variables breaks for lists # with leading whitespace SCOPE: { my $doc = PPI::Document->new( \'my ( $self, $param ) = @_;' ); my $stmt = $doc->child(0); isa_ok( $stmt, 'PPI::Statement::Variable' ); is_deeply( [$stmt->variables], ['$self', '$param'], 'variables() for my list with whitespace' ); } ##################################################################### # Bug #23788: PPI::Statement::location() returns undef for C<({})>. SCOPE: { my $doc = PPI::Document->new( \'({})' ); isa_ok( $doc, 'PPI::Document' ); my $bad = $doc->find( sub { not defined $_[1]->location } ); is( $bad, '', 'All elements return defined for ->location' ); } ##################################################################### # Chris Laco on users@perlcritic.tigris.org (sorry no direct URL...) # http://perlcritic.tigris.org/servlets/SummarizeList?listName=users # Empty constructor has no location SCOPE: { my $doc = PPI::Document->new( \'$h={};' ); my $hash = $doc->find('PPI::Structure::Constructor')->[0]; ok($hash, 'location for empty constructor - fetched a constructor'); is_deeply( $hash->location, [1,4,4,1,undef], 'location for empty constructor'); } ##################################################################### # Perl::MinimumVersion regression SCOPE: { my $doc = PPI::Document->new( \'use utf8;' ); my $stmt = $doc->child(0); isa_ok( $stmt, 'PPI::Statement::Include' ); is( $stmt->pragma, 'utf8', 'pragma() with numbers' ); } ##################################################################### # Proof that _new_token must return "1" SCOPE: { my $doc = PPI::Document->new(\<<'END_PERL'); $$content =~ s/(?:\015{1,2}\012|\015|\012)/\n/gs; END_PERL isa_ok( $doc, 'PPI::Document' ); } ###################################################################### # Check quoteengine token behaviour at end of file SCOPE: { my $doc = PPI::Document->new(\'s/'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 0, 'Found 0 section' ); } SCOPE: { my $doc = PPI::Document->new(\'s{'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 0, 'Found 0 section' ); } SCOPE: { my $doc = PPI::Document->new(\'s/foo'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); is( $regexp->_section_content(0), 'foo', 's/foo correct at EOL' ); } SCOPE: { my $doc = PPI::Document->new(\'s{foo'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); is( $regexp->_section_content(0), 'foo', 's{foo correct at EOL' ); } SCOPE: { my $doc = PPI::Document->new(\'s/foo/'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = PPI::Document->new(\'s{foo}{'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = PPI::Document->new(\'s{foo}/'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 1, 'Found 1 section' ); } SCOPE: { my $doc = PPI::Document->new(\'s/foo/bar'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's/foo/bar correct at EOL' ); } SCOPE: { my $doc = PPI::Document->new(\'s{foo}{bar'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's{foo}{bar correct at EOL' ); } SCOPE: { my $doc = PPI::Document->new(\'s{foo}/bar'); isa_ok( $doc, 'PPI::Document' ); my $regexp = $doc->child(0)->child(0); isa_ok( $regexp, 'PPI::Token::Regexp::Substitute' ); is( $regexp->_sections, 2, 'Found 2 sections' ); is( $regexp->_section_content(1), 'bar', 's{foo}/bar correct at EOL' ); } ###################################################################### # Confirmation of cases where we special case / to a regex SCOPE: { my $doc = PPI::Document->new(\<<'END_PERL'); @foo = split /foo/, $var; return / Special /x ? 0 : 1; print "Hello" if /regex/; END_PERL isa_ok( $doc, 'PPI::Document' ); my $match = $doc->find('PPI::Token::Regexp::Match'); is( scalar(@$match), 3, 'Found expected number of matches' ); } 21_exhaustive.t100644000000000000 1206713511127601 15725 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Exhaustively test all possible Perl programs to a particular length use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use Params::Util qw{_INSTANCE}; use PPI; use PPI::Test 'quotable'; # When distributing, keep this in to verify the test script # is working correctly, but limit to 2 (maaaaybe 3) so we # don't slow the install process down too much. my ( $MAX_CHARS, $ITERATIONS, $LENGTH ) = ( 2, 1000, 190 ); my @ALL_CHARS = ( qw{a b c f g m q r s t w x y z V W X 0 1 8 9}, ';', '[', ']', '{', '}', '(', ')', '=', '?', '|', '+', '<', '>', '.', '!', '~', '^', '*', '$', '@', '&', ':', '%', ',', '\\', '/', '_', ' ', "\n", "\t", '-', "'", '"', '`', '#', # Comment out to make parsing more intense ); # Cases known to have failed in the past. my @FAILURES = ( # Failed cases 3 chars or less '!%:', '!%:', '!%:', '!%:', '!*:', '!@:', '%:', '%:,', '%:;', '*:', '*:,', '*::', '*:;', '+%:', '+*:', '+@:', '-%:', '-*:', '-@:', ';%:', ';*:', ';@:', '@:', '@:,', '@::', '@:;', '\%:', '\&:', '\*:', '\@:', '~%:', '~*:', '~@:', '(<', '(<', '=<', 'm(', 'm(', 'm<', 'm[', 'm{', 'q(', 'q<', 'q[', 'q{', 's(', 's<', 's[', 's{', 'y(', 'y<', 'y[', 'y{', '$\'0', '009', '0bB', '0xX', '009;', '0bB;', '0xX;', "<<'", '<<"', '<<`', '&::', '<s', 's<>-', '*::0', '*::1', '*:::', '*::\'', '$::0', '$:::', '$::\'', '@::0', '@::1', '@:::', '&::0', '&::\'', '%:::', '%::\'', # More-specific single cases thrown up during the heavy testing '$:::z', '*:::z', "\\\@::'9:!", "} mz}~<\nV", "( {8", ); plan tests => ($MAX_CHARS + $ITERATIONS + @FAILURES + ($ENV{AUTHOR_TESTING} ? 1 : 0)); ##################################################################### # Code/Dump Testing my $last_index = scalar(@ALL_CHARS) - 1; LENGTHLOOP: foreach my $len ( 1 .. $MAX_CHARS ) { # Initialise the char array my @chars = (0) x $len; # The main test loop my $failures = 0; # simulate subtests CHARLOOP: while ( 1 ) { # Test the current set of chars my $code = join '', map { $ALL_CHARS[$_] } @chars; unless ( length($code) == $len ) { die "Failed sanity check. Error in the code generation mechanism"; } $failures += 1 if !compare_code( $code ); # Increment the last character $chars[$len - 1]++; # Cascade the wrapping as needed foreach ( reverse( 0 .. $len - 1 ) ) { next CHARLOOP unless $chars[$_] > $last_index; if ( $_ == 0 ) { # End of the iterations, move to the next length last CHARLOOP; } # Carry to the previous char $chars[$_] = 0; $chars[$_ - 1]++; } } is( $failures, 0, "No tokenizer failures for all $len-length programs" ); } ##################################################################### # Test a series of random strings for ( 1 .. $ITERATIONS ) { # Generate a random string my $code = join( '', map { $ALL_CHARS[$_] } map { int(rand($last_index) + 1) } (1 .. $LENGTH) ); ok( compare_code($code), "round trip successful" ); } ##################################################################### # Test all the failures foreach my $code ( @FAILURES ) { ok( compare_code($code), "round trip of old failure successful" ); } exit(0); ##################################################################### # Support Functions sub compare_code { my ( $code ) = @_; my $round_tripped = round_trip_code($code); my $ok = ($code eq $round_tripped); if ( !$ok ) { my $code_quoted = quotable($code); diag( qq{input: "$code_quoted"} ); my $round_tripped_quoted = quotable($round_tripped); diag( qq{output: "$round_tripped_quoted"} ); my $shortest = quotable(quickcheck($code)); diag( qq{shorted failing substring: "$shortest"} ); } if ( scalar(keys %PPI::Element::PARENT) != 0 ) { $ok = 0; my $code_quoted = quotable($code); diag( qq{ Stale \%PARENT entries at the end of testing of "$code_quoted"} ); } %PPI::Element::PARENT = %PPI::Element::PARENT; return $ok; } sub round_trip_code { my ( $code ) = @_; my $result; my $Document = eval { # use Carp 'croak'; $SIG{__WARN__} = sub { croak('Triggered a warning') }; PPI::Document->new(\$code); }; if ( _INSTANCE($Document, 'PPI::Document') ) { $result = $Document->serialize; } return $result; } # Find the shortest failing substring of known bad string sub quickcheck { my $code = shift; my $fails = $code; # use Carp 'croak'; $SIG{__WARN__} = sub { croak('Triggered a warning') }; while ( length $fails ) { chop $code; PPI::Document->new(\$code) or last; $fails = $code; } while ( length $fails ) { substr( $code, 0, 1, '' ); PPI::Document->new(\$code) or return $fails; $fails = $code; } return $fails; } 28_foreach_qw.t100644000000000000 261613511127601 15644 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Standalone tests to check "foreach qw{foo} {}" use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 12 + ($ENV{AUTHOR_TESTING} ? 1 : 0); #use File::Spec::Functions ':ALL'; use PPI; ##################################################################### # Parse the canonical cases SCOPE: { my $string = 'for qw{foo} {} foreach'; my $document = PPI::Document->new( \$string ); isa_ok( $document, 'PPI::Document' ); my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } SCOPE: { my $string = 'foreach qw{foo} {} foreach'; my $document = PPI::Document->new( \$string ); isa_ok( $document, 'PPI::Document' ); my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } SCOPE: { my $string = 'for my $foo qw{bar} {} foreach'; my $document = PPI::Document->new( \$string ); isa_ok( $document, 'PPI::Document' ); my $statements = $document->find('Statement::Compound'); is( scalar(@$statements), 2, 'Found 2 statements' ); is( $statements->[0]->type, 'foreach', '->type ok' ); is( $statements->[1]->type, 'foreach', '->type ok' ); } 1; PPI000755000000000000 013511127601 14061 5ustar00unknownunknown000000000000PPI-1.270/t/libTest.pm100644000000000000 170513511127601 15501 0ustar00unknownunknown000000000000PPI-1.270/t/lib/PPIpackage PPI::Test; use warnings; use strict; use File::Spec::Functions (); our @ISA = 'Exporter'; our @EXPORT_OK = qw( find_files quotable pause ); our %EXPORT_TAGS; # Find file names in named t/data dirs sub find_files { my ( $testdir ) = @_; # Does the test directory exist? die "Failed to find test directory $testdir" if !-e $testdir or !-d $testdir or !-r $testdir; # Find the .code test files opendir my $TESTDIR, $testdir or die "opendir: $!"; my @perl = map { File::Spec::Functions::catfile( $testdir, $_ ) } sort grep { /\.(?:code|pm|t)$/ } readdir $TESTDIR; closedir $TESTDIR or die "closedir: $!"; return @perl; } sub quotable { my ( $quotable ) = @_; $quotable =~ s|\\|\\\\|g; $quotable =~ s|\t|\\t|g; $quotable =~ s|\n|\\n|g; $quotable =~ s|\$|\\\$|g; $quotable =~ s|\@|\\\@|g; $quotable =~ s|\"|\\\"|g; return $quotable; } sub pause { local $@; sleep 1 if !eval { require Time::HiRes; Time::HiRes::sleep(0.1); 1 }; } 1; ppi_statement.t100644000000000000 461613511127601 16073 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Statement use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 22 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; SPECIALIZED: { my $Document = PPI::Document->new(\<<'END_PERL'); package Foo; use strict; ; while (1) { last; } BEGIN { } sub foo { } state $x; $x = 5; END_PERL isa_ok( $Document, 'PPI::Document' ); my $statements = $Document->find('Statement'); is( scalar @{$statements}, 10, 'Found the 10 test statements' ); isa_ok( $statements->[0], 'PPI::Statement::Package', 'Statement 1: isa Package' ); ok( $statements->[0]->specialized, 'Statement 1: is specialized' ); isa_ok( $statements->[1], 'PPI::Statement::Include', 'Statement 2: isa Include' ); ok( $statements->[1]->specialized, 'Statement 2: is specialized' ); isa_ok( $statements->[2], 'PPI::Statement::Null', 'Statement 3: isa Null' ); ok( $statements->[2]->specialized, 'Statement 3: is specialized' ); isa_ok( $statements->[3], 'PPI::Statement::Compound', 'Statement 4: isa Compound' ); ok( $statements->[3]->specialized, 'Statement 4: is specialized' ); isa_ok( $statements->[4], 'PPI::Statement::Expression', 'Statement 5: isa Expression' ); ok( $statements->[4]->specialized, 'Statement 5: is specialized' ); isa_ok( $statements->[5], 'PPI::Statement::Break', 'Statement 6: isa Break' ); ok( $statements->[5]->specialized, 'Statement 6: is specialized' ); isa_ok( $statements->[6], 'PPI::Statement::Scheduled', 'Statement 7: isa Scheduled' ); ok( $statements->[6]->specialized, 'Statement 7: is specialized' ); isa_ok( $statements->[7], 'PPI::Statement::Sub', 'Statement 8: isa Sub' ); ok( $statements->[7]->specialized, 'Statement 8: is specialized' ); isa_ok( $statements->[8], 'PPI::Statement::Variable', 'Statement 9: isa Variable' ); ok( $statements->[8]->specialized, 'Statement 9: is specialized' ); is( ref $statements->[9], 'PPI::Statement', 'Statement 10: is a simple Statement' ); ok( ! $statements->[9]->specialized, 'Statement 10: is not specialized' ); } ppi_token_pod.t100644000000000000 201413511127601 16037 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token::Pod use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 8 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; MERGE: { # Create the test fragments my $one = PPI::Token::Pod->new("=pod\n\nOne\n\n=cut\n"); my $two = PPI::Token::Pod->new("=pod\n\nTwo"); isa_ok( $one, 'PPI::Token::Pod' ); isa_ok( $two, 'PPI::Token::Pod' ); # Create the combined Pod my $merged = PPI::Token::Pod->merge($one, $two); isa_ok( $merged, 'PPI::Token::Pod' ); is( $merged->content, "=pod\n\nOne\n\nTwo\n\n=cut\n", 'Merged POD looks ok' ); } TOKENIZE: { foreach my $test ( [ "=pod\n=cut", [ 'PPI::Token::Pod' ] ], [ "=pod\n=cut\n", [ 'PPI::Token::Pod' ] ], [ "=pod\n=cut\n\n", [ 'PPI::Token::Pod', 'PPI::Token::Whitespace' ] ], [ "=pod\n=Cut\n\n", [ 'PPI::Token::Pod' ] ], # pod doesn't end, so no whitespace token ) { my $T = PPI::Tokenizer->new( \$test->[0] ); my @tokens = map { ref $_ } @{ $T->all_tokens }; is_deeply( \@tokens, $test->[1], 'all tokens as expected' ); } } Element.pm100644000000000000 5435413511127601 15740 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Element; =pod =head1 NAME PPI::Element - The abstract Element class, a base for all source objects =head1 INHERITANCE PPI::Element is the root of the PDOM tree =head1 DESCRIPTION The abstract C serves as a base class for all source-related objects, from a single whitespace token to an entire document. It provides a basic set of methods to provide a common interface and basic implementations. =head1 METHODS =cut use strict; use Clone 0.30 (); use Scalar::Util qw{refaddr}; use Params::Util qw{_INSTANCE _ARRAY}; use List::Util (); use PPI::Util (); use PPI::Node (); use PPI::Singletons '%_PARENT'; our $VERSION = '1.270'; # VERSION our $errstr = ""; use overload 'bool' => \&PPI::Util::TRUE; use overload '""' => 'content'; use overload '==' => '__equals'; use overload '!=' => '__nequals'; use overload 'eq' => '__eq'; use overload 'ne' => '__ne'; ##################################################################### # General Properties =pod =head2 significant Because we treat whitespace and other non-code items as Tokens (in order to be able to "round trip" the L back to a file) the C method allows us to distinguish between tokens that form a part of the code, and tokens that aren't significant, such as whitespace, POD, or the portion of a file after (and including) the C<__END__> token. Returns true if the Element is significant, or false it not. =cut ### XS -> PPI/XS.xs:_PPI_Element__significant 0.845+ sub significant() { 1 } =pod =head2 class The C method is provided as a convenience, and really does nothing more than returning C. However, some people have found that they appreciate the laziness of C<$Foo-Eclass eq 'whatever'>, so I have caved to popular demand and included it. Returns the class of the Element as a string =cut sub class { ref($_[0]) } =pod =head2 tokens The C method returns a list of L objects for the Element, essentially getting back that part of the document as if it had not been lexed. This also means there are no Statements and no Structures in the list, just the Token classes. =cut sub tokens { $_[0] } =pod =head2 content For B C, the C method will reconstitute the base code for it as a single string. This method is also the method used for overloading stringification. When an Element is used in a double-quoted string for example, this is the method that is called. B You should be aware that because of the way that here-docs are handled, any here-doc content is not included in C, and as such you should B eval or execute the result if it contains any L. The L method C should be used to stringify a PDOM document into something that can be executed as expected. Returns the basic code as a string (excluding here-doc content). =cut ### XS -> PPI/XS.xs:_PPI_Element__content 0.900+ sub content() { '' } ##################################################################### # Navigation Methods =pod =head2 parent Elements themselves are not intended to contain other Elements, that is left to the L abstract class, a subclass of C. However, all Elements can be contained B a parent Node. If an Element is within a parent Node, the C method returns the Node. =cut sub parent { $_PARENT{refaddr $_[0]} } =pod =head2 descendant_of $element Answers whether a C is contained within another one. Cs are considered to be descendants of themselves. =cut sub descendant_of { my $cursor = shift; my $parent = shift or return undef; while ( refaddr $cursor != refaddr $parent ) { $cursor = $_PARENT{refaddr $cursor} or return ''; } return 1; } =pod =head2 ancestor_of $element Answers whether a C is contains another one. Cs are considered to be ancestors of themselves. =cut sub ancestor_of { my $self = shift; my $cursor = shift or return undef; while ( refaddr $cursor != refaddr $self ) { $cursor = $_PARENT{refaddr $cursor} or return ''; } return 1; } =pod =head2 statement For a C that is contained (at some depth) within a L, the C method will return the first parent Statement object lexically 'above' the Element. Returns a L object, which may be the same Element if the Element is itself a L object. Returns false if the Element is not within a Statement and is not itself a Statement. =cut sub statement { my $cursor = shift; while ( ! _INSTANCE($cursor, 'PPI::Statement') ) { $cursor = $_PARENT{refaddr $cursor} or return ''; } $cursor; } =pod =head2 top For a C that is contained within a PDOM tree, the C method will return the top-level Node in the tree. Most of the time this should be a L object, however this will not always be so. For example, if a subroutine has been removed from its Document, to be moved to another Document. Returns the top-most PDOM object, which may be the same Element, if it is not within any parent PDOM object. =cut sub top { my $cursor = shift; while ( my $parent = $_PARENT{refaddr $cursor} ) { $cursor = $parent; } $cursor; } =pod =head2 document For an Element that is contained within a L object, the C method will return the top-level Document for the Element. Returns the L for this Element, or false if the Element is not contained within a Document. =cut sub document { my $top = shift->top; _INSTANCE($top, 'PPI::Document') and $top; } =pod =head2 next_sibling All L objects (specifically, our parent Node) contain a number of C objects. The C method returns the C immediately after the current one, or false if there is no next sibling. =cut sub next_sibling { my $self = shift; my $parent = $_PARENT{refaddr $self} or return ''; my $key = refaddr $self; my $elements = $parent->{children}; my $position = List::Util::first { refaddr $elements->[$_] == $key } 0..$#$elements; $elements->[$position + 1] || ''; } =pod =head2 snext_sibling As per the other 's' methods, the C method returns the next B sibling of the C object. Returns a C object, or false if there is no 'next' significant sibling. =cut sub snext_sibling { my $self = shift; my $parent = $_PARENT{refaddr $self} or return ''; my $key = refaddr $self; my $elements = $parent->{children}; my $position = List::Util::first { refaddr $elements->[$_] == $key } 0..$#$elements; while ( defined(my $it = $elements->[++$position]) ) { return $it if $it->significant; } ''; } =pod =head2 previous_sibling All L objects (specifically, our parent Node) contain a number of C objects. The C method returns the Element immediately before the current one, or false if there is no 'previous' C object. =cut sub previous_sibling { my $self = shift; my $parent = $_PARENT{refaddr $self} or return ''; my $key = refaddr $self; my $elements = $parent->{children}; my $position = List::Util::first { refaddr $elements->[$_] == $key } 0..$#$elements; $position and $elements->[$position - 1] or ''; } =pod =head2 sprevious_sibling As per the other 's' methods, the C method returns the previous B sibling of the C object. Returns a C object, or false if there is no 'previous' significant sibling. =cut sub sprevious_sibling { my $self = shift; my $parent = $_PARENT{refaddr $self} or return ''; my $key = refaddr $self; my $elements = $parent->{children}; my $position = List::Util::first { refaddr $elements->[$_] == $key } 0..$#$elements; while ( $position-- and defined(my $it = $elements->[$position]) ) { return $it if $it->significant; } ''; } =pod =head2 first_token As a support method for higher-order algorithms that deal specifically with tokens and actual Perl content, the C method finds the first PPI::Token object within or equal to this one. That is, if called on a L subclass, it will descend until it finds a L. If called on a L object, it will return the same object. Returns a L object, or dies on error (which should be extremely rare and only occur if an illegal empty L exists below the current Element somewhere.) =cut sub first_token { my $cursor = shift; while ( $cursor->isa('PPI::Node') ) { $cursor = $cursor->first_element or die "Found empty PPI::Node while getting first token"; } $cursor; } =pod =head2 last_token As a support method for higher-order algorithms that deal specifically with tokens and actual Perl content, the C method finds the last PPI::Token object within or equal to this one. That is, if called on a L subclass, it will descend until it finds a L. If called on a L object, it will return the itself. Returns a L object, or dies on error (which should be extremely rare and only occur if an illegal empty L exists below the current Element somewhere.) =cut sub last_token { my $cursor = shift; while ( $cursor->isa('PPI::Node') ) { $cursor = $cursor->last_element or die "Found empty PPI::Node while getting first token"; } $cursor; } =pod =head2 next_token As a support method for higher-order algorithms that deal specifically with tokens and actual Perl content, the C method finds the L object that is immediately after the current Element, even if it is not within the same parent L as the one for which the method is being called. Note that this is B defined as a L-specific method, because it can be useful to find the next token that is after, say, a L, although obviously it would be useless to want the next token after a L. Returns a L object, or false if there are no more tokens after the Element. =cut sub next_token { my $cursor = shift; # Find the next element, going upwards as needed while ( 1 ) { my $element = $cursor->next_sibling; if ( $element ) { return $element if $element->isa('PPI::Token'); return $element->first_token; } $cursor = $cursor->parent or return ''; if ( $cursor->isa('PPI::Structure') and $cursor->finish ) { return $cursor->finish; } } } =pod =head2 previous_token As a support method for higher-order algorithms that deal specifically with tokens and actual Perl content, the C method finds the L object that is immediately before the current Element, even if it is not within the same parent L as this one. Note that this is not defined as a L-only method, because it can be useful to find the token is before, say, a L, although obviously it would be useless to want the next token before a L. Returns a L object, or false if there are no more tokens before the C. =cut sub previous_token { my $cursor = shift; # Find the previous element, going upwards as needed while ( 1 ) { my $element = $cursor->previous_sibling; if ( $element ) { return $element if $element->isa('PPI::Token'); return $element->last_token; } $cursor = $cursor->parent or return ''; if ( $cursor->isa('PPI::Structure') and $cursor->start ) { return $cursor->start; } } } ##################################################################### # Manipulation =pod =head2 clone As per the L module, the C method makes a perfect copy of an Element object. In the generic case, the implementation is done using the L module's mechanism itself. In higher-order cases, such as for Nodes, there is more work involved to keep the parent-child links intact. =cut sub clone { Clone::clone(shift); } =pod =head2 insert_before @Elements The C method allows you to insert lexical perl content, in the form of C objects, before the calling C. You need to be very careful when modifying perl code, as it's easy to break things. In its initial incarnation, this method allows you to insert a single Element, and will perform some basic checking to prevent you inserting something that would be structurally wrong (in PDOM terms). In future, this method may be enhanced to allow the insertion of multiple Elements, inline-parsed code strings or L objects. Returns true if the Element was inserted, false if it can not be inserted, or C if you do not provide a C object as a parameter. =cut sub __insert_before { my $self = shift; $self->parent->__insert_before_child( $self, @_ ); } =pod =head2 insert_after @Elements The C method allows you to insert lexical perl content, in the form of C objects, after the calling C. You need to be very careful when modifying perl code, as it's easy to break things. In its initial incarnation, this method allows you to insert a single Element, and will perform some basic checking to prevent you inserting something that would be structurally wrong (in PDOM terms). In future, this method may be enhanced to allow the insertion of multiple Elements, inline-parsed code strings or L objects. Returns true if the Element was inserted, false if it can not be inserted, or C if you do not provide a C object as a parameter. =cut sub __insert_after { my $self = shift; $self->parent->__insert_after_child( $self, @_ ); } =pod =head2 remove For a given C, the C method will remove it from its parent B, along with all of its children. Returns the C itself as a convenience, or C if an error occurs while trying to remove the C. =cut sub remove { my $self = shift; my $parent = $self->parent or return $self; $parent->remove_child( $self ); } =pod =head2 delete For a given C, the C method will remove it from its parent, immediately deleting the C and all of its children (if it has any). Returns true if the C was successfully deleted, or C if an error occurs while trying to remove the C. =cut sub delete { $_[0]->remove or return undef; $_[0]->DESTROY; 1; } =pod =head2 replace $Element Although some higher level class support more exotic forms of replace, at the basic level the C method takes a single C as an argument and replaces the current C with it. To prevent accidental damage to code, in this initial implementation the replacement element B be of the same class (or a subclass) as the one being replaced. =cut sub replace { my $self = ref $_[0] ? shift : return undef; _INSTANCE(shift, ref $self) or return undef; die "The ->replace method has not yet been implemented"; } =pod =head2 location If the Element exists within a L that has indexed the Element locations using C, the C method will return the location of the first character of the Element within the Document. Returns the location as a reference to a five-element array in the form C<[ $line, $rowchar, $col, $logical_line, $logical_file_name ]>. The values are in a human format, with the first character of the file located at C<[ 1, 1, 1, ?, 'something' ]>. The second and third numbers are similar, except that the second is the literal horizontal character, and the third is the visual column, taking into account tabbing (see L). The fourth number is the line number, taking into account any C<#line> directives. The fifth element is the name of the file that the element was found in, if available, taking into account any C<#line> directives. Returns C on error, or if the L object has not been indexed. =cut sub location { my $self = shift; $self->_ensure_location_present or return undef; # Return a copy, not the original return [ @{$self->{_location}} ]; } =pod =head2 line_number If the Element exists within a L that has indexed the Element locations using C, the C method will return the line number of the first character of the Element within the Document. Returns C on error, or if the L object has not been indexed. =cut sub line_number { my $self = shift; my $location = $self->location() or return undef; return $location->[0]; } =pod =head2 column_number If the Element exists within a L that has indexed the Element locations using C, the C method will return the column number of the first character of the Element within the Document. Returns C on error, or if the L object has not been indexed. =cut sub column_number { my $self = shift; my $location = $self->location() or return undef; return $location->[1]; } =pod =head2 visual_column_number If the Element exists within a L that has indexed the Element locations using C, the C method will return the visual column number of the first character of the Element within the Document, according to the value of L. Returns C on error, or if the L object has not been indexed. =cut sub visual_column_number { my $self = shift; my $location = $self->location() or return undef; return $location->[2]; } =pod =head2 logical_line_number If the Element exists within a L that has indexed the Element locations using C, the C method will return the line number of the first character of the Element within the Document, taking into account any C<#line> directives. Returns C on error, or if the L object has not been indexed. =cut sub logical_line_number { my $self = shift; return $self->location()->[3]; } =pod =head2 logical_filename If the Element exists within a L that has indexed the Element locations using C, the C method will return the logical file name containing the first character of the Element within the Document, taking into account any C<#line> directives. Returns C on error, or if the L object has not been indexed. =cut sub logical_filename { my $self = shift; my $location = $self->location() or return undef; return $location->[4]; } sub _ensure_location_present { my $self = shift; unless ( exists $self->{_location} ) { # Are we inside a normal document? my $Document = $self->document or return undef; if ( $Document->isa('PPI::Document::Fragment') ) { # Because they can't be serialized, document fragments # do not support the concept of location. return undef; } # Generate the locations. If they need one location, then # the chances are they'll want more, and it's better that # everything is already pre-generated. $Document->index_locations or return undef; unless ( exists $self->{_location} ) { # erm... something went very wrong here return undef; } } return 1; } # Although flush_locations is only publically a Document-level method, # we are able to implement it at an Element level, allowing us to # selectively flush only the part of the document that occurs after the # element for which the flush is called. sub _flush_locations { my $self = shift; unless ( $self == $self->top ) { return $self->top->_flush_locations( $self ); } # Get the full list of all Tokens my @Tokens = $self->tokens; # Optionally allow starting from an arbitrary element (or rather, # the first Token equal-to-or-within an arbitrary element) if ( _INSTANCE($_[0], 'PPI::Element') ) { my $start = shift->first_token; while ( my $Token = shift @Tokens ) { return 1 unless $Token->{_location}; next unless refaddr($Token) == refaddr($start); # Found the start. Flush its location delete $$Token->{_location}; last; } } # Iterate over any remaining Tokens and flush their location foreach my $Token ( @Tokens ) { delete $Token->{_location}; } 1; } ##################################################################### # XML Compatibility Methods sub _xml_name { my $class = ref $_[0] || $_[0]; my $name = lc join( '_', split /::/, $class ); substr($name, 4); } sub _xml_attr { return {}; } sub _xml_content { defined $_[0]->{content} ? $_[0]->{content} : ''; } ##################################################################### # Internals # Set the error string sub _error { $errstr = $_[1]; undef; } # Clear the error string sub _clear { $errstr = ''; $_[0]; } # Being DESTROYed in this manner, rather than by an explicit # ->delete means our reference count has probably fallen to zero. # Therefore we don't need to remove ourselves from our parent, # just the index ( just in case ). ### XS -> PPI/XS.xs:_PPI_Element__DESTROY 0.900+ sub DESTROY { delete $_PARENT{refaddr $_[0]} } # Operator overloads sub __equals { ref $_[1] and refaddr($_[0]) == refaddr($_[1]) } sub __nequals { !__equals(@_) } sub __eq { my $self = _INSTANCE($_[0], 'PPI::Element') ? $_[0]->content : $_[0]; my $other = _INSTANCE($_[1], 'PPI::Element') ? $_[1]->content : $_[1]; $self eq $other; } sub __ne { !__eq(@_) } 1; =pod =head1 TO DO It would be nice if C could be used in an ad-hoc manner. That is, if called on an Element within a Document that has not been indexed, it will do a one-off calculation to find the location. It might be very painful if someone started using it a lot, without remembering to index the document, but it would be handy for things that are only likely to use it once, such as error handlers. =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut 19_selftesting.t100644000000000000 1270213511127601 16072 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Load ALL of the PPI files, and look for a collection # of known problems, implemented using PPI itself. # Using PPI to analyse its own code at install-time? Fuck yeah! :) use lib 't/lib'; use PPI::Test::pragmas; use Test::More; # Plan comes later use Test::Object; use File::Spec::Functions ':ALL'; use Params::Util qw{_CLASS _ARRAY _INSTANCE _IDENTIFIER}; use Class::Inspector 1.22; use PPI; use PPI::Test 'find_files'; use PPI::Test::Object; use constant CI => 'Class::Inspector'; ##################################################################### # Prepare # Find all of the files to be checked my %tests = map { $_ => $INC{$_} } grep { ! /\bXS\.pm/ } grep { /^PPI\b/ } keys %INC; unless ( %tests ) { Test::More::plan( tests => 1 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); ok( undef, "Failed to find any files to test" ); exit(); } my @files = sort values %tests; # Find all the testable perl files in t/data foreach my $dir ( '05_lexer', '08_regression', '11_util', '13_data', '15_transform' ) { my @perl = find_files( catdir('t', 'data', $dir) ); push @files, @perl; } # Declare our plan Test::More::plan( tests => scalar(@files) * 14 + 3 + ($ENV{AUTHOR_TESTING} ? 1 : 0) ); ##################################################################### # Self-test the search functions before we use them # Check this actually finds something bad my $sample = PPI::Document->new(\<<'END_PERL'); isa($foo, 'Bad::Class1'); isa($foo, 'PPI::Document'); $foo->isa('Bad::Class2'); $foo->isa("Bad::Class3"); isa($foo, 'ARRAY'); # Not bad isa($foo->thing, qq # ok? ); END_PERL isa_ok( $sample, 'PPI::Document' ); my $bad = $sample->find( \&bug_bad_isa_class_name ); ok( _ARRAY($bad), 'Found bad things' ); @$bad = map { $_->string } @$bad; is_deeply( $bad, [ 'Bad::Class1', 'Bad::Class2', 'Bad::Class3', 'Bad::Class4' ], 'Found all found known bad things' ); ##################################################################### # Run the Tests foreach my $file ( @files ) { # MD5 the raw file my $md5a = PPI::Util::md5hex_file($file); like( $md5a, qr/^[[:xdigit:]]{32}\z/, 'md5hex_file ok' ); # Load the file my $Document = PPI::Document->new($file); ok( _INSTANCE($Document, 'PPI::Document'), "$file: Parsed ok" ); # Compare the preload signature to the post-load value my $md5b = $Document->hex_id; is( $md5b, $md5a, '->hex_id matches md5hex' ); # By this point, everything should have parsed properly at least # once, so no need to skip. SCOPE: { my $rv = $Document->find( \&bug_bad_isa_class_name ); if ( $rv ) { $Document->index_locations; foreach ( @$rv ) { print "# $file: Found bad class " . $_->content . "\n"; } } is_deeply( $rv, '', "$file: All class names in ->isa calls exist" ); } SCOPE: { my $rv = $Document->find( \&bad_static_method ); if ( $rv ) { $Document->index_locations; foreach ( @$rv ) { my $c = $_->sprevious_sibling->content; my $m = $_->snext_sibling->content; my $l = $_->location; print "# $file: Found bad call ${c}->${m} at line $l->[0], col $l->[1]\n"; } } is_deeply( $rv, '', "$file: All class names in static method calls" ); } # Test with Test::Object stuff object_ok( $Document ); } ##################################################################### # Test Functions # Check for accidental use of illegal or non-existant classes in # ->isa calls. This has happened at least once, presumably because # PPI has a LOT of classes and it can get confusing. sub bug_bad_isa_class_name { my ($Document, $Element) = @_; # Find a quote containing a class name $Element->isa('PPI::Token::Quote') or return ''; _CLASS($Element->string) or return ''; if ( $Element->string =~ /^(?:ARRAY|HASH|CODE|SCALAR|REF|GLOB)$/ ) { return ''; } # It should be the last thing in an expression in a list my $Expression = $Element->parent or return ''; $Expression->isa('PPI::Statement::Expression') or return ''; $Element == $Expression->schild(-1) or return ''; my $List = $Expression->parent or return ''; $List->isa('PPI::Structure::List') or return ''; $List->schildren == 1 or return ''; # The list should be the params list for an isa call my $Word = $List->sprevious_sibling or return ''; $Word->isa('PPI::Token::Word') or return ''; $Word->content =~ /^(?:UNIVERSAL::)?isa\z/s or return ''; # Is the class real and loaded? CI->loaded($Element->string) and return ''; # Looks like we found a class that doesn't exist in # an isa call. return 1; } # Check for the use of a method that doesn't exist sub bad_static_method { my ($document, $element) = @_; # Find a quote containing a class name $element->isa('PPI::Token::Operator') or return ''; $element->content eq '->' or return ''; # Check the method my $method = $element->snext_sibling or return ''; $method->isa('PPI::Token::Word') or return ''; _IDENTIFIER($method->content) or return ''; # Check the class my $class = $element->sprevious_sibling or return ''; $class->isa('PPI::Token::Word') or return ''; _CLASS($class->content) or return ''; # It's usually a deep class $class = $class->content; $method = $method->content; $class =~ /::/ or return ''; # Check the method exists $class->can($method) and return ''; return 1; } 1; filename.pl100644000000000000 15213511127601 16027 0ustar00unknownunknown000000000000PPI-1.270/t/data#!/usr/bin/perl if ( 1 ) { print "Hello World!\n"; } #line 1000 moo.pl print "Goodbye Blue Sky\n"; 1; ppi_token_word.t100644000000000000 4204613511127601 16261 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token::Word use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 1762 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; use lib 't/lib'; use Helper 'check_with'; LITERAL: { my @pairs = ( "F", 'F', "Foo::Bar", 'Foo::Bar', "Foo'Bar", 'Foo::Bar', ); while ( @pairs ) { my $from = shift @pairs; my $to = shift @pairs; my $doc = PPI::Document->new( \"$from;" ); isa_ok( $doc, 'PPI::Document' ); my $word = $doc->find_first('Token::Word'); isa_ok( $word, 'PPI::Token::Word' ); is( $word->literal, $to, "The source $from becomes $to ok" ); } } METHOD_CALL: { my $Document = PPI::Document->new(\<<'END_PERL'); indirect $foo; indirect_class_with_colon Foo::; $bar->method_with_parentheses; print SomeClass->method_without_parentheses + 1; sub_call(); $baz->chained_from->chained_to; a_first_thing a_middle_thing a_last_thing; (first_list_element, second_list_element, third_list_element); first_comma_separated_word, second_comma_separated_word, third_comma_separated_word; single_bareword_statement; { bareword_no_semicolon_end_of_block } $buz{hash_key}; fat_comma_left_side => $thingy; END_PERL isa_ok( $Document, 'PPI::Document' ); my $words = $Document->find('Token::Word'); is( scalar @{$words}, 23, 'Found the 23 test words' ); my %words = map { $_ => $_ } @{$words}; is( scalar $words{indirect}->method_call, undef, 'Indirect notation is unknown.', ); is( scalar $words{indirect_class_with_colon}->method_call, 1, 'Indirect notation with following word ending with colons is true.', ); is( scalar $words{method_with_parentheses}->method_call, 1, 'Method with parentheses is true.', ); is( scalar $words{method_without_parentheses}->method_call, 1, 'Method without parentheses is true.', ); is( scalar $words{print}->method_call, undef, 'Plain print is unknown.', ); is( scalar $words{SomeClass}->method_call, undef, 'Class in class method call is unknown.', ); is( scalar $words{sub_call}->method_call, 0, 'Subroutine call is false.', ); is( scalar $words{chained_from}->method_call, 1, 'Method that is chained from is true.', ); is( scalar $words{chained_to}->method_call, 1, 'Method that is chained to is true.', ); is( scalar $words{a_first_thing}->method_call, undef, 'First bareword is unknown.', ); is( scalar $words{a_middle_thing}->method_call, undef, 'Bareword in the middle is unknown.', ); is( scalar $words{a_last_thing}->method_call, 0, 'Bareword at the end is false.', ); foreach my $false_word ( qw< first_list_element second_list_element third_list_element first_comma_separated_word second_comma_separated_word third_comma_separated_word single_bareword_statement bareword_no_semicolon_end_of_block hash_key fat_comma_left_side > ) { is( scalar $words{$false_word}->method_call, 0, "$false_word is false.", ); } } __TOKENIZER__ON_CHAR: { # PPI::Statement::Operator for my $test ( [ q{$foo and'bar';}, 'and' ], [ q{$foo cmp'bar';}, 'cmp' ], [ q{$foo eq'bar';}, 'eq' ], [ q{$foo ge'bar';}, 'ge' ], [ q{$foo gt'bar';}, 'gt' ], [ q{$foo le'bar';}, 'le' ], [ q{$foo lt'bar';}, 'lt' ], [ q{$foo ne'bar';}, 'ne' ], [ q{$foo not'bar';}, 'not' ], [ q{$foo or'bar';}, 'or' ], [ q{$foo x'bar';}, 'x' ], [ q{$foo xor'bar';}, 'xor' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 2, 'PPI::Token::Operator', $expected, $code ); _compare_child( $statement, 3, 'PPI::Token::Quote::Single', "'bar'", $code ); _compare_child( $statement, 4, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Quote::* for my $test ( [ q{q'foo';}, q{q'foo'}, 'PPI::Token::Quote::Literal' ], [ q{qq'foo';}, q{qq'foo'}, 'PPI::Token::Quote::Interpolate' ], [ q{qr'foo';}, q{qr'foo'}, 'PPI::Token::QuoteLike::Regexp' ], [ q{qw'foo';}, q{qw'foo'}, 'PPI::Token::QuoteLike::Words' ], [ q{qx'foo';}, q{qx'foo'}, 'PPI::Token::QuoteLike::Command' ], ) { my ( $code, $expected, $type ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, $type, $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Regexp::* for my $test ( [ q{m'foo';}, q{m'foo'}, 'PPI::Token::Regexp::Match' ], [ q{s'foo'bar';}, q{s'foo'bar'}, 'PPI::Token::Regexp::Substitute' ], [ q{tr'fo'ba';}, q{tr'fo'ba'}, 'PPI::Token::Regexp::Transliterate' ], [ q{y'fo'ba';}, q{y'fo'ba'}, 'PPI::Token::Regexp::Transliterate' ], ) { my ( $code, $expected, $type ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, $type, $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Structure', ';', $code ); } # PPI::Token::Word for my $test ( [ q{abs'3';}, 'abs' ], [ q{accept'1234',2345;}, 'accept' ], [ q{alarm'5';}, 'alarm' ], [ q{atan2'5';}, 'atan2' ], [ q{bind'5',"";}, 'bind' ], [ q{binmode'5';}, 'binmode' ], [ q{bless'foo', 'bar';}, 'bless' ], [ q{break'foo' when 1;}, 'break' ], [ q{caller'3';}, 'caller' ], [ q{chdir'foo';}, 'chdir' ], [ q{chmod'0777', 'foo';}, 'chmod' ], [ q{chomp'a';}, 'chomp' ], [ q{chop'a';}, 'chop' ], [ q{chown'a';}, 'chown' ], [ q{chr'32';}, 'chr' ], [ q{chroot'a';}, 'chroot' ], [ q{close'1';}, 'close' ], [ q{closedir'1';}, 'closedir' ], [ q{connect'1234',$foo;}, 'connect' ], [ q{continue'a';}, 'continue' ], [ q{cos'3';}, 'cos' ], [ q{crypt'foo', 'bar';}, 'crypt' ], [ q{dbmclose'foo';}, 'dbmclose' ], [ q{dbmopen'foo','bar';}, 'dbmopen' ], [ q{default'a' {}}, 'default' ], [ q{defined'foo';}, 'defined' ], [ q{delete'foo';}, 'delete' ], [ q{die'foo';}, 'die' ], [ q{do'foo';}, 'do' ], [ q{dump'foo';}, 'dump' ], [ q{each'foo';}, 'each' ], [ q{else'foo' {};}, 'else' ], [ q{elsif'foo' {};}, 'elsif' ], [ q{endgrent'foo';}, 'endgrent' ], [ q{endhostent'foo';}, 'endhostent' ], [ q{endnetent'foo';}, 'endnetent' ], [ q{endprotoent'foo';}, 'endprotoent' ], [ q{endpwent'foo';}, 'endpwent' ], [ q{endservent'foo';}, 'endservent' ], [ q{eof'foo';}, 'eof' ], [ q{eval'foo';}, 'eval' ], [ q{evalbytes'foo';}, 'evalbytes' ], [ q{exec'foo';}, 'exec' ], [ q{exists'foo';}, 'exists' ], [ q{exit'foo';}, 'exit' ], [ q{exp'foo';}, 'exp' ], [ q{fc'foo';}, 'fc' ], [ q{fcntl'1';}, 'fcntl' ], [ q{fileno'1';}, 'fileno' ], [ q{flock'1', LOCK_EX;}, 'flock' ], [ q{fork'';}, 'fork' ], [ qq{format''=\n.}, 'format' ], [ q{formline'@',1;}, 'formline' ], [ q{getc'1';}, 'getc' ], [ q{getgrent'foo';}, 'getgrent' ], [ q{getgrgid'1';}, 'getgrgid' ], [ q{getgrnam'foo';}, 'getgrnam' ], [ q{gethostbyaddr'1', AF_INET;}, 'gethostbyaddr' ], [ q{gethostbyname'foo';}, 'gethostbyname' ], [ q{gethostent'foo';}, 'gethostent' ], [ q{getlogin'foo';}, 'getlogin' ], [ q{getnetbyaddr'1', AF_INET;}, 'getnetbyaddr' ], [ q{getnetbyname'foo';}, 'getnetbyname' ], [ q{getnetent'foo';}, 'getnetent' ], [ q{getpeername'foo';}, 'getpeername' ], [ q{getpgrp'1';}, 'getpgrp' ], [ q{getppid'1';}, 'getppid' ], [ q{getpriority'1',2;}, 'getpriority' ], [ q{getprotobyname'tcp';}, 'getprotobyname' ], [ q{getprotobynumber'6';}, 'getprotobynumber' ], [ q{getprotoent'foo';}, 'getprotoent' ], [ q{getpwent'foo';}, 'getpwent' ], [ q{getpwnam'foo';}, 'getpwnam' ], [ q{getpwuid'1';}, 'getpwuid' ], [ q{getservbyname'foo', 'bar';}, 'getservbyname' ], [ q{getservbyport'23', 'tcp';}, 'getservbyport' ], [ q{getservent'foo';}, 'getservent' ], [ q{getsockname'foo';}, 'getsockname' ], [ q{getsockopt'foo', 'bar', TCP_NODELAY;}, 'getsockopt' ], [ q{glob'foo';}, 'glob' ], [ q{gmtime'1';}, 'gmtime' ], [ q{goto'label';}, 'goto' ], [ q{hex'1';}, 'hex' ], [ q{index'1','foo';}, 'index' ], [ q{int'1';}, 'int' ], [ q{ioctl'1',1;}, 'ioctl' ], [ q{join'a',@foo;}, 'join' ], [ q{keys'foo';}, 'keys' ], [ q{kill'KILL';}, 'kill' ], [ q{last'label';}, 'last' ], [ q{lc'foo';}, 'lc' ], [ q{lcfirst'foo';}, 'lcfirst' ], [ q{length'foo';}, 'length' ], [ q{link'foo','bar';}, 'link' ], [ q{listen'1234',10;}, 'listen' ], [ q{local'foo';}, 'local' ], [ q{localtime'1';}, 'localtime' ], [ q{lock'foo';}, 'lock' ], [ q{log'foo';}, 'log' ], [ q{lstat'foo';}, 'lstat' ], [ q{mkdir'foo';}, 'mkdir' ], [ q{msgctl'1','foo',1;}, 'msgctl' ], [ q{msgget'1',1}, 'msgget' ], [ q{msgrcv'1',$foo,1,1,1;}, 'msgrcv' ], [ q{msgsnd'1',$foo,1;}, 'msgsnd' ], [ q{my'foo';}, 'my' ], [ q{next'label';}, 'next' ], [ q{oct'foo';}, 'oct' ], [ q{open'foo';}, 'open' ], [ q{opendir'foo';}, 'opendir' ], [ q{ord'foo';}, 'ord' ], [ q{our'foo';}, 'our' ], [ q{pack'H*',$data;}, 'pack' ], [ q{pipe'in','out';}, 'pipe' ], [ q{pop'foo';}, 'pop' ], [ q{pos'foo';}, 'pos' ], [ q{print'foo';}, 'print' ], [ q{printf'foo','bar';}, 'printf' ], [ q{prototype'foo';}, 'prototype' ], [ q{push'foo','bar';}, 'push' ], [ q{quotemeta'foo';}, 'quotemeta' ], [ q{rand'1';}, 'rand' ], [ q{read'1',$foo,100;}, 'read' ], [ q{readdir'1';}, 'readdir' ], [ q{readline'1';}, 'readline' ], [ q{readlink'1';}, 'readlink' ], [ q{readpipe'1';}, 'readpipe' ], [ q{recv'1',$foo,100,1;}, 'recv' ], [ q{redo'label';}, 'redo' ], [ q{ref'foo';}, 'ref' ], [ q{rename'foo','bar';}, 'rename' ], [ q{require'foo';}, 'require' ], [ q{reset'f';}, 'reset' ], [ q{return'foo';}, 'return' ], [ q{reverse'foo','bar';}, 'reverse' ], [ q{rewinddir'1';}, 'rewinddir' ], [ q{rindex'1','foo';}, 'rindex' ], [ q{rmdir'foo';}, 'rmdir' ], [ q{say'foo';}, 'say' ], [ q{scalar'foo','bar';}, 'scalar' ], [ q{seek'1',100,0;}, 'seek' ], [ q{seekdir'1',100;}, 'seekdir' ], [ q{select'1';}, 'select' ], [ q{semctl'1',1,1;}, 'semctl' ], [ q{semget'foo',1,1;}, 'semget' ], [ q{semop'foo','bar';}, 'semop' ], [ q{send'1',$foo'100,1;}, 'send' ], [ q{setgrent'foo';}, 'setgrent' ], [ q{sethostent'1';}, 'sethostent' ], [ q{setnetent'1';}, 'setnetent' ], [ q{setpgrp'1',2;}, 'setpgrp' ], [ q{setpriority'1',2, 3;}, 'setpriority' ], [ q{setprotoent'1';}, 'setprotoent' ], [ q{setpwent'foo';}, 'setpwent' ], [ q{setservent'1';}, 'setservent' ], [ q{setsockopt'1',2,'foo',3;}, 'setsockopt' ], [ q{shift'1','2';}, 'shift' ], [ q{shmctl'1',2,$foo;}, 'shmctl' ], [ q{shmget'1',2,1;}, 'shmget' ], [ q{shmread'1',$foo,0,10;}, 'shmread' ], [ q{shmwrite'1',$foo,0,10;}, 'shmwrite' ], [ q{shutdown'1',0;}, 'shutdown' ], [ q{sin'1';}, 'sin' ], [ q{sleep'1';}, 'sleep' ], [ q{socket'1',2,3,6;}, 'socket' ], [ q{socketpair'1',2,3,4,6;}, 'socketpair' ], [ q{splice'1',2;}, 'splice' ], [ q{split'1','foo';}, 'split' ], [ q{sprintf'foo','bar';}, 'sprintf' ], [ q{sqrt'1';}, 'sqrt' ], [ q{srand'1';}, 'srand' ], [ q{stat'foo';}, 'stat' ], [ q{state'foo';}, 'state' ], [ q{study'foo';}, 'study' ], [ q{substr'foo',1;}, 'substr' ], [ q{symlink'foo','bar';}, 'symlink' ], [ q{syscall'foo';}, 'syscall' ], [ q{sysopen'foo','bar',1;}, 'sysopen' ], [ q{sysread'1',$bar,1;}, 'sysread' ], [ q{sysseek'1',0,0;}, 'sysseek' ], [ q{system'foo';}, 'system' ], [ q{syswrite'1',$bar,1;}, 'syswrite' ], [ q{tell'1';}, 'tell' ], [ q{telldir'1';}, 'telldir' ], [ q{tie'foo',$bar;}, 'tie' ], [ q{tied'foo';}, 'tied' ], [ q{time'foo';}, 'time' ], [ q{times'foo';}, 'times' ], [ q{truncate'foo',1;}, 'truncate' ], [ q{uc'foo';}, 'uc' ], [ q{ucfirst'foo';}, 'ucfirst' ], [ q{umask'foo';}, 'umask' ], [ q{undef'foo';}, 'undef' ], [ q{unlink'foo';}, 'unlink' ], [ q{unpack'H*',$data;}, 'unpack' ], [ q{unshift'1';}, 'unshift' ], [ q{untie'foo';}, 'untie' ], [ q{utime'1','2';}, 'utime' ], [ q{values'foo';}, 'values' ], [ q{vec'1',0.0;}, 'vec' ], [ q{wait'1';}, 'wait' ], [ q{waitpid'1',0;}, 'waitpid' ], [ q{wantarray'foo';}, 'wantarray' ], [ q{warn'foo';}, 'warn' ], [ q{when'foo' {}}, 'when' ], [ q{write'foo';}, 'write' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, 'PPI::Token::Word', $expected, $code ); isa_ok( $statement->child(1), 'PPI::Token::Quote::Single', "$code: second child is a 'PPI::Token::Quote::Single'" ); } for my $test ( [ q{1 for'foo';}, 'for' ], [ q{1 foreach'foo';}, 'foreach' ], [ q{1 if'foo';}, 'if' ], [ q{1 unless'foo';}, 'unless' ], [ q{1 until'foo';}, 'until' ], [ q{1 while'foo';}, 'while' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 2, 'PPI::Token::Word', $expected, $code ); _compare_child( $statement, 3, 'PPI::Token::Quote::Single', "'foo'", $code ); } # Untested: given, grep map, sort, sub # PPI::Statement::Include for my $test ( [ "no'foo';", 'no' ], [ "require'foo';", 'require' ], [ "use'foo';", 'use' ], ) { my ( $code, $expected ) = @$test; my ( $Document, $statement ) = _parse_to_statement( $code, 'PPI::Statement::Include' ); is( $statement, $code, "$code: statement text matches" ); _compare_child( $statement, 0, 'PPI::Token::Word', $expected, $code ); _compare_child( $statement, 1, 'PPI::Token::Quote::Single', "'foo'", $code ); _compare_child( $statement, 2, 'PPI::Token::Structure', ';', $code ); } # PPI::Statement::Package my ( $PackageDocument, $statement ) = _parse_to_statement( "package'foo';", 'PPI::Statement::Package' ); is( $statement, q{package'foo';}, q{package'foo'} ); _compare_child( $statement, 0, 'PPI::Token::Word', 'package', 'package statement' ); _compare_child( $statement, 1, 'PPI::Token::Quote::Single', "'foo'", 'package statement' ); _compare_child( $statement, 2, 'PPI::Token::Structure', ';', 'package statement' ); } sub _parse_to_statement { local $Test::Builder::Level = $Test::Builder::Level+1; my $code = shift; my $type = shift; my $Document = PPI::Document->new( \$code ); isa_ok( $Document, 'PPI::Document', "$code: got the document" ); my $statements = $Document->find( $type ); is( scalar(@$statements), 1, "$code: got one $type" ); isa_ok( $statements->[0], $type, "$code: got the statement" ); return ( $Document, $statements->[0] ); } sub _compare_child { local $Test::Builder::Level = $Test::Builder::Level+1; my $statement = shift; my $childno = shift; my $type = shift; my $content = shift; my $desc = shift; isa_ok( $statement->child($childno), $type, "$desc child $childno is a $type"); is( $statement->child($childno), $content, "$desc child $childno is 1" ); return; } check_with "1.eqm'bar';", sub { is $_->child( 0 )->child( 1 )->content, "eqm'bar", "eqm' bareword after number and concat op is not mistaken for eq"; }; check_with "__DATA__", sub { is $_->child( 1 ), undef, 'DATA segment without following newline does not get one added'; }; check_with "__DATA__ a", sub { is $_->child( 1 )->content, ' a', 'DATA segment without following newline, but text, has text added as comment in following token'; }; check_with "__END__", sub { is $_->child( 1 ), undef, 'END segment without following newline does not get one added'; }; check_with "__END__ a", sub { is $_->child( 0 )->child( 1 )->content, ' a', 'END segment without following newline, but text, has text added as comment in children list'; }; check_with "__END__ a\n", sub { is $_->child( 0 )->child( 1 )->content, ' a', 'END segment, followed by text and newline, has text added as comment in children list'; }; check_with "__DATA__ a\n", sub { is $_->child( 1 )->content, ' a', 'DATA segment, followed by text and newline, has text added as comment in following token'; }; 1; Document.pm100644000000000000 5355513511127601 16127 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Document; =pod =head1 NAME PPI::Document - Object representation of a Perl document =head1 INHERITANCE PPI::Document isa PPI::Node isa PPI::Element =head1 SYNOPSIS use PPI; # Load a document from a file my $Document = PPI::Document->new('My/Module.pm'); # Strip out comments $Document->prune('PPI::Token::Comment'); # Find all the named subroutines my $sub_nodes = $Document->find( sub { $_[1]->isa('PPI::Statement::Sub') and $_[1]->name } ); my @sub_names = map { $_->name } @$sub_nodes; # Save the file $Document->save('My/Module.pm.stripped'); =head1 DESCRIPTION The C class represents a single Perl "document". A C object acts as a root L, with some additional methods for loading and saving, and working with the line/column locations of Elements within a file. The exemption to its L-like behavior this is that a C object can NEVER have a parent node, and is always the root node in a tree. =head2 Storable Support C implements the necessary C and C hooks to provide native support for L, if you have it installed. However if you want to clone a Document, you are highly recommended to use the C<$Document-Eclone> method rather than Storable's C function (although C should still work). =head1 METHODS Most of the things you are likely to want to do with a Document are probably going to involve the methods from L class, of which this is a subclass. The methods listed here are the remaining few methods that are truly Document-specific. =cut use strict; use Carp (); use List::Util 1.33 (); use Params::Util 1.00 qw{_SCALAR0 _ARRAY0 _INSTANCE}; use Digest::MD5 (); use PPI::Util (); use PPI (); use PPI::Node (); use overload 'bool' => \&PPI::Util::TRUE; use overload '""' => 'content'; our $VERSION = '1.270'; # VERSION our ( $errstr, @ISA ) = ( "", "PPI::Node" ); use PPI::Document::Fragment (); # Document cache my $CACHE; # Convenience constants related to constants use constant LOCATION_LINE => 0; use constant LOCATION_CHARACTER => 1; use constant LOCATION_COLUMN => 2; use constant LOCATION_LOGICAL_LINE => 3; use constant LOCATION_LOGICAL_FILE => 4; ##################################################################### # Constructor and Static Methods =pod =head2 new # Simple construction $doc = PPI::Document->new( $filename ); $doc = PPI::Document->new( \$source ); # With the readonly attribute set $doc = PPI::Document->new( $filename, readonly => 1, ); The C constructor takes as argument a variety of different sources of Perl code, and creates a single cohesive Perl C for it. If passed a file name as a normal string, it will attempt to load the document from the file. If passed a reference to a C, this is taken to be source code and parsed directly to create the document. If passed zero arguments, a "blank" document will be created that contains no content at all. In all cases, the document is considered to be "anonymous" and not tied back to where it was created from. Specifically, if you create a PPI::Document from a filename, the document will B remember where it was created from. The constructor also takes attribute flags. At this time, the only available attribute is the C flag. Setting C to true will allow various systems to provide additional optimisations and caching. Note that because C is an optimisation flag, it is off by default and you will need to explicitly enable it. Returns a C object, or C if parsing fails. L objects can also be thrown if there are parsing problems. =cut sub new { local $_; # An extra one, just in case my $class = ref $_[0] ? ref shift : shift; unless ( @_ ) { my $self = $class->SUPER::new; $self->{readonly} = ! 1; $self->{tab_width} = 1; return $self; } # Check constructor attributes my $source = shift; my %attr = @_; # Check the data source if ( ! defined $source ) { $class->_error("An undefined value was passed to PPI::Document::new"); } elsif ( ! ref $source ) { # Catch people using the old API if ( $source =~ /(?:\012|\015)/ ) { Carp::croak("API CHANGE: Source code should only be passed to PPI::Document->new as a SCALAR reference"); } # Save the filename $attr{filename} ||= $source; # When loading from a filename, use the caching layer if it exists. if ( $CACHE ) { my $file_contents = PPI::Util::_slurp( $source ); # Errors returned as plain string return $class->_error($file_contents) if !ref $file_contents; # Retrieve the document from the cache my $document = $CACHE->get_document($file_contents); return $class->_setattr( $document, %attr ) if $document; $document = PPI::Lexer->lex_source( $$file_contents ); if ( $document ) { # Save in the cache $CACHE->store_document( $document ); return $class->_setattr( $document, %attr ); } } else { my $document = PPI::Lexer->lex_file( $source ); return $class->_setattr( $document, %attr ) if $document; } } elsif ( _SCALAR0($source) ) { my $document = PPI::Lexer->lex_source( $$source ); return $class->_setattr( $document, %attr ) if $document; } elsif ( _ARRAY0($source) ) { $source = join '', map { "$_\n" } @$source; my $document = PPI::Lexer->lex_source( $source ); return $class->_setattr( $document, %attr ) if $document; } else { $class->_error("Unknown object or reference was passed to PPI::Document::new"); } # Pull and store the error from the lexer my $errstr; if ( _INSTANCE($@, 'PPI::Exception') ) { $errstr = $@->message; } elsif ( $@ ) { $errstr = $@; $errstr =~ s/\sat line\s.+$//; } elsif ( PPI::Lexer->errstr ) { $errstr = PPI::Lexer->errstr; } else { $errstr = "Unknown error parsing Perl document"; } PPI::Lexer->_clear; $class->_error( $errstr ); } sub load { Carp::croak("API CHANGE: File names should now be passed to PPI::Document->new to load a file"); } sub _setattr { my ($class, $document, %attr) = @_; $document->{readonly} = !! $attr{readonly}; $document->{filename} = $attr{filename}; return $document; } =pod =head2 set_cache $cache As of L 1.100, C supports parser caching. The default cache class L provides a L-based caching or the parsed document based on the MD5 hash of the document as a string. The static C method is used to set the cache object for C to use when loading documents. It takes as argument a L object (or something that C the same). If passed C, this method will stop using the current cache, if any. For more information on caching, see L. Returns true on success, or C if not passed a valid param. =cut sub set_cache { my $class = ref $_[0] ? ref shift : shift; if ( defined $_[0] ) { # Enable the cache my $object = _INSTANCE(shift, 'PPI::Cache') or return undef; $CACHE = $object; } else { # Disable the cache $CACHE = undef; } 1; } =pod =head2 get_cache If a document cache is currently set, the C method will return it. Returns a L object, or C if there is no cache currently set for C. =cut sub get_cache { $CACHE; } ##################################################################### # PPI::Document Instance Methods =pod =head2 filename The C accessor returns the name of the file in which the document is stored. =cut sub filename { $_[0]->{filename}; } =pod =head2 readonly The C attribute indicates if the document is intended to be read-only, and will never be modified. This is an advisory flag, that writers of L-related systems may or may not use to enable optimisations and caches for your document. Returns true if the document is read-only or false if not. =cut sub readonly { $_[0]->{readonly}; } =pod =head2 tab_width [ $width ] In order to handle support for C correctly, C need to understand the concept of tabs and tab width. The C method is used to get and set the size of the tab width. At the present time, PPI only supports "naive" (width 1) tabs, but we do plan on supporting arbitrary, default and auto-sensing tab widths later. Returns the tab width as an integer, or Cs if you attempt to set the tab width. =cut sub tab_width { my $self = shift; return $self->{tab_width} unless @_; $self->{tab_width} = shift; } =pod =head2 save $document->save( $file ) The C method serializes the C object and saves the resulting Perl document to a file. Returns C on failure to open or write to the file. =cut sub save { my $self = shift; local *FILE; open( FILE, '>', $_[0] ) or return undef; binmode FILE; print FILE $self->serialize or return undef; close FILE or return undef; return 1; } =pod =head2 serialize Unlike the C method, which shows only the immediate content within an element, Document objects also have to be able to be written out to a file again. When doing this we need to take into account some additional factors. Primarily, we need to handle here-docs correctly, so that are written to the file in the expected place. The C method generates the actual file content for a given Document object. The resulting string can be written straight to a file. Returns the serialized document as a string. =cut sub serialize { my $self = shift; my @tokens = $self->tokens; # The here-doc content buffer my $heredoc = ''; # Start the main loop my $output = ''; foreach my $i ( 0 .. $#tokens ) { my $Token = $tokens[$i]; # Handle normal tokens unless ( $Token->isa('PPI::Token::HereDoc') ) { my $content = $Token->content; # Handle the trivial cases unless ( $heredoc ne '' and $content =~ /\n/ ) { $output .= $content; next; } # We have pending here-doc content that needs to be # inserted just after the first newline in the content. if ( $content eq "\n" ) { # Shortcut the most common case for speed $output .= $content . $heredoc; } else { # Slower and more general version $content =~ s/\n/\n$heredoc/; $output .= $content; } $heredoc = ''; next; } # This token is a HereDoc. # First, add the token content as normal, which in this # case will definitely not contain a newline. $output .= $Token->content; # Now add all of the here-doc content to the heredoc buffer. foreach my $line ( $Token->heredoc ) { $heredoc .= $line; } if ( $Token->{_damaged} ) { # Special Case: # There are a couple of warning/bug situations # that can occur when a HereDoc content was read in # from the end of a file that we silently allow. # # When writing back out to the file we have to # auto-repair these problems if we aren't going back # on to the end of the file. # When calculating $last_line, ignore the final token if # and only if it has a single newline at the end. my $last_index = $#tokens; if ( $tokens[$last_index]->{content} =~ /^[^\n]*\n$/ ) { $last_index--; } # This is a two part test. # First, are we on the last line of the # content part of the file my $last_line = List::Util::none { $tokens[$_] and $tokens[$_]->{content} =~ /\n/ } (($i + 1) .. $last_index); if ( ! defined $last_line ) { # Handles the null list case $last_line = 1; } # Secondly, are their any more here-docs after us, # (with content or a terminator) my $any_after = List::Util::any { $tokens[$_]->isa('PPI::Token::HereDoc') and ( scalar(@{$tokens[$_]->{_heredoc}}) or defined $tokens[$_]->{_terminator_line} ) } (($i + 1) .. $#tokens); if ( ! defined $any_after ) { # Handles the null list case $any_after = ''; } # We don't need to repair the last here-doc on the # last line. But we do need to repair anything else. unless ( $last_line and ! $any_after ) { # Add a terminating string if it didn't have one unless ( defined $Token->{_terminator_line} ) { $Token->{_terminator_line} = $Token->{_terminator}; } # Add a trailing newline to the terminating # string if it didn't have one. unless ( $Token->{_terminator_line} =~ /\n$/ ) { $Token->{_terminator_line} .= "\n"; } } } # Now add the termination line to the heredoc buffer if ( defined $Token->{_terminator_line} ) { $heredoc .= $Token->{_terminator_line}; } } # End of tokens if ( $heredoc ne '' ) { # If the file doesn't end in a newline, we need to add one # so that the here-doc content starts on the next line. unless ( $output =~ /\n$/ ) { $output .= "\n"; } # Now we add the remaining here-doc content # to the end of the file. $output .= $heredoc; } $output; } =pod =head2 hex_id The C method generates an unique identifier for the Perl document. This identifier is basically just the serialized document, with Unix-specific newlines, passed through MD5 to produce a hexadecimal string. This identifier is used by a variety of systems (such as L and L) as a unique key against which to store or cache information about a document (or indeed, to cache the document itself). Returns a 32 character hexadecimal string. =cut sub hex_id { PPI::Util::md5hex($_[0]->serialize); } =pod =head2 index_locations Within a document, all L objects can be considered to have a "location", a line/column position within the document when considered as a file. This position is primarily useful for debugging type activities. The method for finding the position of a single Element is a bit laborious, and very slow if you need to do it a lot. So the C method will index and save the locations of every Element within the Document in advance, making future calls to virtually free. Please note that this index should always be cleared using C once you are finished with the locations. If content is added to or removed from the file, these indexed locations will be B. =cut sub index_locations { my $self = shift; my @tokens = $self->tokens; # Whenever we hit a heredoc we will need to increment by # the number of lines in its content section when we # encounter the next token with a newline in it. my $heredoc = 0; # Find the first Token without a location my ($first, $location) = (); foreach ( 0 .. $#tokens ) { my $Token = $tokens[$_]; next if $Token->{_location}; # Found the first Token without a location # Calculate the new location if needed. if ($_) { $location = $self->_add_location( $location, $tokens[$_ - 1], \$heredoc ); } else { my $logical_file = $self->can('filename') ? $self->filename : undef; $location = [ 1, 1, 1, 1, $logical_file ]; } $first = $_; last; } # Calculate locations for the rest if ( defined $first ) { foreach ( $first .. $#tokens ) { my $Token = $tokens[$_]; $Token->{_location} = $location; $location = $self->_add_location( $location, $Token, \$heredoc ); # Add any here-doc lines to the counter if ( $Token->isa('PPI::Token::HereDoc') ) { $heredoc += $Token->heredoc + 1; } } } 1; } sub _add_location { my ($self, $start, $Token, $heredoc) = @_; my $content = $Token->{content}; # Does the content contain any newlines my $newlines =()= $content =~ /\n/g; my ($logical_line, $logical_file) = $self->_logical_line_and_file($start, $Token, $newlines); unless ( $newlines ) { # Handle the simple case return [ $start->[LOCATION_LINE], $start->[LOCATION_CHARACTER] + length($content), $start->[LOCATION_COLUMN] + $self->_visual_length( $content, $start->[LOCATION_COLUMN] ), $logical_line, $logical_file, ]; } # This is the more complex case where we hit or # span a newline boundary. my $physical_line = $start->[LOCATION_LINE] + $newlines; my $location = [ $physical_line, 1, 1, $logical_line, $logical_file ]; if ( $heredoc and $$heredoc ) { $location->[LOCATION_LINE] += $$heredoc; $location->[LOCATION_LOGICAL_LINE] += $$heredoc; $$heredoc = 0; } # Does the token have additional characters # after their last newline. if ( $content =~ /\n([^\n]+?)\z/ ) { $location->[LOCATION_CHARACTER] += length($1); $location->[LOCATION_COLUMN] += $self->_visual_length( $1, $location->[LOCATION_COLUMN], ); } $location; } sub _logical_line_and_file { my ($self, $start, $Token, $newlines) = @_; # Regex taken from perlsyn, with the correction that there's no space # required between the line number and the file name. if ($start->[LOCATION_CHARACTER] == 1) { if ( $Token->isa('PPI::Token::Comment') ) { if ( $Token->content =~ m< \A \# \s* line \s+ (\d+) \s* (?: (\"?) ([^\"]* [^\s\"]) \2 )? \s* \z >xms ) { return $1, ($3 || $start->[LOCATION_LOGICAL_FILE]); } } elsif ( $Token->isa('PPI::Token::Pod') ) { my $content = $Token->content; my $line; my $file = $start->[LOCATION_LOGICAL_FILE]; my $end_of_directive; while ( $content =~ m< ^ \# \s*? line \s+? (\d+) (?: (?! \n) \s)* (?: (\"?) ([^\"]*? [^\s\"]) \2 )?? \s*? $ >xmsg ) { ($line, $file) = ($1, ( $3 || $file ) ); $end_of_directive = pos $content; } if (defined $line) { pos $content = $end_of_directive; my $post_directive_newlines =()= $content =~ m< \G [^\n]* \n >xmsg; return $line + $post_directive_newlines - 1, $file; } } } return $start->[LOCATION_LOGICAL_LINE] + $newlines, $start->[LOCATION_LOGICAL_FILE]; } sub _visual_length { my ($self, $content, $pos) = @_; my $tab_width = $self->tab_width; my ($length, $vis_inc); return length $content if $content !~ /\t/; # Split the content in tab and non-tab parts and calculate the # "visual increase" of each part. for my $part ( split(/(\t)/, $content) ) { if ($part eq "\t") { $vis_inc = $tab_width - ($pos-1) % $tab_width; } else { $vis_inc = length $part; } $length += $vis_inc; $pos += $vis_inc; } $length; } =pod =head2 flush_locations When no longer needed, the C method clears all location data from the tokens. =cut sub flush_locations { shift->_flush_locations(@_); } =pod =head2 normalized The C method is used to generate a "Layer 1" L object for the current Document. A "normalized" Perl Document is an arbitrary structure that removes any irrelevant parts of the document and refactors out variations in style, to attempt to approach something that is closer to the "true meaning" of the Document. See L for more information on document normalization and the tasks for which it is useful. Returns a L object, or C on error. =cut sub normalized { # The normalization process will utterly destroy and mangle # anything passed to it, so we are going to only give it a # clone of ourselves. PPI::Normal->process( $_[0]->clone ); } =pod =head1 complete The C method is used to determine if a document is cleanly structured, all braces are closed, the final statement is fully terminated and all heredocs are fully entered. Returns true if the document is complete or false if not. =cut sub complete { my $self = shift; # Every structure has to be complete $self->find_any( sub { $_[1]->isa('PPI::Structure') and ! $_[1]->complete } ) and return ''; # Strip anything that isn't a statement off the end my @child = $self->children; while ( @child and not $child[-1]->isa('PPI::Statement') ) { pop @child; } # We must have at least one statement return '' unless @child; # Check the completeness of the last statement return $child[-1]->_complete; } ##################################################################### # PPI::Node Methods # We are a scope boundary ### XS -> PPI/XS.xs:_PPI_Document__scope 0.903+ sub scope() { 1 } ##################################################################### # PPI::Element Methods sub insert_before { return undef; # die "Cannot insert_before a PPI::Document"; } sub insert_after { return undef; # die "Cannot insert_after a PPI::Document"; } sub replace { return undef; # die "Cannot replace a PPI::Document"; } ##################################################################### # Error Handling # Set the error message sub _error { $errstr = $_[1]; undef; } # Clear the error message. # Returns the object as a convenience. sub _clear { $errstr = ''; $_[0]; } =pod =head2 errstr For error that occur when loading and saving documents, you can use C, as either a static or object method, to access the error message. If a Document loads or saves without error, C will return false. =cut sub errstr { $errstr; } ##################################################################### # Native Storable Support sub STORABLE_freeze { my $self = shift; my $class = ref $self; my %hash = %$self; return ($class, \%hash); } sub STORABLE_thaw { my ($self, undef, $class, $hash) = @_; bless $self, $class; foreach ( keys %$hash ) { $self->{$_} = delete $hash->{$_}; } $self->__link_children; } 1; =pod =head1 TO DO - May need to overload some methods to forcefully prevent Document objects becoming children of another Node. =head1 SUPPORT See the L in the main module. =head1 AUTHOR Adam Kennedy Eadamk@cpan.orgE =head1 SEE ALSO L, L =head1 COPYRIGHT Copyright 2001 - 2011 Adam Kennedy. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with this module. =cut ppi_token_magic.t100644000000000000 311113511127601 16334 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token::Magic use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 38 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; __TOKENIZER_ON_CHAR: { my $document = PPI::Document->new(\<<'END_PERL'); $[; # Magic $[ $$; # Magic $$ %-; # Magic %- $#-; # Magic $#- $$foo; # Symbol $foo Dereference of $foo $^W; # Magic $^W $^WIDE_SYSTEM_CALLS; # Magic $^WIDE_SYSTEM_CALLS ${^MATCH}; # Magic ${^MATCH} @{^_Bar}; # Magic @{^_Bar} ${^_Bar}[0]; # Magic @{^_Bar} %{^_Baz}; # Magic %{^_Baz} ${^_Baz}{burfle}; # Magic %{^_Baz} $${^MATCH}; # Magic ${^MATCH} Dereference of ${^MATCH} \${^MATCH}; # Magic ${^MATCH} $0; # Magic $0 -- program being executed $0x2; # Magic $0 -- program being executed $10; # Magic $10 -- capture variable $1100; # Magic $1100 -- capture variable END_PERL isa_ok( $document, 'PPI::Document' ); $document->index_locations(); my $symbols = $document->find( 'PPI::Token::Symbol' ); is( scalar(@$symbols), 18, 'Found the correct number of symbols' ); my $comments = $document->find( 'PPI::Token::Comment' ); foreach my $token ( @$symbols ) { my ($hash, $class, $name, $remk) = split /\s+/, $comments->[$token->line_number - 1], 4; isa_ok( $token, "PPI::Token::$class" ); is( $token->symbol, $name, $remk || "The symbol is $name" ); } } ppi_token_quote.t100644000000000000 126413511127601 16420 0ustar00unknownunknown000000000000PPI-1.270/t#!/usr/bin/perl # Unit testing for PPI::Token::Quote use lib 't/lib'; use PPI::Test::pragmas; use Test::More tests => 15 + ($ENV{AUTHOR_TESTING} ? 1 : 0); use PPI; STRING: { # Prove what we say in the ->string docs my $Document = PPI::Document->new(\<<'END_PERL'); 'foo' "foo" q{foo} qq END_PERL isa_ok( $Document, 'PPI::Document' ); my $quotes = $Document->find('Token::Quote'); is( ref($quotes), 'ARRAY', 'Found quotes' ); is( scalar(@$quotes), 4, 'Found 4 quotes' ); foreach my $Quote ( @$quotes ) { isa_ok( $Quote, 'PPI::Token::Quote'); can_ok( $Quote, 'string' ); is( $Quote->string, 'foo', '->string returns "foo" for ' . $Quote->content ); } } Exception.pm100644000000000000 371613511127601 16261 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Exception; =head1 NAME PPI::Exception - The PPI exception base class =head1 SYNOPSIS use PPI::Exception; my $e = PPI::Exception->new( 'something happened' ); $e->throw; PPI::Exception->new( message => 'something happened' )->throw; PPI::Exception->throw( message => 'something happened' ); =head1 DESCRIPTION All exceptions thrown from within PPI will be instances or derivations of this class. =cut use strict; use Params::Util qw{_INSTANCE}; our $VERSION = '1.270'; # VERSION =head1 METHODS =head2 new $message | message => $message, ... Constructs and returns a new C object. A message for the exception can be passed, either as a string or as C<< message => $message >>. The message is available via the C method. =cut sub new { my $class = shift; return bless { @_ }, $class if @_ > 1; return bless { message => $_[0] }, $class if @_; return bless { message => 'Unknown Exception' }, $class; } =head2 throw If called on a C object, throws the object. If called on the class name, uses the arguments to construct a C and then throw it. Each time the object is thrown, information from the Perl call is saved and made available via the C method. This method never returns. =cut sub throw { my $it = shift; if ( _INSTANCE($it, 'PPI::Exception') ) { if ( $it->{callers} ) { push @{ $it->{callers} }, [ caller(0) ]; } else { $it->{callers} ||= []; } } else { my $message = $_[0] || 'Unknown Exception'; $it = $it->new( message => $message, callers => [ [ caller(0) ], ], ); } die $it; } =head2 message Returns the exception message passed to the object's constructor, or a default message. =cut sub message { $_[0]->{message}; } =head2 callers Returns a listref, each element of which is a listref of C information. The returned listref can be empty. =cut sub callers { @{ $_[0]->{callers} || [] }; } 1; Statement.pm100644000000000000 2152213511127601 16302 0ustar00unknownunknown000000000000PPI-1.270/lib/PPIpackage PPI::Statement; =pod =head1 NAME PPI::Statement - The base class for Perl statements =head1 INHERITANCE PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION PPI::Statement is the root class for all Perl statements. This includes (from L) "Declarations", "Simple Statements" and "Compound Statements". The class PPI::Statement itself represents a "Simple Statement" as defined in the L manpage. =head1 STATEMENT CLASSES Please note that unless documented themselves, these classes are yet to be frozen/finalised. Names may change slightly or be added or removed. =head2 L This covers all "scheduled" blocks, chunks of code that are executed separately from the main body of the code, at a particular time. This includes all C, C, C, C and C blocks. =head2 L A package declaration, as defined in L. =head2 L A statement that loads or unloads another module. This includes 'use', 'no', and 'require' statements. =head2 L A named subroutine declaration, or forward declaration =head2 L A variable declaration statement. This could be either a straight declaration or also be an expression. This includes all 'my', 'state', 'local' and 'our' statements. =head2 L This covers the whole family of 'compound' statements, as described in L. This includes all statements starting with 'if', 'unless', 'for', 'foreach' and 'while'. Note that this does NOT include 'do', as it is treated differently. All compound statements have implicit ends. That is, they do not end with a ';' statement terminator. =head2 L A statement that breaks out of a structure. This includes all of 'redo', 'goto', 'next', 'last' and 'return' statements. =head2 L The kind of statement introduced in Perl 5.10 that starts with 'given'. This has an implicit end. =head2 L The kind of statement introduced in Perl 5.10 that starts with 'when' or 'default'. This also has an implicit end. =head2 L A special statement which encompasses an entire C<__DATA__> block, including the initial C<'__DATA__'> token itself and the entire contents. =head2 L A special statement which encompasses an entire __END__ block, including the initial '__END__' token itself and the entire contents, including any parsed PPI::Token::POD that may occur in it. =head2 L L is a little more speculative, and is intended to help represent the special rules relating to "expressions" such as in: # Several examples of expression statements # Boolean conditions if ( expression ) { ... } # Lists, such as for arguments Foo->bar( expression ) =head2 L A null statement is a special case for where we encounter two consecutive statement terminators. ( ;; ) The second terminator is given an entire statement of its own, but one that serves no purpose. Hence a 'null' statement. Theoretically, assuming a correct parsing of a perl file, all null statements are superfluous and should be able to be removed without damage to the file. But don't do that, in case PPI has parsed something wrong. =head2 L Because L is intended for use when parsing incorrect or incomplete code, the problem arises of what to do with a stray closing brace. Rather than die, it is allocated its own "unmatched brace" statement, which really means "unmatched closing brace". An unmatched open brace at the end of a file would become a structure with no contents and no closing brace. If the document loaded is intended to be correct and valid, finding a L in the PDOM is generally indicative of a misparse. =head2 L This is used temporarily mid-parsing to hold statements for which the lexer cannot yet determine what class it should be, usually because there are insufficient clues, or it might be more than one thing. You should never encounter these in a fully parsed PDOM tree. =head1 METHODS C itself has very few methods. Most of the time, you will be working with the more generic L or L methods, or one of the methods that are subclass-specific. =cut use strict; use Scalar::Util (); use Params::Util qw{_INSTANCE}; use PPI::Node (); use PPI::Exception (); use PPI::Singletons '%_PARENT'; our $VERSION = '1.270'; # VERSION our @ISA = "PPI::Node"; use PPI::Statement::Break (); use PPI::Statement::Compound (); use PPI::Statement::Data (); use PPI::Statement::End (); use PPI::Statement::Expression (); use PPI::Statement::Include (); use PPI::Statement::Null (); use PPI::Statement::Package (); use PPI::Statement::Scheduled (); use PPI::Statement::Sub (); use PPI::Statement::Given (); use PPI::Statement::UnmatchedBrace (); use PPI::Statement::Unknown (); use PPI::Statement::Variable (); use PPI::Statement::When (); # "Normal" statements end at a statement terminator ; # Some are not, and need the more rigorous _continues to see # if we are at an implicit statement boundary. sub __LEXER__normal() { 1 } ##################################################################### # Constructor sub new { my $class = shift; if ( ref $class ) { PPI::Exception->throw; } # Create the object my $self = bless { children => [], }, $class; # If we have been passed what should be an initial token, add it my $token = shift; if ( _INSTANCE($token, 'PPI::Token') ) { # Inlined $self->__add_element(shift); Scalar::Util::weaken( $_PARENT{Scalar::Util::refaddr $token} = $self ); push @{$self->{children}}, $token; } $self; } =pod =head2 label One factor common to most statements is their ability to be labeled. The C