PPI-1.281/0000775060175106017510000000000014733536547012316 5ustar MithalduMithalduPPI-1.281/Changes0000755060175106017510000015644014733536547013624 0ustar MithalduMithalduRevision history for Perl extension PPI 1.281 2024-12-27 14:44:47Z Summary: - Implement support for signatures and other parsing features Details: - Framework for recognition of parsing feature activation via: - `use $PERL_VERSION` in code - `use feature` in code - `use $Common::CPAN::Module` in code - PPI::Document->new( feature_mods => ... ) - PPI::Document->new( custom_feature_includes => ... ) - PPI::Document->new( custom_feature_include_cb => ... ) - $ENV{PPI_CUSTOM_FEATURE_INCLUDES} - Added ability to parse features: - signatures, as PPI::Structure::Signature - try catch, as PPI::Statement::Compound 1.279 2024-08-23 14:02:44Z Summary: - Implemented a cache to speed up sibling iteration (GH#287) (Graham Knop (haarg)) 1.278 2024-03-11 02:20:06Z - Add support for new octal number syntax (GH#295) (Branislav Branislav Zahradník) 1.277 2023-09-22 09:12:48Z Summary: - Parse prototypes as literal quotes, enables parens and newlines in protos - Fix false positive detection of labels (GH#289) (Dan Church) Details: - Wrapped most Document->new calls in tests with automatic checks 1.276 2022-07-19 21:43:50Z Summary: - Implement Replace Method (GH#274) (Renee and Olaf Alders) 1.275 2022-07-18 19:42:13Z Summary: - CHECK bareword handle parsed as scheduled block (GH#247) (trwyant) 1.274 2022-05-02 18:21:56Z Summary: - Indentation in here-docs is now preserved (GH#252) (trwyant) 1.273 2022-04-22 15:58:31Z Summary: - Whitespace in signatures is now preserved (GH#257) 1.272 2022-02-02 16:10:50Z Summary: - Drop prerequisite for IO::String on perl 5.8+ 1.271 2022-01-25 21:47:21Z Summary: - return correct name for lexical subroutines - silence uninitialized warning in t/07_token.t - bump minimum Test::More version to 0.96 - fix some typos in Pod - moved repository to Perl-Critic GitHub org: https://github.com/Perl-Critic/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 PPI-1.281/cpanfile0000744060175106017510000000427314733536547014027 0ustar MithalduMithaldu# This file is generated by Dist::Zilla::Plugin::CPANFile v6.030 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Clone" => "0.30"; requires "Digest::MD5" => "2.35"; requires "Exporter" => "0"; requires "File::Path" => "0"; requires "File::Spec" => "0"; requires "List::Util" => "1.33"; requires "Params::Util" => "1.00"; requires "Safe::Isa" => "0"; requires "Scalar::Util" => "0"; requires "Storable" => "2.17"; requires "Task::Weaken" => "0"; requires "YAML::PP" => "0"; requires "constant" => "0"; requires "if" => "0"; requires "overload" => "0"; requires "perl" => "5.006"; requires "strict" => "0"; requires "version" => "0.77"; on 'test' => sub { requires "B" => "0"; requires "Class::Inspector" => "1.22"; requires "Encode" => "0"; requires "ExtUtils::MakeMaker" => "0"; requires "File::Copy" => "0"; requires "File::Spec" => "0"; requires "File::Spec::Functions" => "0"; requires "File::Temp" => "0"; requires "Test::More" => "0.96"; requires "Test::NoWarnings" => "0"; requires "Test::Object" => "0.07"; requires "Test::SubCalls" => "1.07"; requires "lib" => "0"; requires "parent" => "0"; requires "utf8" => "0"; requires "warnings" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'develop' => sub { requires "Devel::Confess" => "0"; requires "Encode" => "0"; requires "File::Spec" => "0"; requires "IO::All" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "MetaCPAN::Client" => "0"; requires "Test2::V0" => "0"; requires "Test::CPAN::Meta" => "0"; requires "Test::ClassAPI" => "0"; requires "Test::DependentModules" => "0"; requires "Test::Kwalitee" => "1.21"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.94"; requires "Test::Pod" => "1.41"; requires "Test::Pod::No404s" => "0"; requires "Test::Portability::Files" => "0"; requires "lib" => "0"; requires "perl" => "5.010"; requires "strictures" => "2"; requires "warnings" => "0"; }; on 'develop' => sub { recommends "Dist::Zilla::PluginBundle::Git::VersionManager" => "0.007"; }; PPI-1.281/dev_notes.txt0000744060175106017510000000236014733536547015045 0ustar MithalduMithalduprove -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 PPI-1.281/dist.ini0000755060175106017510000000477314733536547013776 0ustar MithalduMithalduname = PPI author = Adam Kennedy license = Perl_5 copyright_holder = Adam Kennedy copyright_year = 2002 [MetaResources] homepage = https://github.com/Perl-Critic/PPI bugtracker = https://github.com/Perl-Critic/PPI/issues repository = https://github.com/Perl-Critic/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 [Prereqs / TestRequires] Test::More = 0.96 [DynamicPrereqs] -body = requires('File::Spec', is_os('MSWin32') ? '3.2701' : '0.84'); -body = requires('IO::String') if $] < '5.008000'; [Git::GatherDir] exclude_filename = README.pod [MetaYAML] [MetaJSON] [Readme] [Manifest] [License] [MakeMaker] [CPANFile] [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 release_branch = trial [CheckPrereqsIndexed] :version = 0.019 [TestRelease] [Git::Check / after tests] [UploadToCPAN] ; The distribution version is calculated from the last git tag. ; To override, use V= dzil ... [@Git::VersionManager] RewriteVersion::Transitional.fallback_version_provider = Git::NextVersion NextRelease.format = %-6v %{yyyy-MM-dd HH:mm:ss'Z'}d%{ (TRIAL RELEASE)}T release snapshot.:version = 2.046 release snapshot.add_files_in = . release snapshot.commit_msg = %N-%v%t%n%n%c Git::Tag.tag_format = v%v Git::Tag.tag_message = v%v%t [ReadmeAnyFromPod] :version = 0.142180 type = pod location = root phase = release [Git::Push] ; listed late, to allow all other plugins which do BeforeRelease checks to run first. [ConfirmRelease] PPI-1.281/lib/0000775060175106017510000000000014733536547013064 5ustar MithalduMithalduPPI-1.281/lib/PPI/0000775060175106017510000000000014733536547013514 5ustar MithalduMithalduPPI-1.281/lib/PPI/Cache.pm0000755060175106017510000001421414733536547015060 0ustar MithalduMithaldupackage 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.281'; 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 PPI-1.281/lib/PPI/Document/0000775060175106017510000000000014733536547015272 5ustar MithalduMithalduPPI-1.281/lib/PPI/Document/File.pm0000755060175106017510000000565314733536547016521 0ustar MithalduMithaldupackage PPI::Document::File; =pod =head1 NAME PPI::Document::File - A Perl Document located in a specific file =head1 DESCRIPTION B B provides a L subclass that represents a Perl document stored in a specific named file. =head1 METHODS =cut use strict; use Carp (); use Params::Util qw{_STRING _INSTANCE}; use PPI::Document (); our $VERSION = '1.281'; our @ISA = 'PPI::Document'; ##################################################################### # Constructor and Accessors =pod =head2 new my $file = PPI::Document::File->new( 'Module.pm' ); The C constructor works the same as for the regular one, except that the only params allowed is a file name. You cannot create an "anonymous" PPI::Document::File object, not can you create an empty one. Returns a new PPI::Document::File object, or C on error. =cut sub new { my $class = shift; my $filename = _STRING(shift); unless ( defined $filename ) { # Perl::Critic got a complaint about not handling a file # named "0". return $class->_error("Did not provide a file name to load"); } # Load the Document my $self = $class->SUPER::new( $filename, @_ ) or return undef; # Unlike a normal inheritance situation, due to our need to stay # compatible with caching magic, this actually returns a regular # anonymous document. We need to rebless if if ( _INSTANCE($self, 'PPI::Document') ) { bless $self, 'PPI::Document::File'; } else { die "PPI::Document::File SUPER call returned an object of the wrong type"; } $self; } =pod =head2 save # Save to the file we were loaded from $file->save; # Save a copy to somewhere else $file->save( 'Module2.pm' ); The C method works similarly to the one in the parent L class, saving a copy of the document to a file. The difference with this subclass is that if C is not passed any filename, it will save it back to the file it was loaded from. Note: When saving to a different file, it is considered to be saving a B and so the value returned by the C accessor will stay the same, and not change to the new filename. =cut sub save { my $self = shift; # Save to where? my $filename = shift; unless ( defined $filename ) { $filename = $self->filename; } # Hand off to main save method $self->SUPER::save( $filename, @_ ); } 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 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-1.281/lib/PPI/Document/Fragment.pm0000755060175106017510000000356114733536547017401 0ustar MithalduMithaldupackage PPI::Document::Fragment; =pod =head1 NAME PPI::Document::Fragment - A fragment of a Perl Document =head1 DESCRIPTION In some situations you might want to work with a fragment of a larger document. C is a class intended for this purpose. It is functionally almost identical to a normal L, except that it is not possible to get line/column positions for the elements within it, and it does not represent a scope. =head1 METHODS =cut use strict; use PPI::Document (); our $VERSION = '1.281'; our @ISA = 'PPI::Document'; ##################################################################### # PPI::Document Methods =pod =head2 index_locations Unlike when called on a PPI::Document object, you should not be attempting to find locations of things within a PPI::Document::Fragment, and thus any call to the C will print a warning and return C instead of attempting to index the locations of the Elements. =cut # There's no point indexing a fragment sub index_locations { warn "Useless attempt to index the locations of a document fragment"; undef; } ##################################################################### # PPI::Element Methods # We are not a scope boundary ### XS -> PPI/XS.xs:_PPI_Document_Fragment__scope 0.903+ sub scope() { '' } 1; =pod =head1 TO DO Integrate this into the rest of PPI so it has actual practical uses. The most obvious would be to implement arbitrary cut/copy/paste more easily. =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 PPI-1.281/lib/PPI/Document/Normalized.pm0000755060175106017510000001716514733536547017747 0ustar MithalduMithaldupackage PPI::Document::Normalized; =pod =head1 NAME PPI::Document::Normalized - A normalized Perl Document =head1 DESCRIPTION A C object is the result of the normalization process contained in the L class. See the documentation for L for more information. The object contains a version stamp and function list for the version of L used to create it, and a processed and delinked L object. Typically, the Document object will have been mangled by the normalization process in a way that would make it fatal to try to actually DO anything with it. Put simply, B use the Document object after normalization. B The object is designed the way it is to provide a bias towards false negatives. A comparison between two ::Normalized object will only return true if they were produced by the same version of PPI::Normal, with the same set of normalization functions (in the same order). You may get false negatives if you are caching objects across an upgrade. Please note that this is done for security purposes, as there are many cases in which low layer normalization is likely to be done as part of a code security process, and false positives could be highly dangerous. =head1 METHODS =cut # For convenience (and since this isn't really a public class), import # the methods we will need from Scalar::Util. use strict; use Scalar::Util qw{refaddr reftype blessed}; use Params::Util qw{_INSTANCE _ARRAY}; use PPI::Util (); our $VERSION = '1.281'; use overload 'bool' => \&PPI::Util::TRUE; use overload '==' => 'equal'; ##################################################################### # Constructor and Accessors =pod =head2 new The C method is intended for use only by the L class, and to get ::Normalized objects, you are highly recommended to use either that module, or the C method of the L object itself. =cut sub new { my $class = shift; my %args = @_; # Check the required params my $Document = _INSTANCE($args{Document}, 'PPI::Document') or return undef; my $version = $args{version}; my $functions = _ARRAY($args{functions}) or return undef; # Create the object my $self = bless { Document => $Document, version => $version, functions => $functions, }, $class; $self; } sub _Document { $_[0]->{Document} } =pod =head2 version The C accessor returns the L version used to create the object. =cut sub version { $_[0]->{version} } =pod =head2 functions The C accessor returns a reference to an array of the normalization functions (in order) that were called when creating the object. =cut sub functions { $_[0]->{functions} } ##################################################################### # Comparison Methods =pod =head2 equal $Normalized The C method is the primary comparison method, taking another PPI::Document::Normalized object, and checking for equivalence to it. The C<==> operator is also overload to this method, so that you can do something like the following: my $first = PPI::Document->load('first.pl'); my $second = PPI::Document->load('second.pl'); if ( $first->normalized == $second->normalized ) { print "The two documents are equivalent"; } Returns true if the normalized documents are equivalent, false if not, or C if there is an error. =cut sub equal { my $self = shift; my $other = _INSTANCE(shift, 'PPI::Document::Normalized') or return undef; # Prevent multiple concurrent runs return undef if $self->{processing}; # Check the version and function list first my $v1 = $self->version || "undef"; my $v2 = $other->version || "undef"; return '' if $v1 ne $v2; $self->_equal_ARRAY( $self->functions, $other->functions ) or return ''; # Do the main comparison run $self->{seen} = {}; my $rv = $self->_equal_blessed( $self->_Document, $other->_Document ); delete $self->{seen}; $rv; } # Check that two objects are matched sub _equal_blessed { my ($self, $this, $that) = @_; my ($bthis, $bthat) = (blessed $this, blessed $that); $bthis and $bthat and $bthis eq $bthat or return ''; # Check the object as a reference $self->_equal_reference( $this, $that ); } # Check that two references match their types sub _equal_reference { my ($self, $this, $that) = @_; my ($rthis, $rthat) = (refaddr $this, refaddr $that); $rthis and $rthat or return undef; # If we have seen this before, are the pointing # is it the same one we saw in both sides my $seen = $self->{seen}->{$rthis}; if ( $seen and $seen ne $rthat ) { return ''; } # Check the reference types my ($tthis, $tthat) = (reftype $this, reftype $that); $tthis and $tthat and $tthis eq $tthat or return undef; # Check the children of the reference type $self->{seen}->{$rthis} = $rthat; my $method = "_equal_$tthat"; my $rv = $self->$method( $this, $that ); delete $self->{seen}->{$rthis}; $rv; } # Compare the children of two SCALAR references sub _equal_SCALAR { my ($self, $this, $that) = @_; my ($cthis, $cthat) = ($$this, $$that); return $self->_equal_blessed( $cthis, $cthat ) if blessed $cthis; return $self->_equal_reference( $cthis, $cthat ) if ref $cthis; return (defined $cthat and $cthis eq $cthat) if defined $cthis; ! defined $cthat; } # For completeness sake, lets just treat REF as a specialist SCALAR case sub _equal_REF { shift->_equal_SCALAR(@_) } # Compare the children of two ARRAY references sub _equal_ARRAY { my ($self, $this, $that) = @_; # Compare the number of elements scalar(@$this) == scalar(@$that) or return ''; # Check each element in the array. # Descend depth-first. foreach my $i ( 0 .. scalar(@$this) ) { my ($cthis, $cthat) = ($this->[$i], $that->[$i]); if ( blessed $cthis ) { return '' unless $self->_equal_blessed( $cthis, $cthat ); } elsif ( ref $cthis ) { return '' unless $self->_equal_reference( $cthis, $cthat ); } elsif ( defined $cthis ) { return '' unless (defined $cthat and $cthis eq $cthat); } else { return '' if defined $cthat; } } 1; } # Compare the children of a HASH reference sub _equal_HASH { my ($self, $this, $that) = @_; # Compare the number of keys return '' unless scalar(keys %$this) == scalar(keys %$that); # Compare each key, descending depth-first. foreach my $k ( keys %$this ) { return '' unless exists $that->{$k}; my ($cthis, $cthat) = ($this->{$k}, $that->{$k}); if ( blessed $cthis ) { return '' unless $self->_equal_blessed( $cthis, $cthat ); } elsif ( ref $cthis ) { return '' unless $self->_equal_reference( $cthis, $cthat ); } elsif ( defined $cthis ) { return '' unless (defined $cthat and $cthis eq $cthat); } else { return '' if defined $cthat; } } 1; } # We do not support GLOB comparisons sub _equal_GLOB { my ($self, $this, $that) = @_; warn('GLOB comparisons are not supported'); ''; } # We do not support CODE comparisons sub _equal_CODE { my ($self, $this, $that) = @_; refaddr $this == refaddr $that; } # We don't support IO comparisons sub _equal_IO { my ($self, $this, $that) = @_; warn('IO comparisons are not supported'); ''; } sub DESTROY { # Take the screw up Document with us if ( $_[0]->{Document} ) { $_[0]->{Document}->DESTROY; delete $_[0]->{Document}; } } 1; =pod =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 PPI-1.281/lib/PPI/Document.pm0000755060175106017510000006117614733536547015644 0ustar MithalduMithaldupackage 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 YAML::PP (); use overload 'bool' => \&PPI::Util::TRUE; use overload '""' => 'content'; our $VERSION = '1.281'; 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. Returns a C object, or C if parsing fails. L objects can also be thrown if there are parsing problems. The constructor also takes attribute flags. =head3 readonly 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. =head3 feature_mods Setting feature_mods with a hashref allows defining perl parsing features to be enabled for the whole document. (e.g. when the code is assumed to be run as a oneliner) =head3 custom_feature_includes custom_feature_includes => { strEct => { signatures => "Syntax::Keyword::Try" } } Setting custom_feature_includes with a hashref allows defining include names which act like pragmas that enable parsing features within their scope. This is mostly useful when your work project has its own boilerplate module. It can also be provided as JSON or YAML in the environment variable PPI_CUSTOM_FEATURE_INCLUDES, like so: PPI_CUSTOM_FEATURE_INCLUDES='strEct: {signatures: perl}' \ perlcritic lib/OurModule.pm PPI_CUSTOM_FEATURE_INCLUDES='{"strEct":{"signatures":"perl"}}' \ perlcritic lib/OurModule.pm =head3 custom_feature_include_cb custom_feature_include_cb => sub { my ($statement) = @_; return $statement->module eq "strEct" ? { signatures => "perl" } : (); }, Setting custom_feature_include_cb with a code reference causes all inspections on includes to call that sub before doing any other inspections. The sub can decide to either return a hashref of features to be enabled or disabled, which will be used for the scope the include was called in, or undef to continue with the default inspections. The argument to the sub will be the L object. This can be useful when your work project has a complex boilerplate module. =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, %attr ); if ( $document ) { # Save in the cache $CACHE->store_document( $document ); return $document; } } else { my $document = PPI::Lexer->lex_file( $source, %attr ); return $document if $document; } } elsif ( _SCALAR0($source) ) { my $document = PPI::Lexer->lex_source( $$source, %attr ); return $document if $document; } elsif ( _ARRAY0($source) ) { $source = join '', map { "$_\n" } @$source; my $document = PPI::Lexer->lex_source( $source, %attr ); return $document 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}; $document->{feature_mods} = $attr{feature_mods}; $document->{custom_feature_includes} = $attr{custom_feature_includes}; $document->{custom_feature_include_cb} = $attr{custom_feature_include_cb}; if ( $ENV{PPI_CUSTOM_FEATURE_INCLUDES} ) { my $includes = YAML::PP::Load $ENV{PPI_CUSTOM_FEATURE_INCLUDES}; die "\$ENV{PPI_CUSTOM_FEATURE_INCLUDES} " . "does not contain valid perl:\n" . "val: '$ENV{PPI_CUSTOM_FEATURE_INCLUDES}'\nerr: $@" if $@; $document->{custom_feature_includes} = { %{ $document->{custom_feature_includes} || {} }, %{$includes} }; } 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; } =head2 feature_mods { feature_name => $provider } =cut sub feature_mods { my $self = shift; return $self->{feature_mods} unless @_; $self->{feature_mods} = shift; } =head2 custom_feature_includes { module_name => { feature_name => $provider } } =cut sub custom_feature_includes { my $self = shift; return $self->{custom_feature_includes} unless @_; $self->{custom_feature_includes} = shift; } =head2 custom_feature_include_cb sub { ... } =cut sub custom_feature_include_cb { my $self = shift; return $self->{custom_feature_include_cb} unless @_; $self->{custom_feature_include_cb} = 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; # Pick up the indentation, which may be undef. my $indentation = $Token->indentation || ''; # Now add all of the here-doc content to the heredoc buffer. foreach my $line ( $Token->heredoc ) { $heredoc .= "\n" eq $line ? $line : $indentation . $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 .= $indentation . $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-1.281/lib/PPI/Dumper.pm0000755060175106017510000001544114733536547015314 0ustar MithalduMithaldupackage 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.281'; ##################################################################### # 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/Perl-Critic/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 PPI-1.281/lib/PPI/Element.pm0000755060175106017510000005516014733536547015453 0ustar MithalduMithaldupackage 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 PPI::Util (); use PPI::Node (); use PPI::Singletons '%_PARENT', '%_POSITION_CACHE'; our $VERSION = '1.281'; 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 $key = refaddr $self; my $parent = $_PARENT{$key} or return ''; my $elements = $parent->{children}; my $position = $parent->__position($self); $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 $key = refaddr $self; my $parent = $_PARENT{$key} or return ''; my $elements = $parent->{children}; my $position = $parent->__position($self); 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 $key = refaddr $self; my $parent = $_PARENT{$key} or return ''; my $elements = $parent->{children}; my $position = $parent->__position($self); $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 $key = refaddr $self; my $parent = $_PARENT{$key} or return ''; my $elements = $parent->{children}; my $position = $parent->__position($self); 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; } } } =head2 presumed_features Returns a hash that indicates which features appear to be active for the given element. =cut sub presumed_features { my ($self) = @_; my @feature_mods; my $walker = $self; while ($walker) { my $sib_walk = $walker; while ($sib_walk) { push @feature_mods, $sib_walk if $sib_walk->can("feature_mods"); $sib_walk = $sib_walk->sprevious_sibling; } $walker = $walker->parent; } my %feature_mods = map %{$_}, reverse grep defined, map $_->feature_mods, @feature_mods; return \%feature_mods; } ##################################################################### # 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. If successful, returns the replace element. Otherwise, returns C. =cut sub replace { my $self = ref $_[0] ? shift : return undef; my $replace = _INSTANCE(shift, ref $self) or return undef; return $self->parent->replace_child( $self, $replace ); } =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 ). sub DESTROY { delete $_PARENT{refaddr $_[0]}; delete $_POSITION_CACHE{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 PPI-1.281/lib/PPI/Exception/0000775060175106017510000000000014733536547015452 5ustar MithalduMithalduPPI-1.281/lib/PPI/Exception/ParserRejection.pm0000755060175106017510000000021014733536547021101 0ustar MithalduMithaldupackage PPI::Exception::ParserRejection; use strict; use PPI::Exception (); our $VERSION = '1.281'; our @ISA = 'PPI::Exception'; 1; PPI-1.281/lib/PPI/Exception.pm0000755060175106017510000000370414733536547016015 0ustar MithalduMithaldupackage 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.281'; =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; PPI-1.281/lib/PPI/Find.pm0000755060175106017510000002140214733536547014732 0ustar MithalduMithaldupackage 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.281'; ##################################################################### # 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 PPI-1.281/lib/PPI/Lexer.pm0000755060175106017510000012366414733536547015146 0ustar MithalduMithaldupackage 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.281'; 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. Additional arguments are passed to the tokenizer as a hash. 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"); } my %args = @_; # 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, %args ); } =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. Additional arguments are passed to the tokenizer as a hash. 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"); } my %args = @_; # 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, %args ); } =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. Additional arguments are set on the L produced. 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; my %args = @_; # Create the empty document my $Document = PPI::Document->new; ref($Document)->_setattr( $Document, %args ); $Tokenizer->_document($Document); # 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. $Tokenizer->_document(undef); 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, ( try => 'PPI::Statement::Compound' ) x !!( $Parent->schild(-1) || $Parent )->presumed_features->{try}, }->{ $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; } # Scheduled block must be followed by left curly or # semicolon. Otherwise we have something else (e.g. # open( CHECK, ... ); if ( 'PPI::Statement::Scheduled' eq $class and not ( $Next->isa( 'PPI::Token::Structure' ) and $Next->content =~ m/\A[{;]\z/ ) # } ) { $class = undef; last; } # 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 '{'; } if ( $type eq 'try' and $LastChild->presumed_features->{try} ) { return 1 if not $LastChild->isa('PPI::Structure::Block'); my $NextLast = $Statement->schild(-2); return '' if $NextLast and $NextLast->isa('PPI::Token') and $NextLast->isa('PPI::Token::Word') and $NextLast->content eq 'catch'; return 1 # if $Token->isa('PPI::Token::Word') and $Token->content eq 'catch'; return ''; } # 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'; } elsif ( $Parent->isa('PPI::Statement::Sub') ) { return 'PPI::Structure::Signature'; } # 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 PPI-1.281/lib/PPI/Node.pm0000755060175106017510000005057414733536547014753 0ustar MithalduMithaldupackage 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 Params::Util qw{_INSTANCE _CLASS _CODELIKE _NUMBER}; use PPI::Element (); use PPI::Singletons '%_PARENT', '%_POSITION_CACHE'; our $VERSION = '1.281'; 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 = $self->__position($child); return undef unless defined $p; # Splice it out, and remove the child's parent entry splice( @{$self->{children}}, $p, 1 ); delete $_PARENT{$key}; $child; } =head2 replace_child $Element, $Replacement If successful, returns the replace element. Otherwise, returns C. =cut sub replace_child { my $self = shift; my $child = _INSTANCE(shift, 'PPI::Element') or return undef; my $replacement = _INSTANCE(shift, 'PPI::Element') or return undef; my $success = $self->__replace_child( $child, $replacement ); return $success ? $replacement : undef; } =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. %$_ = (); } } $_[0]->SUPER::DESTROY; } sub __position { my ( $self, $child ) = @_; my $key = refaddr $child; return undef unless # my $elements = $self->{children}; if (defined (my $position = $_POSITION_CACHE{$key})) { my $maybe_child = $elements->[$position]; return $position if defined $maybe_child and refaddr $maybe_child == $key; } delete $_POSITION_CACHE{$key}; $_POSITION_CACHE{refaddr $elements->[$_]} = $_ for 0 .. $#{$elements}; return $_POSITION_CACHE{$key}; } # Insert one or more elements before a child sub __insert_before_child { my ( $self, $child, @insertions ) = @_; my $key = refaddr $child; my $p = $self->__position($child); foreach ( @insertions ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } splice( @{$self->{children}}, $p, 0, @insertions ); 1; } # Insert one or more elements after a child sub __insert_after_child { my ( $self, $child, @insertions ) = @_; my $key = refaddr $child; my $p = $self->__position($child); foreach ( @insertions ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } splice( @{$self->{children}}, $p + 1, 0, @insertions ); 1; } # Replace a child sub __replace_child { my ( $self, $old_child, @replacements ) = @_; my $old_child_addr = refaddr $old_child; # Cache parent of new children my $old_child_index = $self->__position($old_child); return undef if !defined $old_child_index; foreach ( @replacements ) { Scalar::Util::weaken( $_PARENT{refaddr $_} = $self ); } # Replace old child with new children splice( @{$self->{children}}, $old_child_index, 1, @replacements ); # Uncache parent of old child delete $_PARENT{$old_child_addr}; 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 PPI-1.281/lib/PPI/Normal/0000775060175106017510000000000014733536547014744 5ustar MithalduMithalduPPI-1.281/lib/PPI/Normal/Standard.pm0000755060175106017510000000615414733536547017051 0ustar MithalduMithaldupackage PPI::Normal::Standard; =pod =head1 NAME PPI::Normal::Standard - Provides standard document normalization functions =head1 DESCRIPTION This module provides the default normalization methods for L. There is no reason for you to need to load this yourself. B. =cut use strict; our $VERSION = '1.281'; ##################################################################### # Configuration and Registration my @METHODS = ( remove_insignificant_elements => 1, remove_useless_attributes => 1, remove_useless_pragma => 2, remove_statement_separator => 2, remove_useless_return => 2, ); sub import { PPI::Normal->register( map { /\D/ ? "PPI::Normal::Standard::$_" : $_ } @METHODS ) or die "Failed to register PPI::Normal::Standard transforms"; } ##################################################################### # Level 1 Transforms # Remove all insignificant elements sub remove_insignificant_elements { my $Document = shift; $Document->prune( sub { ! $_[1]->significant } ); } # Remove custom attributes that are not relevant to normalization sub remove_useless_attributes { my $Document = shift; delete $Document->{tab_width}; ### FIXME - Add support for more things } ##################################################################### # Level 2 Transforms # Remove version dependencies and pragma my $remove_pragma = map { $_ => 1 } qw{ strict warnings diagnostics less }; sub remove_useless_pragma { my $Document = shift; $Document->prune( sub { return '' unless $_[1]->isa('PPI::Statement::Include'); return 1 if $_[1]->version; return 1 if $remove_pragma->{$_[1]->pragma}; ''; } ); } # Remove all semi-colons at the end of statements sub remove_statement_separator { my $Document = shift; $Document->prune( sub { $_[1]->isa('PPI::Token::Structure') or return ''; $_[1]->content eq ';' or return ''; my $stmt = $_[1]->parent or return ''; $stmt->isa('PPI::Statement') or return ''; $_[1]->next_sibling and return ''; 1; } ); } # In any block, the "return" in the last statement is not # needed if there is only one and only one thing after the # return. sub remove_useless_return { my $Document = shift; $Document->prune( sub { $_[1]->isa('PPI::Token::Word') or return ''; $_[1]->content eq 'return' or return ''; my $stmt = $_[1]->parent or return ''; $stmt->isa('PPI::Statement::Break') or return ''; $stmt->children == 2 or return ''; $stmt->next_sibling and return ''; my $block = $stmt->parent or return ''; $block->isa('PPI::Structure::Block') or return ''; 1; } ); } 1; =pod =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 PPI-1.281/lib/PPI/Normal.pm0000755060175106017510000001432514733536547015310 0ustar MithalduMithaldupackage 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.281'; # 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 PPI-1.281/lib/PPI/Singletons.pm0000755060175106017510000000624614733536547016210 0ustar MithalduMithaldupackage PPI::Singletons; # exports some singleton variables to avoid aliasing magic use strict; use Exporter (); our $VERSION = '1.281'; our @ISA = 'Exporter'; our @EXPORT_OK = qw{ %_PARENT %_POSITION_CACHE %OPERATOR %MAGIC %LAYER $CURLY_SYMBOL %QUOTELIKE %KEYWORDS }; our %_PARENT; # Master Child -> Parent index our %_POSITION_CACHE; # cache for position in parent # operator index our %OPERATOR = map { $_ => 1 } ( qw{ -> ++ -- ** ! ~ + - =~ !~ * / % x . << >> < > <= >= lt gt le ge == != <=> eq ne cmp ~~ & | ^ && || // .. ... ? : = **= += -= .= *= /= %= x= &= |= ^= <<= >>= &&= ||= //= => <> <<>> and or xor not }, ',' # Avoids "comma in qw{}" warning ); # Magic variables taken from perlvar. # Several things added separately to avoid warnings. our %MAGIC = map { $_ => 1 } qw{ $1 $2 $3 $4 $5 $6 $7 $8 $9 $_ $& $` $' $+ @+ %+ $* $. $/ $| $\\ $" $; $% $= $- @- %- $) $~ $^ $: $? $! %! $@ $$ $< $> $( $0 $[ $] @_ @* $^L $^A $^E $^C $^D $^F $^H $^I $^M $^N $^O $^P $^R $^S $^T $^V $^W $^X %^H $::| }, '$}', '$,', '$#', '$#+', '$#-'; our %LAYER = ( 1 => [], 2 => [] ); # Registered function store our $CURLY_SYMBOL = qr{\G\^[[:upper:]_]\w+\}}; our %QUOTELIKE = ( 'q' => 'Quote::Literal', 'qq' => 'Quote::Interpolate', 'qx' => 'QuoteLike::Command', 'qw' => 'QuoteLike::Words', 'qr' => 'QuoteLike::Regexp', 'm' => 'Regexp::Match', 's' => 'Regexp::Substitute', 'tr' => 'Regexp::Transliterate', 'y' => 'Regexp::Transliterate', ); # List of keywords is from regen/keywords.pl in the perl source. our %KEYWORDS = map { $_ => 1 } qw{ abs accept alarm and atan2 bind binmode bless break caller chdir chmod chomp chop chown chr chroot close closedir cmp connect continue cos crypt dbmclose dbmopen default defined delete die do dump each else elsif endgrent endhostent endnetent endprotoent endpwent endservent eof eq eval evalbytes exec exists exit exp fc fcntl fileno flock for foreach fork format formline ge getc getgrent getgrgid getgrnam gethostbyaddr gethostbyname gethostent getlogin getnetbyaddr getnetbyname getnetent getpeername getpgrp getppid getpriority getprotobyname getprotobynumber getprotoent getpwent getpwnam getpwuid getservbyname getservbyport getservent getsockname getsockopt given glob gmtime goto grep gt hex if index int ioctl join keys kill last lc lcfirst le length link listen local localtime lock log lstat lt m map mkdir msgctl msgget msgrcv msgsnd my ne next no not oct open opendir or ord our pack package pipe pop pos print printf prototype push q qq qr quotemeta qw qx rand read readdir readline readlink readpipe recv redo ref rename require reset return reverse rewinddir rindex rmdir s say scalar seek seekdir select semctl semget semop send setgrent sethostent setnetent setpgrp setpriority setprotoent setpwent setservent setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep socket socketpair sort splice split sprintf sqrt srand stat state study sub substr symlink syscall sysopen sysread sysseek system syswrite tell telldir tie tied time times tr truncate uc ucfirst umask undef unless unlink unpack unshift untie until use utime values vec wait waitpid wantarray warn when while write x xor y }; 1; PPI-1.281/lib/PPI/Statement/0000775060175106017510000000000014733536547015460 5ustar MithalduMithalduPPI-1.281/lib/PPI/Statement/Break.pm0000755060175106017510000000260114733536547017042 0ustar MithalduMithaldupackage PPI::Statement::Break; =pod =head1 NAME PPI::Statement::Break - Statements which break out of normal statement flow =head1 SYNOPSIS last; goto FOO; next if condition(); return $foo; redo; =head1 INHERITANCE PPI::Statement::Break isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C is intended to represent statements that break out of the normal statement flow control. This covers the basic types C<'redo'>, C<'goto'>, C<'next'>, C<'last'> and C<'return'>. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. However, it is expected to gain methods for identifying the line to break to, or the structure to break out of. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; 1; =pod =head1 TO DO - Add the methods to identify the break target - Add some proper unit testing =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 PPI-1.281/lib/PPI/Statement/Compound.pm0000755060175106017510000001076414733536547017613 0ustar MithalduMithaldupackage PPI::Statement::Compound; =pod =head1 NAME PPI::Statement::Compound - Describes all compound statements =head1 SYNOPSIS # A compound if statement if ( foo ) { bar(); } else { baz(); } # A compound loop statement foreach ( @list ) { bar($_); } =head1 INHERITANCE PPI::Statement::Compound isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C objects are used to describe all current forms of compound statements, as described in L. This covers blocks using C, C, C, C, C, and C. Please note this does B cover "simple" statements with trailing conditions. Please note also that "do" is also not part of a compound statement. # This is NOT a compound statement my $foo = 1 if $condition; # This is also not a compound statement do { ... } until $condition; =head1 METHODS C has a number of methods in addition to the standard L, L and L methods. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Keyword type map my %TYPES = ( 'if' => 'if', 'unless' => 'if', 'while' => 'while', 'until' => 'while', 'for' => 'for', 'foreach' => 'foreach', ); # Lexer clues sub __LEXER__normal() { '' } ##################################################################### # PPI::Statement::Compound analysis methods =pod =head2 type The C method returns the syntactic type of the compound statement. There are four basic compound statement types. The C<'if'> type includes all variations of the if and unless statements, including any C<'elsif'> or C<'else'> parts of the compound statement. The C<'while'> type describes the standard while and until statements, but again does B describes simple statements with a trailing while. The C<'for'> type covers the C-style for loops, regardless of whether they were declared using C<'for'> or C<'foreach'>. The C<'foreach'> type covers loops that iterate over collections, regardless of whether they were declared using C<'for'> or C<'foreach'>. All of the compounds are a variation on one of these four. Returns the simple string C<'if'>, C<'for'>, C<'foreach'> or C<'while'>, or C if the type cannot be determined. =cut sub type { my $self = shift; my $p = 0; # Child position my $Element = $self->schild($p) or return undef; # A labelled statement if ( $Element->isa('PPI::Token::Label') ) { $Element = $self->schild(++$p) or return 'label'; } # Most simple cases my $content = $Element->content; if ( $content =~ /^for(?:each)?\z/ ) { $Element = $self->schild(++$p) or return $content; if ( $Element->isa('PPI::Token') ) { return 'foreach' if $Element->content =~ /^my|our|state\z/; return 'foreach' if $Element->isa('PPI::Token::Symbol'); return 'foreach' if $Element->isa('PPI::Token::QuoteLike::Words'); } if ( $Element->isa('PPI::Structure::List') ) { return 'foreach'; } return 'for'; } return { %TYPES, ( try => 'try' ) x !!$self->presumed_features->{try}, }->{$content} if $Element->isa('PPI::Token::Word'); return 'continue' if $Element->isa('PPI::Structure::Block'); # Unknown (shouldn't exist?) undef; } ##################################################################### # PPI::Node Methods sub scope() { 1 } ##################################################################### # PPI::Element Methods sub _complete { my $self = shift; my $type = $self->type or die "Illegal compound statement type"; # Check the different types of compound statements if ( $type eq 'if' ) { # Unless the last significant child is a complete # block, it must be incomplete. my $child = $self->schild(-1) or return ''; $child->isa('PPI::Structure') or return ''; $child->braces eq '{}' or return ''; $child->_complete or return ''; # It can STILL be } elsif ( $type eq 'while' ) { die "CODE INCOMPLETE"; } else { die "CODE INCOMPLETE"; } } 1; =pod =head1 TO DO - Write unit tests for this package =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 PPI-1.281/lib/PPI/Statement/Data.pm0000755060175106017510000000267714733536547016704 0ustar MithalduMithaldupackage PPI::Statement::Data; =pod =head1 NAME PPI::Statement::Data - The __DATA__ section of a file =head1 SYNOPSIS # Normal content __DATA__ This: data is: part of: the PPI::Statement::Data: object =head1 INHERITANCE PPI::Statement::Compound isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C is a utility class designed to hold content in the __DATA__ section of a file. It provides a single statement to hold B of the data. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. However, it is expected to gain methods for accessing the data directly, (as a filehandle for example) just as you would access the data in the Perl code itself. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Data is never complete sub _complete () { '' } 1; =pod =head1 TO DO - Add the methods to read in the data - Add some proper unit testing =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 PPI-1.281/lib/PPI/Statement/End.pm0000755060175106017510000000263014733536547016526 0ustar MithalduMithaldupackage PPI::Statement::End; =pod =head1 NAME PPI::Statement::End - Content after the __END__ of a module =head1 SYNOPSIS # This is normal content __END__ This is part of a PPI::Statement::End statement =pod This is not part of the ::End statement, it's POD =cut This is another PPI::Statement::End statement =head1 INHERITANCE PPI::Statement::End isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C is a utility class designed to serve as a contained for all of the content after the __END__ tag in a file. It doesn't cover the ENTIRE of the __END__ section, and can be interspersed with L tokens. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Once we have an __END__ we're done sub _complete () { 1 } 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 PPI-1.281/lib/PPI/Statement/Expression.pm0000755060175106017510000000234514733536547020162 0ustar MithalduMithaldupackage PPI::Statement::Expression; =pod =head1 NAME PPI::Statement::Expression - A generic and non-specialised statement =head1 SYNOPSIS $foo = bar; ("Hello World!"); do_this(); =head1 INHERITANCE PPI::Statement::Expression isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION A C is a normal statement that is evaluated, may or may not assign, may or may not have side effects, and has no special or redeeming features whatsoever. It provides a default for all statements that don't fit into any other classes. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; 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 PPI-1.281/lib/PPI/Statement/Given.pm0000755060175106017510000000257514733536547017100 0ustar MithalduMithaldupackage PPI::Statement::Given; =pod =head1 NAME PPI::Statement::Given - A given-when statement =head1 SYNOPSIS given ( foo ) { say $_; } =head1 INHERITANCE PPI::Statement::Given isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C objects are used to describe switch statements, as described in L. =head1 METHODS C has no methods beyond those provided by the standard L, L and L methods. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Lexer clues sub __LEXER__normal() { '' } sub _complete { my $child = $_[0]->schild(-1); return !! ( defined $child and $child->isa('PPI::Structure::Block') and $child->complete ); } ##################################################################### # PPI::Node Methods sub scope() { 1 } 1; =pod =head1 TO DO - Write unit tests for this package =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 PPI-1.281/lib/PPI/Statement/Include/0000775060175106017510000000000014733536547017043 5ustar MithalduMithalduPPI-1.281/lib/PPI/Statement/Include/Perl6.pm0000755060175106017510000000315014733536547020371 0ustar MithalduMithaldupackage PPI::Statement::Include::Perl6; =pod =head1 NAME PPI::Statement::Include::Perl6 - Inline Perl 6 file section =head1 SYNOPSIS use v6-alpha; grammar My::Grammar { ... } =head1 INHERITANCE PPI::Statement::Include::Perl6 isa PPI::Statement::Include isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION A C is a special include statement that indicates the start of a section of Perl 6 code inlined into a regular Perl 5 code file. The primary purpose of the class is to allow L to provide at least basic support for "6 in 5" modules like v6.pm; Currently, PPI only supports starting a Perl 6 block. It does not currently support changing back to Perl 5 again. Additionally all POD and __DATA__ blocks and __END__ blocks will be included in the Perl 6 string and will not be parsed by PPI. =cut use strict; use PPI::Statement::Include (); our $VERSION = '1.281'; our @ISA = "PPI::Statement::Include"; =pod =head2 perl6 The C method returns the block of Perl 6 code that is attached to the "use v6...;" command. =cut sub perl6 { $_[0]->{perl6}; } 1; =pod =head1 TO DO - Write specific unit tests for this package =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 PPI-1.281/lib/PPI/Statement/Include.pm0000755060175106017510000002112314733536547017401 0ustar MithalduMithaldupackage PPI::Statement::Include; =pod =head1 NAME PPI::Statement::Include - Statements that include other code =head1 SYNOPSIS # The following are all includes use 5.006; use strict; use My::Module; use constant FOO => 'Foo'; require Foo::Bar; require "Foo/Bar.pm"; require $foo if 1; no strict 'refs'; =head1 INHERITANCE PPI::Statement::Include isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION Despite its name, the C class covers a number of different types of statement that cover all statements starting with C, C and C. But basically, they cover three situations. Firstly, a dependency on a particular version of perl (for which the C method returns true), a pragma (for which the C method returns true), or the loading (and unloading via no) of modules. =head1 METHODS C has a number of methods in addition to the standard L, L and L methods. =cut use strict; use version 0.77 (); use Safe::Isa '$_call_if_object'; use PPI::Statement (); use PPI::Statement::Include::Perl6 (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; =pod =head2 type The C method returns the general type of statement (C<'use'>, C<'no'> or C<'require'>). Returns the type as a string, or C if the type cannot be detected. =cut sub type { my $self = shift; my $keyword = $self->schild(0) or return undef; $keyword->isa('PPI::Token::Word') and $keyword->content; } =pod =head2 module The C method returns the module name specified in any include statement. This C pragma names, because pragma are implemented as modules. (And lets face it, the definition of a pragma can be fuzzy at the best of times in any case) This covers all of these... use strict; use My::Module; no strict; require My::Module; ...but does not cover any of these... use 5.006; require 5.005; require "explicit/file/name.pl"; Returns the module name as a string, or C if the include does not specify a module name. =cut sub module { my $self = shift; my $module = $self->schild(1) or return undef; $module->isa('PPI::Token::Word') and $module->content; } =pod =head2 module_version The C method returns the minimum version of the module required by the statement, if there is one. =cut sub module_version { my $self = shift; my $argument = $self->schild(3); if ( $argument and $argument->isa('PPI::Token::Operator') ) { return undef; } my $version = $self->schild(2) or return undef; return undef unless $version->isa('PPI::Token::Number'); return $version; } =pod =head2 pragma The C method checks for an include statement's use as a pragma, and returns it if so. Or at least, it claims to. In practice it's a lot harder to say exactly what is or isn't a pragma, because the definition is fuzzy. The C of a pragma is to modify the way in which the parser works. This is done though the use of modules that do various types of internals magic. For now, PPI assumes that any "module name" that is only a set of lowercase letters (and perhaps numbers, like C). This behaviour is expected to change, most likely to something that knows the specific names of the various "pragmas". Returns the name of the pragma, or false ('') if the include is not a pragma. =cut sub pragma { my $self = shift; my $module = $self->module or return ''; $module =~ /^[a-z][a-z\d]*$/ ? $module : ''; } =pod =head2 version The C method checks for an include statement that introduces a dependency on the version of C the code is compatible with. This covers two specific statements. use 5.006; require 5.006; Currently the version is returned as a string, although in future the version may be returned as a L object. If you want a numeric representation, use C. Returns false if the statement is not a version dependency. =cut sub version { my $self = shift; my $version = $self->schild(1) or return undef; $version->isa('PPI::Token::Number') ? $version->content : ''; } =pod =head2 version_literal The C method has the same behavior as C, but the version is returned as a numeric literal. Returns false if the statement is not a version dependency. =cut sub version_literal { my $self = shift; my $version = $self->schild(1) or return undef; $version->isa('PPI::Token::Number') ? $version->literal : ''; } =pod =head2 arguments The C method gives you the rest of the statement after the module/pragma and module version, i.e. the stuff that will be used to construct what gets passed to the module's C subroutine. This does include the comma, etc. operators, but doesn't include non-significant direct children or any final semicolon. =cut sub arguments { my $self = shift; my @args = $self->schildren; # Remove the "use", "no" or "require" shift @args; # Remove the statement terminator if ( $args[-1]->isa('PPI::Token::Structure') and $args[-1]->content eq ';' ) { pop @args; } # Remove the module or perl version. shift @args; return unless @args; if ( $args[0]->isa('PPI::Token::Number') ) { my $after = $args[1] or return; $after->isa('PPI::Token::Operator') or shift @args; } return @args; } =head2 feature_mods # `use feature 'signatures';` my %mods = $include->feature_mods; # { signatures => "perl" } # `use 5.036;` my %mods = $include->feature_mods; # { signatures => "perl" } Returns a hashref of features identified as enabled by the include, or undef if the include does not enable features. The value for each feature indicates the provider of the feature. =cut sub feature_mods { my ($self) = @_; return if $self->type eq "require"; if ( my $cb_features = $self->_custom_feature_include_cb->($self) ) # { return $cb_features; } if ( my $perl_version = $self->version ) { ## tried using feature.pm, but it is impossible to install future ## versions of it, so e.g. a 5.20 install cannot know about ## 5.36 features # crude proof of concept hack due to above return { signatures => "perl" } if version::->parse($perl_version) >= 5.035; } my %known = ( signatures => 1, try => 1 ); my $on_or_off = $self->type eq "use"; if ( $on_or_off and my $custom = $self->_custom_feature_includes->{ $self->module } ) # { return $custom; } if ( $self->module eq "feature" ) { my @features = grep $known{$_}, $self->_decompose_arguments; return { map +( $_ => $on_or_off ? "perl" : 0 ), @features }; } elsif ( $self->module eq "Mojolicious::Lite" ) { my $wants_signatures = grep /-signatures/, $self->_decompose_arguments; return { signatures => $wants_signatures ? "perl" : 0 }; } elsif ( $self->module eq "Modern::Perl" ) { my $v = $self->module_version->$_call_if_object("literal") || 0; return { signatures => $v >= 2023 ? "perl" : 0 }; } elsif ( $self->module eq "experimental" ) { my $wants_signatures = grep /signatures/, $self->_decompose_arguments; return { signatures => $wants_signatures ? "perl" : 0 }; } elsif ( $self->module eq "Syntax::Keyword::Try" ) { return { try => $on_or_off ? "Syntax::Keyword::Try" : 0 }; } return; } sub _decompose_arguments { my ($self) = @_; my @args = $self->arguments; while ( grep ref, @args ) { @args = map $self->_decompose_argument($_), @args; } return @args; } sub _decompose_argument { my ( $self, $arg ) = @_; return $arg->children if $arg->isa("PPI::Structure::List") or $arg->isa("PPI::Statement::Expression"); my $as_text = $arg->can("literal") || $arg->can("string"); return $as_text->($arg) if $as_text; die "unknown arg decompose type: $arg , " . ref $arg; } sub _custom_feature_includes { my ($self) = @_; return unless # my $document = $self->document; return $document->custom_feature_includes || {}; } sub _custom_feature_include_cb { my ($self) = @_; return unless # my $document = $self->document; return $document->custom_feature_include_cb || sub { }; } 1; =pod =head1 TO DO - Write specific unit tests for this package =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 PPI-1.281/lib/PPI/Statement/Null.pm0000755060175106017510000000263114733536547016733 0ustar MithalduMithaldupackage PPI::Statement::Null; =pod =head1 NAME PPI::Statement::Null - A useless null statement =head1 SYNOPSIS my $foo = 1; ; # <-- Null statement my $bar = 1; =head1 INHERITANCE PPI::Statement::Null isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C is a utility class designed to handle situations where PPI encounters a naked statement separator. Although strictly speaking, the semicolon is a statement B and not a statement B, PPI considers a semicolon to be a statement terminator under most circumstances. In any case, the null statement has no purpose, and can be safely deleted with no ill effect. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # A null statement is not significant sub significant() { '' } 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 PPI-1.281/lib/PPI/Statement/Package.pm0000755060175106017510000000655314733536547017363 0ustar MithalduMithaldupackage PPI::Statement::Package; =pod =head1 NAME PPI::Statement::Package - A package statement =head1 INHERITANCE PPI::Statement::Package isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION Most L subclasses are assigned based on the value of the first token or word found in the statement. When PPI encounters a statement starting with 'package', it converts it to a C object. When working with package statements, please remember that packages only exist within their scope, and proper support for scoping has yet to be completed in PPI. However, if the immediate parent of the package statement is the top level L object, then it can be considered to define everything found until the next top-level "file scoped" package statement. A file may, however, contain nested temporary package, in which case you are mostly on your own :) =head1 METHODS C has a number of methods in addition to the standard L, L and L methods. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Lexer clues sub __LEXER__normal() { '' } =pod =head2 namespace Most package declarations are simple, and just look something like package Foo::Bar; The C method returns the name of the declared package, in the above case 'Foo::Bar'. It returns this exactly as written and does not attempt to clean up or resolve things like ::Foo to main::Foo. If the package statement is done any different way, it returns false. =cut sub namespace { my $self = shift; my $namespace = $self->schild(1) or return ''; $namespace->isa('PPI::Token::Word') ? $namespace->content : ''; } =pod =head2 version Some package declarations may include a version: package Foo::Bar 1.23; package Baz v1.23; The C method returns the stringified version as seen in the document (if any), otherwise the empty string. =cut sub version { my $self = shift; my $version = $self->schild(2) or return ''; $version->isa('PPI::Token::Structure') ? '' : $version->content; } =pod =head2 file_scoped Regardless of whether it is named or not, the C method will test to see if the package declaration is a top level "file scoped" statement or not, based on its location. In general, returns true if it is a "file scoped" package declaration with an immediate parent of the top level Document, or false if not. Note that if the PPI DOM tree B have a PPI::Document object at as the root element, this will return false. Likewise, it will also return false if the root element is a L, as a fragment of a file does not represent a scope. =cut sub file_scoped { my $self = shift; my ($Parent, $Document) = ($self->parent, $self->top); $Parent and $Document and $Parent == $Document and $Document->isa('PPI::Document') and ! $Document->isa('PPI::Document::Fragment'); } 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 PPI-1.281/lib/PPI/Statement/Scheduled.pm0000755060175106017510000000406014733536547017717 0ustar MithalduMithaldupackage PPI::Statement::Scheduled; =pod =head1 NAME PPI::Statement::Scheduled - A scheduled code block =head1 INHERITANCE PPI::Statement::Scheduled isa PPI::Statement::Sub isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION A scheduled code block is one that is intended to be run at a specific time during the loading process. There are five types of scheduled block: BEGIN { # Executes as soon as this block is fully defined ... } CHECK { # Executes after overall compile-phase in reverse order ... } UNITCHECK { # Executes after compile-phase of individual module in reverse order ... } INIT { # Executes just before run-time ... } END { # Executes as late as possible in reverse order ... } Technically these scheduled blocks are actually subroutines, and in fact may have 'sub' in front of them. =head1 METHODS =cut use strict; use PPI::Statement::Sub (); our $VERSION = '1.281'; our @ISA = "PPI::Statement::Sub"; sub __LEXER__normal() { '' } sub _complete { my $child = $_[0]->schild(-1); return !! ( defined $child and $child->isa('PPI::Structure::Block') and $child->complete ); } =pod =head2 type The C method returns the type of scheduled block, which should always be one of C<'BEGIN'>, C<'CHECK'>, C<'UNITCHECK'>, C<'INIT'> or C<'END'>. =cut sub type { my $self = shift; my @children = $self->schildren or return undef; $children[0]->content eq 'sub' ? $children[1]->content : $children[0]->content; } # This is actually the same as Sub->name sub name { shift->type(@_); } 1; =pod =head1 TO DO - Write unit tests for this package =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 PPI-1.281/lib/PPI/Statement/Sub.pm0000755060175106017510000001157614733536547016562 0ustar MithalduMithaldupackage PPI::Statement::Sub; =pod =head1 NAME PPI::Statement::Sub - Subroutine declaration =head1 INHERITANCE PPI::Statement::Sub isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION Except for the special BEGIN, CHECK, UNITCHECK, INIT, and END subroutines (which are part of L) all subroutine declarations are lexed as a PPI::Statement::Sub object. Primarily, this means all of the various C statements, but also forward declarations such as C or C. It B include anonymous subroutines, as these are merely part of a normal statement. =head1 METHODS C has a number of methods in addition to the standard L, L and L methods. =cut use strict; use List::Util (); use Params::Util qw{_INSTANCE}; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Lexer clue sub __LEXER__normal() { '' } sub _complete { my $child = $_[0]->schild(-1); return !! ( defined $child and $child->isa('PPI::Structure::Block') and $child->complete ); } ##################################################################### # PPI::Statement::Sub Methods =pod =head2 name The C method returns the name of the subroutine being declared. In some rare cases such as a naked C at the end of the file, this may return false. =cut sub name { my ($self) = @_; # Usually the second token is the name. # The third token is the name if this is a lexical subroutine. my $token = $self->schild(defined $self->type ? 2 : 1); return $token->content if defined $token and $token->isa('PPI::Token::Word'); # In the case of special subs whose 'sub' can be omitted (AUTOLOAD # or DESTROY), the name will be the first token. $token = $self->schild(0); return $token->content if defined $token and $token->isa('PPI::Token::Word'); return ''; } =pod =head2 prototype If it has one, the C method returns the subroutine's prototype. It is returned in the same format as L, cleaned and removed from its brackets. Returns the subroutine's prototype, or undef if the subroutine does not define one. Note that when the sub has an empty prototype (C<()>) the return is an empty string. =cut sub prototype { my $self = shift; my $Prototype = List::Util::first { _INSTANCE($_, 'PPI::Token::Prototype') } $self->children; defined($Prototype) ? $Prototype->prototype : undef; } =pod =head2 block With its name and implementation shared with L, the C method finds and returns the actual Structure object of the code block for this subroutine. Returns false if this is a forward declaration, or otherwise does not have a code block. =cut sub block { my $self = shift; my $lastchild = $self->schild(-1) or return ''; $lastchild->isa('PPI::Structure::Block') and $lastchild; } =pod =head2 forward The C method returns true if the subroutine declaration is a forward declaration. That is, it returns false if the subroutine has a code block, or true if it does not. =cut sub forward { ! shift->block; } =pod =head2 reserved The C method provides a convenience method for checking to see if this is a special reserved subroutine. It does not check against any particular list of reserved sub names, but just returns true if the name is all uppercase, as defined in L. Note that in the case of BEGIN, CHECK, UNITCHECK, INIT and END, these will be defined as L objects, not subroutines. Returns true if it is a special reserved subroutine, or false if not. =cut sub reserved { my $self = shift; my $name = $self->name or return ''; # perlsub is silent on whether reserveds can contain: # - underscores; # we allow them due to existing practice like CLONE_SKIP and __SUB__. # - numbers; we allow them by PPI tradition. $name eq uc $name; } =pod =head2 type The C method checks and returns the declaration type of the statement, which will be one of 'my', 'our', or 'state'. Returns a string of the type, or C if the type is not declared. =cut sub type { my $self = shift; # Get the first significant child my @schild = grep { $_->significant } $self->children; # Ignore labels shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label'); # Get the type (_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|our|state)$/) ? $schild[0]->content : undef; } 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 PPI-1.281/lib/PPI/Statement/Unknown.pm0000755060175106017510000000272014733536547017457 0ustar MithalduMithaldupackage PPI::Statement::Unknown; =pod =head1 NAME PPI::Statement::Unknown - An unknown or transient statement =head1 INHERITANCE PPI::Statement::Unknown isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION The C class is used primarily during the lexing process to hold elements that are known to be statement, but for which the exact C of statement is as yet unknown, and requires further tokens in order to resolve the correct type. They should not exist in a fully parse B document, and if any exists they indicate either a problem in Document, or possibly (by allowing it to get through unresolved) a bug in L. =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # If one of these ends up in the final document, # we're pretty much screwed. Just call it a day. sub _complete () { 1 } 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 PPI-1.281/lib/PPI/Statement/UnmatchedBrace.pm0000755060175106017510000000325314733536547020667 0ustar MithalduMithaldupackage PPI::Statement::UnmatchedBrace; =pod =head1 NAME PPI::Statement::UnmatchedBrace - Isolated unmatched brace =head1 SYNOPSIS sub foo { 1; } } # <--- This is an unmatched brace =head1 INHERITANCE PPI::Statement::UnmatchedBrace isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION The C class is a miscellaneous utility class. Objects of this type should be rare, or not exist at all in normal valid L objects. It can be either a round ')', square ']' or curly '}' brace, this class does not distinguish. Objects of this type are only allocated at a structural level, not a lexical level (as they are lexically invalid anyway). The presence of a C indicated a broken or invalid document. Or maybe a bug in PPI, but B more likely a broken Document. :) =head1 METHODS C has no additional methods beyond the default ones provided by L, L and L. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Once we've hit a naked unmatched brace we can never truly be complete. # So instead we always just call it a day... sub _complete () { 1 } 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 PPI-1.281/lib/PPI/Statement/Variable.pm0000755060175106017510000001012514733536547017543 0ustar MithalduMithaldupackage PPI::Statement::Variable; =pod =head1 NAME PPI::Statement::Variable - Variable declaration statements =head1 SYNOPSIS # All of the following are variable declarations my $foo = 1; my ($foo, $bar) = (1, 2); our $foo = 1; local $foo; local $foo = 1; LABEL: my $foo = 1; =head1 INHERITANCE PPI::Statement::Variable isa PPI::Statement::Expression isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION The main intent of the C class is to describe simple statements that explicitly declare new local or global variables. Note that this does not make it exclusively the only place where variables are defined, and later on you should expect that the C method will migrate deeper down the tree to either L or L to recognise this fact, but for now it stays here. =head1 METHODS =cut use strict; use Params::Util qw{_INSTANCE}; use PPI::Statement::Expression (); our $VERSION = '1.281'; our @ISA = "PPI::Statement::Expression"; =pod =head2 type The C method checks and returns the declaration type of the statement, which will be one of 'my', 'local', 'our', or 'state'. Returns a string of the type, or C if the type cannot be detected (which is probably a bug). =cut sub type { my $self = shift; # Get the first significant child my @schild = grep { $_->significant } $self->children; # Ignore labels shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label'); # Get the type (_INSTANCE($schild[0], 'PPI::Token::Word') and $schild[0]->content =~ /^(my|local|our|state)$/) ? $schild[0]->content : undef; } =pod =head2 variables As for several other PDOM Element types that can declare variables, the C method returns a list of the canonical forms of the variables defined by the statement. Returns a list of the canonical string forms of variables, or the null list if it is unable to find any variables. =cut sub variables { map { $_->canonical } $_[0]->symbols; } =pod =head2 symbols Returns a list of the variables defined by the statement, as Ls. =cut sub symbols { my $self = shift; # Get the children we care about my @schild = grep { $_->significant } $self->children; shift @schild if _INSTANCE($schild[0], 'PPI::Token::Label'); # If the second child is a symbol, return its name if ( _INSTANCE($schild[1], 'PPI::Token::Symbol') ) { return $schild[1]; } # If it's a list, return as a list if ( _INSTANCE($schild[1], 'PPI::Structure::List') ) { my $Expression = $schild[1]->schild(0); $Expression and $Expression->isa('PPI::Statement::Expression') or return (); # my and our are simpler than local if ( $self->type eq 'my' or $self->type eq 'our' or $self->type eq 'state' ) { return grep { $_->isa('PPI::Token::Symbol') } $Expression->schildren; } # Local is much more icky (potentially). # Not that we are actually going to deal with it now, # but having this separate is likely going to be needed # for future bug reports about local() things. # This is a slightly better way to check. return grep { $self->_local_variable($_) } grep { $_->isa('PPI::Token::Symbol') } $Expression->schildren; } # erm... this is unexpected (); } sub _local_variable { my ($self, $el) = @_; # The last symbol should be a variable my $n = $el->snext_sibling or return 1; my $p = $el->sprevious_sibling; if ( ! $p or $p eq ',' ) { # In the middle of a list return 1 if $n eq ','; # The first half of an assignment return 1 if $n eq '='; } # Lets say no for know... additional work # should go here. return ''; } 1; =pod =head1 TO DO - Write unit tests for this =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 PPI-1.281/lib/PPI/Statement/When.pm0000755060175106017510000000302214733536547016715 0ustar MithalduMithaldupackage PPI::Statement::When; =pod =head1 NAME PPI::Statement::When - A when statement =head1 SYNOPSIS foreach ( qw/ foo bar baz / ) { when ( m/b/ ) { boing($_); } when ( m/f/ ) { boom($_); } default { tchak($_); } } =head1 INHERITANCE PPI::Statement::When isa PPI::Statement isa PPI::Node isa PPI::Element =head1 DESCRIPTION C objects are used to describe when and default statements, as described in L. =head1 METHODS C has no methods beyond those provided by the standard L, L and L methods. =cut use strict; use PPI::Statement (); our $VERSION = '1.281'; our @ISA = "PPI::Statement"; # Lexer clues sub __LEXER__normal() { '' } sub _complete { my $child = $_[0]->schild(-1); return !! ( defined $child and $child->isa('PPI::Structure::Block') and $child->complete ); } ##################################################################### # PPI::Node Methods sub scope() { 1; } 1; =pod =head1 TO DO - Write unit tests for this package =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 PPI-1.281/lib/PPI/Statement.pm0000755060175106017510000002151014733536547016016 0ustar MithalduMithaldupackage 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.281'; 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