PPIx-EditorTools-0.18/0000755000175000017500000000000012040433503013467 5ustar gaborgaborPPIx-EditorTools-0.18/Changes0000644000175000017500000000473612040433375015003 0ustar gaborgaborRevision history for PPIx-EditorTools 0.18 2012.10.20 - Including Module::Install 1.06 http://weblog.bulknews.net/post/33907905561/do-not-ship-modules-with-module-install-1-04 - Add test using Test::CPAN::Changes 0.17 2012.08.19 - in Frankfurt am Main 0.15_04 2012.07.11 - suppress warning Exiting eval via next (BOWTIE) 0.15_03 2012.07.07 - Add patches from #1435 inspired by dod++ (BOWTIE) - Add additional tests for #1435 (BOWTIE) 0.16 2012.08.15 - released based on 0.15_02 0.15_02 2012.06.08 - Add patches from #401 by buff3r++ (BOWTIE) - Add Moose::Role support (BOWTIE) 0.15 2011.05.06 - Parse Moose files as well (BOWTIE) 0.14 2011.05.04 - Move from Dist::Zilla to Module::Install (-> LICENSE, META.json, README files removed, inc/ added) 0.13 2011.03.24 - Copy the lexer code used for syntax highlighting in Padre::Document::Perl::PPILexer to PPIx::EditorTools::Lexer (SZABGAB) 0.12 2011.03.23 - Copy the Outline generating code from Padre::Document::Perl::Outline to PPIx::EditorTools::Outline (SZABGAB) 0.11 2010.11.18 - Fixed RT #63107: Finding declared variables fragile and misses loop variables OVID++ (AZAWAWI) - Moved to Dist::Zilla (AZAWAWI) 0.10 2010.09.26 - Fixed Padre ticket #655: Can't rename to a variable with an underscore in it (PATRICKAS) - Fixed Padre ticket #653: Lexically rename doesn't work when clicking on declaration of variable (PATRICKAS) - Added feature to change variable style to/from camelCase (SMUELLER) 0.09 2009.09.19 - Fixed Padre ticket:504 and ticket:586 which is basically about being able to rename a variable when the cursor is over its declaration (AZAWAWI) - Refactored code a bit and removed some dead code (AZAWAWI) - Fixed one passing TODO test in t/06-renamevariable.t (AZAWAWI) - Added a test to t/02-findvariabledeclaration.t to make sure this fix works in the future (AZAWAWI) 0.08 2009.08.05 - updated location tests to work with the PPI v1.205 (RT#48449) (MGRIMES) - removed the INSTALL file: bad copyright and old install instuctions 0.07 2009.07.21 - skip tests if PPI version includes an underscore _ (SZABGAB) 0.06 2009.07.11 - fix MANIFEST.SKIP 0.05 2009.07.07 - Switch Changes to be more machine parsable (ADAMK) - Added dependency versions - Removed needless 5.10 dependency that wasn't reflected in the code - Switched to Module::Install to auto-detect config from the code 0.04 2009.06.25 - Added Changes file - Removed MANIFEST and META.yml from repository PPIx-EditorTools-0.18/README0000644000175000017500000000111112040433172014343 0ustar gaborgaborNAME PPIx::EditorTools - Utility methods and base class for manipulating Perl via PPI SYNOPSIS See PPIx::EditorTools::* DESCRIPTION Base class and utility methods for manipulating Perl via PPI. Pulled out from the "Padre::Task::PPI" code. METHODS new() Constructor. Generally shouldn't be called with any arguments. AUTHORS Gabor Szabo CONTRIBUTORS ADAMK AZAWAWI BOWTIE buff3r MGRIMES PATRICKAS SMUELLER SEE ALSO "PPIx::EditorTools::*", Padre, App::EditorTools, Padre, and PPI. PPIx-EditorTools-0.18/MANIFEST0000644000175000017500000000226512040433441014626 0ustar gaborgaborChanges inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/PPIx/EditorTools.pm lib/PPIx/EditorTools/FindUnmatchedBrace.pm lib/PPIx/EditorTools/FindVariableDeclaration.pm lib/PPIx/EditorTools/IntroduceTemporaryVariable.pm lib/PPIx/EditorTools/Lexer.pm lib/PPIx/EditorTools/Outline.pm lib/PPIx/EditorTools/RenamePackage.pm lib/PPIx/EditorTools/RenamePackageFromPath.pm lib/PPIx/EditorTools/RenameVariable.pm lib/PPIx/EditorTools/ReturnObject.pm Makefile.PL MANIFEST This list of files META.yml README script/ppix_editortools t/00-ppix-editortools.t t/01-findunmatchedbrace.t t/02-findvariabledeclaration.t t/03-introducetemporaryvariable.t t/04-renamepackage.t t/05-renamepackagefrompath.t t/06-camelcasing.t t/07-renamevariable.t t/08-getallvariabledeclarations.t t/09-outline.t t/10-lexer.t t/100-changes.t t/outline/file1.pl t/outline/file2.pl t/outline/Foo.pm t/outline/Mooclass.pm t/outline/MooclassVanilla.pm t/outline/Moofirst.pm t/outline/Moorole.pm t/outline/test_1435.pl t/rename_variable/1.in t/rename_variable/1.out PPIx-EditorTools-0.18/Makefile.PL0000644000175000017500000000373512040433172015453 0ustar gaborgabor# NOTE: inc::Module::Install::PRIVATE::Padre needs Perl 5.8, so make sure # that we force the Perl version check (and fail) early. # Unicode is also considered to finally be "stable" at 5.8.5, so we will # set our dependency on that. use 5.008005; use strict; #use lib 'privinc'; use inc::Module::Install 1.00; #use POSIX qw(locale_h); # Workaround for the fact that Module::Install loads the modules # into memory and when Test::NoWarnings is loaded it will hide # the warnings generated from that point. # Removed in r2208, added again in r9001 eval { require Test::NoWarnings; $SIG{__WARN__} = 'DEFAULT'; }; # Configure-time dependencies MUST be done first. # This version ensures that we have a new MakeMaker that # WON'T load modules to determine the version. # This _SHOULD_ theoretically make the "require Test::NoWarnings". # stuff above here no longer needed. configure_requires 'ExtUtils::MakeMaker' => '6.52'; # NOTE: Core modules that aren't dual-life should always have a version of 0 name 'PPIx-EditorTools'; license 'perl'; author 'Steffen Mueller C'; author 'Repackaged by Mark Grimes C'; author 'Ahmad M. Zawawi '; all_from 'lib/PPIx/EditorTools.pm'; requires 'perl' => '5.008005'; # General dependencies requires 'Carp'; requires 'Class::XSAccessor' => '1.02'; requires 'File::Spec'; requires 'File::Basename'; requires 'PPI' => '1.215'; requires 'PPI::Find' => '0'; requires 'Try::Tiny' => '0.11'; test_requires 'File::Find' => '0'; test_requires 'File::Temp' => '0'; test_requires 'Test::More' => '0.88'; test_requires 'Test::Most' => '0'; test_requires 'Test::Differences' => '0'; test_requires 'Test::NoWarnings' => '0.084'; no_index 'directory' => qw{ t xt eg share inc privinc }; homepage 'http://padre.perlide.org/'; bugtracker 'http://padre.perlide.org/trac/'; repository 'http://svn.perlide.org/padre/trunk/PPIx-EditorTools/'; WriteAll; PPIx-EditorTools-0.18/inc/0000755000175000017500000000000012040433503014240 5ustar gaborgaborPPIx-EditorTools-0.18/inc/Module/0000755000175000017500000000000012040433503015465 5ustar gaborgaborPPIx-EditorTools-0.18/inc/Module/Install/0000755000175000017500000000000012040433503017073 5ustar gaborgaborPPIx-EditorTools-0.18/inc/Module/Install/Metadata.pm0000644000175000017500000004327712040433415021170 0ustar gaborgabor#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; PPIx-EditorTools-0.18/inc/Module/Install/Fetch.pm0000644000175000017500000000462712040433415020475 0ustar gaborgabor#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; PPIx-EditorTools-0.18/inc/Module/Install/Makefile.pm0000644000175000017500000002743712040433415021165 0ustar gaborgabor#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 PPIx-EditorTools-0.18/inc/Module/Install/Win32.pm0000644000175000017500000000340312040433415020335 0ustar gaborgabor#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; PPIx-EditorTools-0.18/inc/Module/Install/Can.pm0000644000175000017500000000615712040433415020145 0ustar gaborgabor#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 PPIx-EditorTools-0.18/inc/Module/Install/Base.pm0000644000175000017500000000214712040433415020311 0ustar gaborgabor#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 PPIx-EditorTools-0.18/inc/Module/Install/WriteAll.pm0000644000175000017500000000237612040433415021166 0ustar gaborgabor#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; PPIx-EditorTools-0.18/inc/Module/Install.pm0000644000175000017500000003013512040433414017434 0ustar gaborgabor#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. PPIx-EditorTools-0.18/lib/0000755000175000017500000000000012040433503014235 5ustar gaborgaborPPIx-EditorTools-0.18/lib/PPIx/0000755000175000017500000000000012040433503015055 5ustar gaborgaborPPIx-EditorTools-0.18/lib/PPIx/EditorTools/0000755000175000017500000000000012040433503017324 5ustar gaborgaborPPIx-EditorTools-0.18/lib/PPIx/EditorTools/FindUnmatchedBrace.pm0000644000175000017500000000357112040433276023345 0ustar gaborgaborpackage PPIx::EditorTools::FindUnmatchedBrace; # ABSTRACT: PPI-based unmatched-brace-finder use 5.008; use strict; use warnings; use Carp; use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => {}; use PPI; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $brace = PPIx::EditorTools::FindUnmatchedBrace->new->find( code => "package TestPackage;\nsub x { 1;\n" ); my $location = $brace->element->location; =head1 DESCRIPTION Finds the location of unmatched braces in a C. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item find( ppi => PPI::Document $ppi ) =item find( code => Str $code ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Finds the location of unmatched braces. Returns a C with the unmatched brace (a C) available via the C accessor. If there is no unmatched brace, returns undef. =back =cut sub find { my ( $self, %args ) = @_; $self->process_doc(%args); my $ppi = $self->ppi; my $where = $ppi->find( \&PPIx::EditorTools::find_unmatched_brace ); if ($where) { @$where = sort { PPIx::EditorTools::element_depth($b) <=> PPIx::EditorTools::element_depth($a) or $a->location->[0] <=> $b->location->[0] or $a->location->[1] <=> $b->location->[1] } @$where; return PPIx::EditorTools::ReturnObject->new( ppi => $ppi, element => $where->[0] ); } return; } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut # Copyright 2008-2009 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/Lexer.pm0000644000175000017500000000654712040433276020764 0ustar gaborgaborpackage PPIx::EditorTools::Lexer; # ABSTRACT: Simple Lexer used for syntax highlighting use 5.008; use strict; use warnings; use Carp; use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => {}; use PPI; our $VERSION = '0.18'; =pod =head1 SYNOPSIS PPIx::EditorTools::Lexer->new->lexer( code => "package TestPackage;\nsub x { 1;\n", highlighter => sub { my ( $css, $row, $rowchar, $len ) = @_; ... }, ); =head1 DESCRIPTION Go over the various interesting elements of a give piece of code or an already process PPI tree. For each token call the user supplied 'highlighter' function with the follow values: $css - The keyword that can be used for colouring. $row - The row number where the token starts $rowchar - The character within that row where the token starts $len - The length of the token =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item find( ppi => PPI::Document $ppi, highlighter => sub {...} ) =item find( code => Str $code, highlighter => sub ...{} ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Return a reference to an array. =back =cut sub lexer { my ( $self, %args ) = @_; my $markup = delete $args{highlighter}; $self->process_doc(%args); my $ppi = $self->ppi; return [] unless defined $ppi; $ppi->index_locations; my @tokens = $ppi->tokens; foreach my $t (@tokens) { my ( $row, $rowchar, $col ) = @{ $t->location }; my $css = class_to_css($t); my $len = $t->length; $markup->( $css, $row, $rowchar, $len ); } } sub class_to_css { my $Token = shift; if ( $Token->isa('PPI::Token::Word') ) { # There are some words we can be very confident are # being used as keywords unless ( $Token->snext_sibling and $Token->snext_sibling->content eq '=>' ) { if ( $Token->content =~ /^(?:sub|return)$/ ) { return 'keyword'; } elsif ( $Token->content =~ /^(?:undef|shift|defined|bless)$/ ) { return 'core'; } } if ( $Token->previous_sibling and $Token->previous_sibling->content eq '->' ) { if ( $Token->content =~ /^(?:new)$/ ) { return 'core'; } } if ( $Token->parent->isa('PPI::Statement::Include') ) { if ( $Token->content =~ /^(?:use|no)$/ ) { return 'keyword'; } if ( $Token->content eq $Token->parent->pragma ) { return 'pragma'; } } elsif ( $Token->parent->isa('PPI::Statement::Variable') ) { if ( $Token->content =~ /^(?:my|local|our)$/ ) { return 'keyword'; } } elsif ( $Token->parent->isa('PPI::Statement::Compound') ) { if ( $Token->content =~ /^(?:if|else|elsif|unless|for|foreach|while|my)$/ ) { return 'keyword'; } } elsif ( $Token->parent->isa('PPI::Statement::Package') ) { if ( $Token->content eq 'package' ) { return 'keyword'; } } elsif ( $Token->parent->isa('PPI::Statement::Scheduled') ) { return 'keyword'; } } # Normal coloring my $css = ref $Token; $css =~ s/^.+:://; $css; } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut # Copyright 2008-2011 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/ReturnObject.pm0000644000175000017500000000552612040433276022307 0ustar gaborgaborpackage PPIx::EditorTools::ReturnObject; # ABSTRACT: Simple object to return values from PPIx::EditorTools use 5.008; use strict; use warnings; use Carp; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $brace = PPIx::EditorTools::FindUnmatchedBrace->new->find( code => "package TestPackage;\nsub x { 1;\n" ); my $location = $brace->element->location; my $ppi = $brace->element->ppi; =head1 DESCRIPTION Retuning a simple C from many of the C methods often results in the loss of the overall context for that element. C provides an object that can be passed around which retains the overall context. For example, in C if the unmatched brace were returned by its C the containing C is likely to go out of scope, thus the C method no longer returns a valid location (rather it returns undef). Using the C preserves the C and the containing context. =head1 METHODS =over 4 =item new() Constructor which should be used by C. Accepts the following named parameters: =over 4 =item ppi A C representing the (possibly modified) code. =item code A string representing the (possibly modified) code. =item element A C or a subclass thereof representing the interesting element. =back =item ppi Accessor to retrieve the C. May create the C from the $code string (lazily) if needed. =item code Accessor to retrieve the string representation of the code. May be retrieved from the C via the serialize method (lazily) if needed. =back =cut sub new { my $class = shift; return bless {@_}, ref($class) || $class; } sub element { my ($self) = @_; # If element is a code ref, run the code once then cache the # result if ( exists $self->{element} and ref( $self->{element} ) and ref( $self->{element} ) eq 'CODE' ) { $self->{element} = $self->{element}->(@_); } return $self->{element}; } sub ppi { my ( $self, $doc ) = @_; # $self->{ppi} = $doc if $doc; # TODO: and isa? return $self->{ppi} if $self->{ppi}; if ( $self->{code} ) { my $code = $self->{code}; $self->{ppi} = PPI::Document->new( \$code ); return $self->{ppi}; } return; } sub code { my ( $self, $doc ) = @_; # $self->{code} = $doc if $doc; return $self->{code} if $self->{code}; if ( $self->{ppi} ) { $self->{code} = $self->{ppi}->serialize; return $self->{code}; } return; } 1; __END__ =head1 SEE ALSO C, L, L, and L. =cut # Copyright 2008-2009 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/FindVariableDeclaration.pm0000644000175000017500000000441312040433276024367 0ustar gaborgaborpackage PPIx::EditorTools::FindVariableDeclaration; # ABSTRACT: Finds where a variable was declared using PPI use 5.008; use strict; use warnings; use Carp; use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => { 'location' => 'location' }; our $VERSION = '0.18'; =pod =head1 SYNOPSIS # finds declaration of variable at cursor my $declaration = PPIx::EditorTools::FindVariableDeclaration->new->find( code => "package TestPackage;\nuse strict;\nBEGIN { $^W = 1; }\nmy \$x=1;\n\$x++;" line => 5, column => 2, ); my $location = $declaration->element->location; =head1 DESCRIPTION Finds the location of a variable declaration. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item find( ppi => PPI::Document $ppi, line => $line, column => $column ) =item find( code => Str $code, line => $line, column => $column ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Searches for the variable declaration and returns a C with the declaration (C) available via the C accessor. Croaks with a "no token" exception if no token is found at the location. Croaks with a "no declaration" exception if unable to find the declaration. =back =cut sub find { my ( $self, %args ) = @_; $self->process_doc(%args); my $column = $args{column} or croak "column required"; my $line = $args{line} or croak "line required"; my $location = [ $line, $column ]; my $ppi = $self->ppi; $ppi->flush_locations; my $token = PPIx::EditorTools::find_token_at_location( $ppi, $location ); croak "no token" unless $token; my $declaration = PPIx::EditorTools::find_variable_declaration($token); croak "no declaration" unless $declaration; return PPIx::EditorTools::ReturnObject->new( ppi => $ppi, element => $declaration, ); } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut # Copyright 2008-2009 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/RenamePackageFromPath.pm0000644000175000017500000000507012040433276024017 0ustar gaborgaborpackage PPIx::EditorTools::RenamePackageFromPath; # ABSTRACT: Change the package name based on the files path use 5.008; use strict; use warnings; use Carp; use Class::XSAccessor accessors => { 'replacement' => 'replacement', 'filename' => 'filename', }; use base 'PPIx::EditorTools'; use PPIx::EditorTools::RenamePackage; use Carp; use File::Spec; use File::Basename; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $munged = PPIx::EditorTools::RenamePackageFromPath->new->rename( code => "package TestPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", filename => './lib/Test/Code/Path.pm', ); my $new_code_as_string = $munged->code; my $package_ppi_element = $munged->element; =head1 DESCRIPTION This module uses PPI to change the package name of code. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item rename( ppi => PPI::Document $ppi, filename => Str ) =item rename( code => Str $code, filename => Str ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Replaces the package name with that supplied in the C parameter and returns a C with the new code available via the C or C accessors, as a C or C, respectively. An attempt will be made to derive the package name from the filename passed as a parameter. The filename's path will converted to an absolute path and it will be searched for a C directory which will be assumed the start of the package name. If no C directory can be found in the absolute path, the relative path will be used. Croaks with a "package name not found" exception if unable to find the package name. =back =cut sub rename { my ( $self, %args ) = @_; $self->process_doc(%args); my $path = $args{filename} || croak "filename required"; my $dir = dirname $path; my $file = basename $path, qw/.pm .PM .Pm/; my @directories = grep { $_ && !/^\.$/ } File::Spec->splitdir( File::Spec->rel2abs($dir) ); my $replacement; if ( grep {/^lib$/} @directories ) { while ( shift(@directories) !~ /^lib$/ ) { } } else { @directories = grep { $_ && !/^\.$/ } File::Spec->splitdir($dir); } $replacement = join( '::', @directories, $file ); return PPIx::EditorTools::RenamePackage->new( ppi => $self->ppi )->rename( replacement => $replacement ); } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut PPIx-EditorTools-0.18/lib/PPIx/EditorTools/RenameVariable.pm0000644000175000017500000001606112040433276022552 0ustar gaborgaborpackage PPIx::EditorTools::RenameVariable; # ABSTRACT: Lexically replace a variable name in Perl code use 5.008; use strict; use warnings; use Carp; use base 'PPIx::EditorTools'; use Class::XSAccessor; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $munged = PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 15, column => 13, replacement => 'stuff', ); my $code_as_strig = $munged->code; my $code_as_ppi = $munged->ppi; my $location = $munged->element->location; =head1 DESCRIPTION This module will lexically replace a variable name. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item rename( ppi => PPI::Document $ppi, line => Int, column => Int, replacement => Str ) =item rename( code => Str $code, line => Int, column => Int, replacement => Str ) =item rename( code => Str $code, line => Int, column => Int, to_camel_case => Bool, [ucfirst => Bool] ) =item rename( code => Str $code, line => Int, column => Int, from_camel_case => Bool, [ucfirst => Bool] ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Renames the variable found at line, column with that supplied in the C parameter and returns a C with the new code available via the C or C accessors, as a C or C, respectively. The C found at line, column is available via the C accessor. Instead of specifying an explicit replacement variable name, you may choose to use the C or C options that automatically convert to/from camelCase. In that mode, the C option will force uppercasing of the first letter. You can not specify a replacement name and use the C options. Croaks with a "no token" exception if no token is found at the location. Croaks with a "no declaration" exception if unable to find the declaration. =back =cut sub rename { my ( $self, %args ) = @_; $self->process_doc(%args); my $column = $args{column} || croak "column required"; my $line = $args{line} || croak "line required"; my $location = [ $line, $column ]; my $replacement = $args{replacement}; if ( ( $args{to_camel_case} or $args{from_camel_case} ) and defined $replacement ) { croak("Can't accept both replacement name and to_camel_case/from_camel_case"); } elsif ( not $args{to_camel_case} and not $args{from_camel_case} and not defined $replacement ) { croak("Need either 'replacement' or to/from_camel_case options"); } my $doc = $self->ppi; my $token = PPIx::EditorTools::find_token_at_location( $doc, $location ); die "no token found" unless defined $token; my $declaration = PPIx::EditorTools::find_variable_declaration($token); die "no declaration" unless defined $declaration; $doc->index_locations; my $scope = $declaration; while ( not $scope->isa('PPI::Document') and not $scope->isa('PPI::Structure::Block') ) { $scope = $scope->parent; } my $token_str = $token->content; my $varname = $token->symbol; if ( not defined $replacement ) { if ( $args{from_camel_case} ) { $replacement = _from_camel_case( $varname, $args{ucfirst} ); } else { # $args{to_camel_case} $replacement = _to_camel_case( $varname, $args{ucfirst} ); } if ( $varname eq $replacement ) { return PPIx::EditorTools::ReturnObject->new( ppi => $doc, element => $token ); } } #warn "VARNAME: $varname"; # TODO: This could be part of PPI somehow? # The following string of hacks is simply for finding symbols in quotelikes and regexes my $type = substr( $varname, 0, 1 ); my $brace = $type eq '@' ? '[' : ( $type eq '%' ? '{' : '' ); my @patterns; if ( $type eq '@' or $type eq '%' ) { my $accessv = $varname; $accessv =~ s/^\Q$type\E/\$/; @patterns = ( quotemeta( _curlify($varname) ), quotemeta($varname), quotemeta($accessv) . '(?=' . quotemeta($brace) . ')', ); if ( $type eq '%' ) { my $slicev = $varname; $slicev =~ s/^\%/\@/; push @patterns, quotemeta($slicev) . '(?=' . quotemeta($brace) . ')'; } elsif ( $type eq '@' ) { my $indexv = $varname; $indexv =~ s/^\@/\$\#/; push @patterns, quotemeta($indexv); } } else { @patterns = ( quotemeta( _curlify($varname) ), quotemeta($varname) . "(?![\[\{])" ); } my %unique; my $finder_regexp = '(?:' . join( '|', grep { !$unique{$_}++ } @patterns ) . ')'; $finder_regexp = qr/$finder_regexp/; # used to find symbols in quotelikes and regexes #warn $finder_regexp; $replacement =~ s/^\W+//; $scope->find( sub { my $node = $_[1]; if ( $node->isa("PPI::Token::Symbol") ) { return 0 unless $node->symbol eq $varname; # TODO do this without breaking encapsulation! $node->{content} = substr( $node->content(), 0, 1 ) . $replacement; } # This used to be a simple "if". Patrickas: "[elsif] resolves this # issue but it may introduce other bugs since I am not sure I # understand the code that follows it." # See Padre trac ticket #655 for the full comment. Remove this # comment if there are new bugs resulting from this change. elsif ( $type eq '@' and $node->isa("PPI::Token::ArrayIndex") ) { # $#foo return 0 unless substr( $node->content, 2 ) eq substr( $varname, 1 ); # TODO do this without breaking encapsulation! $node->{content} = '$#' . $replacement; } elsif ( $node->isa("PPI::Token") ) { # the case of potential quotelikes and regexes my $str = $node->content; if ($str =~ s{($finder_regexp)([\[\{]?)}< if ($1 =~ tr/{//) { substr($1, 0, ($1=~tr/#//)+1) . "{$replacement}$2" } else { substr($1, 0, ($1=~tr/#//)+1) . "$replacement$2" } >ge ) { # TODO do this without breaking encapsulation! $node->{content} = $str; } } return 0; }, ); return PPIx::EditorTools::ReturnObject->new( ppi => $doc, element => $token, ); } # converts a variable name to camel case and optionally converts the # first character to upper case sub _to_camel_case { my $var = shift; my $ucfirst = shift; my $prefix; if ( $var =~ s/^(\W*_)// ) { $prefix = $1; } $var =~ s/_([[:alpha:]])/\u$1/g; $var =~ s/^([^[:alpha:]]*)([[:alpha:]])/$1\u$2/ if $ucfirst; $var = $prefix . $var if defined $prefix; return $var; } sub _from_camel_case { my $var = shift; my $ucfirst = shift; my $prefix; if ( $var =~ s/^(\W*_?)// ) { $prefix = $1; } if ($ucfirst) { $var = lcfirst($var); $var =~ s/([[:upper:]])/_\u$1/g; $var =~ s/^([^[:alpha:]]*)([[:alpha:]])/$1\u$2/; } else { $var =~ s/^([^[:alpha:]]*)([[:alpha:]])/$1\l$2/; $var =~ s/([[:upper:]])/_\l$1/g; } $var = $prefix . $var if defined $prefix; return $var; } sub _curlify { my $var = shift; if ( $var =~ s/^([\$\@\%])(.+)$/${1}{$2}/ ) { return ($var); } return (); } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut PPIx-EditorTools-0.18/lib/PPIx/EditorTools/IntroduceTemporaryVariable.pm0000644000175000017500000001246412040433276025205 0ustar gaborgaborpackage PPIx::EditorTools::IntroduceTemporaryVariable; # ABSTRACT: Introduces a temporary variable using PPI use 5.008; use strict; use warnings; use Carp; use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => { 'start_location' => 'start_location', 'end_location' => 'end_location', 'expression' => 'expression', 'location' => 'location', }; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $munged = PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce( code => "use strict; BEGIN { $^W = 1; }\n\tmy $x = ( 1 + 10 / 12 ) * 2;\n\tmy $y = ( 3 + 10 / 12 ) * 2;\n", start_location => [ 2, 19 ], end_location => [ 2, 25 ], varname => '$foo', ); my $modified_code_as_string = $munged->code; my $location_of_new_var_declaration = $munged->element->location; =head1 DESCRIPTION Given a region of code within a statement, replaces all occurrences of that code with a temporary variable. Declares and initializes the temporary variable right above the statement that included the selected expression. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item find( ppi => PPI::Document, start_location => Int, end_location => Int, varname => Str ) =item find( code => Str, start_location => Int, end_location => Int, varname => Str ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Given the region of code specified by start_location and end_location, replaces that code with a temporary variable with the name given in varname (defaults to C). Declares and initializes the temporary variable right above the statement that included the selected expression. Returns a C with the modified code as a string available via the C accessor (or as a C via the C accessor), and the C where the new variable is declared available via the C accessor. Croaks with a "no token" exception if no token is found at the location. Croaks with a "no statement" exception if unable to find the statement. =back =cut sub introduce { my ( $self, %args ) = @_; $self->process_doc(%args); my $start_loc = $args{start_location} or croak "start_location required"; my $end_loc = $args{end_location} or croak "end_location required"; my $varname = $args{varname}; $varname = 'tmp' if not defined $varname; $varname = '$' . $varname if $varname !~ /^[\$\@\%]/; my $ppi = $self->ppi; $ppi->flush_locations; my $token = PPIx::EditorTools::find_token_at_location( $ppi, $start_loc ); $ppi->flush_locations; die "no token" unless $token; my $statement = $token->statement(); die "no statement" unless $statement; # walk up the PPI tree until we reach a sort of structure that's not a statement. # FIXME: This may or may not be robust. A PPI::Statement claims to be what's # defined as "statements" in perlsyn, but it's not! perlsyn says all statements # end in a semicolon unless at the end of a block. # For PPI, Statements can be part of others and thus don't necessarily have # a semicolon. while (1) { my $parent = $statement->statement(); last if not defined $parent; if ( $parent eq $statement ) { # exactly the same object, ie. is a statement already $parent = $statement->parent(); # force the parent last if not $parent # stop if we're at a block or at the document level or $parent->isa('PPI::Structure::Block') or $parent->isa('PPI::Structure::Document'); $parent = $parent->statement(); # force it to be a statement } last if not $parent # stop if the parent isn't a statement or not $parent->isa('PPI::Statement'); $statement = $parent; } my $location_for_insert = $statement->location; $self->location($location_for_insert); # TODO: split on a look behind \n so we keep the \n my @code = map {"$_\n"} split( /\n/, $ppi->serialize ); my $expr; for my $line_num ( $start_loc->[0] .. $end_loc->[0] ) { my $line = $code[ $line_num - 1 ]; # 0 based index to 1 base line numbers substr( $line, $end_loc->[1] ) = '' if $line_num == $end_loc->[0]; substr( $line, 0, $start_loc->[1] - 1 ) = '' if $line_num == $start_loc->[0]; $expr .= $line; } $self->expression($expr); my $indent = ''; $indent = $1 if $code[ $location_for_insert->[0] - 1 ] =~ /^(\s+)/; my $place_holder = 'XXXXX_PPIx_EDITOR_PLACE_HOLDER_XXXXX'; substr( $code[ $location_for_insert->[0] - 1 ], $location_for_insert->[1] - 1, 0 ) = sprintf( "my %s = %s;\n%s", $varname, $place_holder, $indent ); # TODO: need to watch for word boundries etc... my $code = join( '', @code ); $code =~ s/\Q$expr\E/$varname/gm; $code =~ s/\Q$place_holder\E/$expr/gm; return PPIx::EditorTools::ReturnObject->new( code => $code, element => sub { PPIx::EditorTools::find_token_at_location( shift->ppi, $location_for_insert ); } ); } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut # Copyright 2008-2009 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/Outline.pm0000644000175000017500000001466212040433276021321 0ustar gaborgaborpackage PPIx::EditorTools::Outline; # ABSTRACT: Collect use pragmata, modules, subroutiones, methods, attributes use 5.008; use strict; use warnings; use Carp; use Try::Tiny; use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => {}; use PPI; our $VERSION = '0.18'; sub find { my ( $self, %args ) = @_; $self->process_doc(%args); my $ppi = $self->ppi; return [] unless defined $ppi; $ppi->index_locations; # Search for interesting things require PPI::Find; # TODO things not very discriptive my @things = PPI::Find->new( sub { # This is a fairly ugly search return 1 if ref $_[0] eq 'PPI::Statement::Package'; return 1 if ref $_[0] eq 'PPI::Statement::Include'; return 1 if ref $_[0] eq 'PPI::Statement::Sub'; return 1 if ref $_[0] eq 'PPI::Statement'; } )->in($ppi); # Define a flag indicating that further Method::Signature/Moose check should run my $check_alternate_sub_decls = 0; # Build the outline structure from the search results my @outline = (); my $cur_pkg = {}; my $not_first_one = 0; foreach my $thing (@things) { if ( ref $thing eq 'PPI::Statement::Package' ) { if ($not_first_one) { if ( not $cur_pkg->{name} ) { $cur_pkg->{name} = 'main'; } push @outline, $cur_pkg; $cur_pkg = {}; } $not_first_one = 1; $cur_pkg->{name} = $thing->namespace; $cur_pkg->{line} = $thing->location->[0]; } elsif ( ref $thing eq 'PPI::Statement::Include' ) { next if $thing->type eq 'no'; if ( $thing->pragma ) { push @{ $cur_pkg->{pragmata} }, { name => $thing->pragma, line => $thing->location->[0] }; } elsif ( $thing->module ) { push @{ $cur_pkg->{modules} }, { name => $thing->module, line => $thing->location->[0] }; unless ($check_alternate_sub_decls) { $check_alternate_sub_decls = 1 if grep { $thing->module eq $_ } ( 'Method::Signatures', 'MooseX::Declare', 'MooseX::Method::Signatures', 'Moose::Role', 'Moose', ); } } } elsif ( ref $thing eq 'PPI::Statement::Sub' ) { push @{ $cur_pkg->{methods} }, { name => $thing->name, line => $thing->location->[0] }; } elsif ( ref $thing eq 'PPI::Statement' ) { # last resort, let's analyse further down... my $node1 = $thing->first_element; my $node2 = $thing->child(2); next unless defined $node2; # Tests for has followed by new line try { no warnings 'exiting'; # suppress warning Exiting eval via next if ( defined $node2->{content} ) { if ( $node2->{content} =~ /\n/ ) { next; } } }; # Moose attribute declaration if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'has' ) { # p $_[1]->next_sibling->isa('PPI::Token::Whitespace'); $self->_Moo_Attributes( $node2, $cur_pkg, $thing ); next; } # MooseX::POE event declaration if ( $node1->isa('PPI::Token::Word') && $node1->content eq 'event' ) { push @{ $cur_pkg->{events} }, { name => $node2->content, line => $thing->location->[0] }; next; } } } if ($check_alternate_sub_decls) { $ppi->find( sub { $_[1]->isa('PPI::Token::Word') or return 0; $_[1]->content =~ /^(?:func|method|before|after|around|override|augment|class|role)\z/ or return 0; $_[1]->next_sibling->isa('PPI::Token::Whitespace') or return 0; my $sib_content = $_[1]->next_sibling->next_sibling->content or return 0; my $name = eval $sib_content; # if eval() failed for whatever reason, default to original trimmed original token $name ||= ( $sib_content =~ m/^\b(\w+)\b/ )[0]; return 0 unless defined $name; # test for MooseX::Declare class, role if ( $_[1]->content =~ m/(class|role)/ ) { $self->_Moo_PkgName( $cur_pkg, $sib_content, $_[1] ); return 1; # break out so we don't write Package name as method } push @{ $cur_pkg->{methods} }, { name => $name, line => $_[1]->line_number }; return 1; } ); } if ( not $cur_pkg->{name} ) { $cur_pkg->{name} = 'main'; } push @outline, $cur_pkg; return \@outline; } ######## # Composed Method, internal, Moose Attributes # cleans moose attributes up, and single lines them. # only runs if PPI finds has # prefix all vars with ma_ otherwise same name ######## sub _Moo_Attributes { my ( $self, $ma_node2, $ma_cur_pkg, $ma_thing ) = @_; my $line_num = $ma_thing->location->[0]; if ( $ma_node2->content =~ /[\n|;]/ ) { return; } my $attrs = eval $ma_node2->content; # if eval() failed for whatever reason, default to original token $attrs ||= $ma_node2->content; if ( ref $attrs eq 'ARRAY' ) { map { push @{ $ma_cur_pkg->{attributes} }, { name => $_, line => $line_num, } } grep {defined} @{$attrs}; } else { push @{ $ma_cur_pkg->{attributes} }, { name => $attrs, line => $line_num, }; } return; } ######## # Composed Method, internal, Moose Pakage Name # write first Class or Role as Package Name if none # prefix all vars with mpn_ otherwise same name ######## sub _Moo_PkgName { my ( $self, $mpn_cur_pkg, $mpn_sib_content, $mpn_ppi_tuple ) = @_; if ( $mpn_cur_pkg->{name} ) { return 1; } # break if we have a pkg name # add to outline $mpn_cur_pkg->{name} = $mpn_sib_content; # class or role name $mpn_cur_pkg->{line} = $mpn_ppi_tuple->line_number; # class or role location return 1; } 1; __END__ =pod =head1 SYNOPSIS my $outline = PPIx::EditorTools::Outline->new->find( code => "package TestPackage;\nsub x { 1;\n" ); print Dumper $outline; =head1 DESCRIPTION Return a list of pragmatas, modules, methods, attributes of a C. =head1 METHODS =over 4 =item * new() Constructor. Generally shouldn't be called with any arguments. =item * find() find( ppi => PPI::Document $ppi ) or find( code => Str $code ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Return a reference to a hash. =back =head2 Internal Methods =over 4 =item * _Moo_Attributes =item * _Moo_PkgName =back =head1 AUTHORS Gabor Szabo Egabor@szabgab.comE =head2 CONTRIBUTORS Kevin Dawson Ebowtie@cpan.orgE buff3r Ebuff3r@E =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut # Copyright 2008-2012 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/lib/PPIx/EditorTools/RenamePackage.pm0000644000175000017500000000377712040433276022372 0ustar gaborgaborpackage PPIx::EditorTools::RenamePackage; # ABSTRACT: Change the package name use strict; BEGIN { $^W = 1; } use base 'PPIx::EditorTools'; use Class::XSAccessor accessors => { 'replacement' => 'replacement' }; use PPI; use Carp; our $VERSION = '0.18'; =pod =head1 SYNOPSIS my $munged = PPIx::EditorTools::RenamePackage->new->rename( code => "package TestPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", replacement => 'NewPackage' ); my $new_code_as_string = $munged->code; my $package_ppi_element = $munged->element; =head1 DESCRIPTION This module uses PPI to change the package name of code. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =item rename( ppi => PPI::Document $ppi, replacement => Str ) =item rename( code => Str $code, replacement => Str ) Accepts either a C to process or a string containing the code (which will be converted into a C) to process. Replaces the package name with that supplied in the C parameter and returns a C with the new code available via the C or C accessors, as a C or C, respectively. Croaks with a "package name not found" exception if unable to find the package name. =back =cut sub rename { my ( $self, %args ) = @_; $self->process_doc(%args); my $replacement = $args{replacement} || croak "replacement required"; my $doc = $self->ppi; # TODO: support MooseX::Declare my $package = $doc->find_first('PPI::Statement::Package') or die "no package found"; my $namespace = $package->schild(1) or croak "package name not found"; $namespace->isa('PPI::Token::Word') or croak "package name not found"; $namespace->{content} = $replacement; return PPIx::EditorTools::ReturnObject->new( ppi => $doc, element => $package ); } 1; __END__ =head1 SEE ALSO This class inherits from C. Also see L, L, and L. =cut PPIx-EditorTools-0.18/lib/PPIx/EditorTools.pm0000644000175000017500000002077012040433276017677 0ustar gaborgaborpackage PPIx::EditorTools; use 5.008; use strict; use warnings; use Carp; use Class::XSAccessor 1.02 constructor => 'new', accessors => { 'code' => 'code', 'ppi' => 'ppi', }; use PPI 1.203; use PPIx::EditorTools::ReturnObject; our $VERSION = '0.18'; =pod =head1 NAME PPIx::EditorTools - Utility methods and base class for manipulating Perl via PPI =head1 SYNOPSIS See PPIx::EditorTools::* =head1 DESCRIPTION Base class and utility methods for manipulating Perl via PPI. Pulled out from the C code. =head1 METHODS =over 4 =item new() Constructor. Generally shouldn't be called with any arguments. =back =cut # Used by all the PPIx::EditorTools::* modules # Checks for either PPI::Document or take the code as a string and # creates the ppi document sub process_doc { my ( $self, %args ) = @_; $self->ppi( $args{ppi} ) if defined $args{ppi}; return 1 if $self->ppi && $self->ppi->isa('PPI::Document'); # TODO: inefficient to pass around full code/ppi $self->code( $args{code} ) if $args{code}; my $code = $self->code; $self->ppi( PPI::Document->new( \$code ) ); return 1 if $self->ppi && $self->ppi->isa('PPI::Document'); croak "arguments ppi or code required"; return; } ##################################################################### # Assorted Search Functions sub find_unmatched_brace { $_[1]->isa('PPI::Statement::UnmatchedBrace') and return 1; $_[1]->isa('PPI::Structure') or return ''; $_[1]->start and $_[1]->finish and return ''; return 1; } # scans a document for variable declarations and # sorts them into three categories: # lexical (my) # our (our, doh) # dynamic (local) # package (use vars) # Returns a hash reference containing the three category names # each pointing at a hash which contains '$variablename' => locations. # locations is an array reference containing one or more PPI-style # locations. Example: # { # lexical => { # '$foo' => [ [ 2, 3, 3], [ 6, 7, 7 ] ], # }, # ... # } # Thus, there are two places where a "my $foo" was declared. On line 2 col 3 # and line 6 col 7. sub get_all_variable_declarations { my $document = shift; my %vars; my $declarations = $document->find( sub { return 0 unless $_[1]->isa('PPI::Statement::Variable') or $_[1]->isa('PPI::Statement::Include') or $_[1]->isa('PPI::Statement::Compound'); return 1; }, ); my %our; my %lexical; my %dynamic; my %package; foreach my $decl (@$declarations) { if ( $decl->isa('PPI::Statement::Variable') ) { my $type = $decl->type(); my @vars = $decl->variables; my $location = $decl->location; my $target_type; if ( $type eq 'my' ) { $target_type = \%lexical; } elsif ( $type eq 'our' ) { $target_type = \%our; } elsif ( $type eq 'local' ) { $target_type = \%dynamic; } foreach my $var (@vars) { $target_type->{$var} ||= []; push @{ $target_type->{$var} }, $location; } } # find use vars... elsif ( $decl->isa('PPI::Statement::Include') and $decl->module eq 'vars' and $decl->type eq 'use' ) { # do it the low-tech way my $string = $decl->content(); my $location = $decl->location; my @vars = $string =~ /([\%\@\$][\w_:]+)/g; foreach my $var (@vars) { $package{$var} ||= []; push @{ $package{$var} }, $location; } } # find for/foreach loop variables elsif ( $decl->isa('PPI::Statement::Compound') && ( $decl->type eq 'for' or $decl->type eq 'foreach' ) ) { my @elems = $decl->elements; next if scalar(@elems) < 5; my $location = $decl->location; my $type = $elems[2]->content(); if ( $elems[4]->isa('PPI::Token::Symbol') && ( $type eq 'my' || $type eq 'our' ) ) { my $target_type; # Only my and our are valid for loop variable if ( $type eq 'my' ) { $target_type = \%lexical; } elsif ( $type eq 'our' ) { $target_type = \%our; } my $var = $elems[4]->content(); $target_type->{$var} ||= []; push @{ $target_type->{$var} }, $location; } } } # end foreach declaration return ( { our => \%our, lexical => \%lexical, dynamic => \%dynamic, package => \%package } ); } ##################################################################### # Stuff that should be in PPI itself sub element_depth { my $cursor = shift; my $depth = 0; while ( $cursor = $cursor->parent ) { $depth += 1; } return $depth; } # TODO: PPIx::IndexOffsets or something similar might help. # TODO: See the 71... tests. If we don#t flush locations there, this breaks. sub find_token_at_location { my $document = shift; my $location = shift; if ( not defined $document or not $document->isa('PPI::Document') or not defined $location or not ref($location) eq 'ARRAY' ) { require Carp; Carp::croak("find_token_at_location() requires a PPI::Document and a PPI-style location as arguments"); } $document->index_locations(); foreach my $token ( $document->tokens ) { my $loc = $token->location; if ( $loc->[0] > $location->[0] or ( $loc->[0] == $location->[0] and $loc->[1] > $location->[1] ) ) { $document->flush_locations(); return $token->previous_token(); } } $document->flush_locations(); return (); } # given either a PPI::Token::Symbol (i.e. a variable) # or a PPI::Token which contains something that looks like # a variable (quoted vars, interpolated vars in regexes...) # find where that variable has been declared lexically. # Doesn't find stuff like "use vars...". sub find_variable_declaration { my $cursor = shift; return () if not $cursor or not $cursor->isa("PPI::Token"); my ( $varname, $token_str ); if ( $cursor->isa("PPI::Token::Symbol") ) { $varname = $cursor->symbol; $token_str = $cursor->content; } else { my $content = $cursor->content; if ( $content =~ /((?:\$#?|[@%*])[\w:\']+)/ ) { $varname = $1; $token_str = $1; } } return () if not defined $varname; $varname =~ s/^\$\#/@/; my $document = $cursor->top(); my $declaration; my $prev_cursor; # This finds variable declarations if you're above it if ( $cursor->parent->isa('PPI::Statement::Variable') ) { return $cursor->parent; } # This finds variable declarations if you're above it and it has the form my ($foo , $bar); if ( $cursor->parent->isa('PPI::Statement::Expression') && $cursor->parent->parent->parent->isa('PPI::Statement::Variable') ) { return $cursor->parent->parent->parent; } while (1) { $prev_cursor = $cursor; $cursor = $cursor->parent; if ( $cursor->isa("PPI::Structure::Block") or $cursor == $document ) { my @elems = $cursor->elements; foreach my $elem (@elems) { # Stop scanning this scope if we're at the branch we're coming # from. This is to ignore declarations later in the block. last if $elem == $prev_cursor; if ( $elem->isa("PPI::Statement::Variable") and grep { $_ eq $varname } $elem->variables ) { $declaration = $elem; last; } # find use vars ... elsif ( $elem->isa("PPI::Statement::Include") and $elem->module eq 'vars' and $elem->type eq 'use' ) { # do it the low-tech way my $string = $elem->content(); my @vars = $string =~ /([\%\@\$][\w_:]+)/g; if ( grep { $varname eq $_ } @vars ) { $declaration = $elem; last; } } } last if $declaration or $cursor == $document; } # this is for "foreach my $i ..." elsif ( $cursor->isa("PPI::Statement::Compound") and $cursor->type() =~ /^for/ ) { my @elems = $cursor->elements; foreach my $elem (@elems) { # Stop scanning this scope if we're at the branch we're coming # from. This is to ignore declarations later in the block. last if $elem == $prev_cursor; if ( $elem->isa("PPI::Token::Word") and $elem->content() =~ /^(?:my|our)$/ ) { my $nelem = $elem->snext_sibling(); if ( defined $nelem and $nelem->isa("PPI::Token::Symbol") and $nelem->symbol() eq $varname || $nelem->content() eq $token_str ) { $declaration = $nelem; last; } } } last if $declaration or $cursor == $document; } } # end while not top level return $declaration; } 1; __END__ =pod =head1 AUTHORS Gabor Szabo Egabor@szabgab.comE =head2 CONTRIBUTORS ADAMK AZAWAWI BOWTIE buff3r MGRIMES PATRICKAS SMUELLER =head1 SEE ALSO C, L, L, L, and L. =cut # Copyright 2008-2009 The Padre development team as listed in Padre.pm. # LICENSE # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl 5 itself. PPIx-EditorTools-0.18/t/0000755000175000017500000000000012040433503013732 5ustar gaborgaborPPIx-EditorTools-0.18/t/09-outline.t0000644000175000017500000001367712040433172016044 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; use PPIx::EditorTools::Outline; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } my @cases = ( { file => 't/outline/Foo.pm', expected => [ { 'modules' => [ { name => 'Method::Signatures', line => 3, }, ], 'methods' => [ { name => 'new', line => 5, }, { name => 'hello', line => 8, } ], 'line' => 1, 'name' => 'Foo', } ], }, { file => 't/outline/file1.pl', expected => [ { 'methods' => [ { 'line' => 6, 'name' => 'qwer' } ], 'modules' => [ { 'line' => 2, 'name' => 'Abc' } ], 'name' => 'main', 'pragmata' => [ { 'line' => 1, 'name' => 'strict' }, { 'line' => 1, 'name' => 'warnings' } ] } ], }, { code => <<'END_CODE', use strict; END_CODE expected => [ { 'pragmata' => [ { 'line' => 1, name => 'strict', }, ], 'name' => 'main', }, ], }, { file => 't/outline/file2.pl', expected => [ { 'methods' => [ { 'line' => 14, 'name' => 'abc' }, { 'line' => 19, 'name' => 'def' }, { 'line' => 26, 'name' => 'xyz' } ], 'name' => 'main', 'pragmata' => [ { 'line' => 4, 'name' => 'strict' }, { 'line' => 5, 'name' => 'autodie' }, { 'line' => 6, 'name' => 'warnings' }, { 'line' => 8, 'name' => 'lib' } ] } ] }, ); ############## # Moose outline testing follows ############## push @cases, ( { file => 't/outline/Mooclass.pm', expected => [ { 'modules' => [ { 'name' => 'MooseX::Declare', 'line' => 1, }, ], 'methods' => [ { 'name' => 'pub_sub', 'line' => 14, }, { 'name' => '_pri_sub', 'line' => 18, }, { 'name' => 'mm_before', 'line' => 22, }, { 'name' => 'mm_after', 'line' => 26, }, { 'name' => 'mm_around', 'line' => 30, }, { 'name' => 'mm_override', 'line' => 34, }, { 'name' => 'mm_augment', 'line' => 38, }, ], 'line' => 3, 'name' => 'Mooclass', 'attributes' => [ { 'name' => 'moo_att', 'line' => 5 }, { 'name' => 'label', 'line' => 7 }, { 'name' => 'progress', 'line' => 7 }, { 'name' => 'butWarn', 'line' => 7 }, { 'name' => 'butTime', 'line' => 7 }, { 'name' => 'start_stop', 'line' => 7 }, { 'name' => 'account', 'line' => 10 }, { 'name' => 'non_quoted_attr', 'line' => 12 }, ], } ], }, # can we do the same thing with vanilla Moose class definitions? { file => 't/outline/MooclassVanilla.pm', expected => [ { 'modules' => [ { 'name' => 'Moose', 'line' => 3, }, ], 'methods' => [ { 'name' => 'pub_sub', 'line' => 13, }, { 'name' => '_pri_sub', 'line' => 17, }, { 'name' => 'mm_before', 'line' => 21, }, { 'name' => 'mm_after', 'line' => 25, }, { 'name' => 'mm_around', 'line' => 29, }, { 'name' => 'mm_override', 'line' => 33, }, { 'name' => 'mm_augment', 'line' => 37, }, ], 'line' => 1, 'name' => 'Moose::Declarations::MethodModifiers::Vanilla', 'attributes' => [ { 'name' => 'moo_att', 'line' => 5, }, { 'name' => 'label', 'line' => 7, }, { 'name' => 'progress', 'line' => 7, }, { 'name' => 'butWarn', 'line' => 7, }, { 'name' => 'butTime', 'line' => 7, }, { 'name' => 'start_stop', 'line' => 7, }, { 'name' => 'account', 'line' => 9, }, { 'name' => 'non_quoted_attr', 'line' => 11, }, ], } ], }, { file => 't/outline/Moorole.pm', expected => [ { 'modules' => [ { 'name' => 'MooseX::Declare', 'line' => 1, }, ], 'line' => 3, 'name' => 'Moorole', 'attributes' => [ { 'line' => 7, 'name' => 'balance' }, { 'line' => 13, 'name' => 'overdraft' } ], 'pragmata' => [ { 'line' => 5, 'name' => 'version' } ] } ] }, { file => 't/outline/Moofirst.pm', expected => [ { 'attributes' => [ { 'line' => 7, 'name' => 'balance' }, { 'line' => 13, 'name' => 'overdraft' }, { 'line' => 23, 'name' => 'name' }, { 'line' => 25, 'name' => 'account' } ], 'line' => 3, 'methods' => [ { 'line' => 27, 'name' => '_build_overdraft' } ], 'modules' => [ { 'line' => 1, 'name' => 'MooseX::Declare' } ], 'name' => 'Moofirst', 'pragmata' => [ { 'line' => 5, 'name' => 'version' } ] } ] }, ); ############## # has outline testing #1435 ############## push @cases, ( { file => 't/outline/test_1435.pl', expected => [ { 'attributes' => [ { 'name' => 'first', 'line' => 3, }, { 'name' => 'second', 'line' => 5, }, ], 'modules' => [ { 'line' => 1, 'name' => 'Class::Accessor' } ], 'name' => 'main', } ], }, ); plan tests => @cases * 1; foreach my $c (@cases) { my $code = $c->{code}; if ( $c->{file} ) { open my $fh, '<', $c->{file} or die( "couldn't read file: ", $c->{file}, ": $!" ); local $/ = undef; $code = <$fh>; } my $outline = PPIx::EditorTools::Outline->new->find( code => $code ); #diag explain $outline; is_deeply ( $outline, $c->{expected}, $c->{file} ) or diag explain $outline; } PPIx-EditorTools-0.18/t/02-findvariabledeclaration.t0000644000175000017500000000255411747265241021217 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 6; use PPIx::EditorTools::FindVariableDeclaration; my $code = <<'END_OF_CODE'; package TestPackage; use strict; use warnings; my $x=1; $x++; END_OF_CODE my $declaration; # Test finding variable declaration when on the variable $declaration = PPIx::EditorTools::FindVariableDeclaration->new->find( code => $code, line => 5, column => 2, ); isa_ok( $declaration, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $declaration->element, 'PPI::Statement::Variable' ); location_is( $declaration->element, [ 4, 1, 1 ], 'simple scalar' ); # Test finding variable declaration when on declaration itself $declaration = PPIx::EditorTools::FindVariableDeclaration->new->find( code => $code, line => 4, column => 4, ); isa_ok( $declaration, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $declaration->element, 'PPI::Statement::Variable' ); location_is( $declaration->element, [ 4, 1, 1 ], 'simple scalar' ); # Helper function sub location_is { my ( $element, $location, $desc ) = @_; my $elem_loc = $element->location; $elem_loc = [ @$elem_loc[ 0 .. 2 ] ] if @$elem_loc > 3; is_deeply( $elem_loc, $location, $desc ); } PPIx-EditorTools-0.18/t/100-changes.t0000644000175000017500000000020312040431771016025 0ustar gaborgaboruse Test::More; eval 'use Test::CPAN::Changes'; plan skip_all => 'Test::CPAN::Changes required for this test' if $@; changes_ok(); PPIx-EditorTools-0.18/t/06-camelcasing.t0000644000175000017500000000437211747265241016635 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } use PPIx::EditorTools::RenameVariable; my @to_camel_tests = ( # test expected ucfirst [qw(abc abc 0)], [qw(abc Abc 1)], [qw(Abc Abc 0)], [qw(Abc Abc 1)], [qw(abc_def abcDef 0)], [qw(abc_def AbcDef 1)], [qw(a_b_c_D_E aBCDE 0)], [qw(a_b_c_D_E ABCDE 1)], [qw(A_b_c_D_E ABCDE 1)], [qw(A_b_c_D_E ABCDE 0)], [qw(_this_is_a_var _thisIsAVar 0)], [qw(_this_is_a_var _ThisIsAVar 1)], ); my @from_camel_tests = ( # test expected ucfirst [qw(abc abc 0)], [qw(abc Abc 1)], [qw(Abc abc 0)], [qw(Abc Abc 1)], [qw(abcDef abc_def 0)], [qw(abcDef Abc_Def 1)], [qw(AbcDef abc_def 0)], [qw(AbcDef Abc_Def 1)], [qw(aBCDE a_b_c_d_e 0)], [qw(aBCDE A_B_C_D_E 1)], [qw(ABCDE a_b_c_d_e 0)], [qw(ABCDE A_B_C_D_E 1)], [qw(_abc _abc 0)], [qw(_abc _Abc 1)], [qw(_thisIsAVar _this_is_a_var 0)], [qw(_thisIsAVar _This_Is_A_Var 1)], [qw(_ThisIsAVar _this_is_a_var 0)], [qw(_ThisIsAVar _This_Is_A_Var 1)], ); plan tests => @to_camel_tests * 3 + @from_camel_tests * 3; foreach my $test (@to_camel_tests) { my ( $src, $exp, $ucfirst ) = @$test; is( PPIx::EditorTools::RenameVariable::_to_camel_case( $src, $ucfirst ), $exp, "to-camel-case '$src' with ucfirst=$ucfirst" ); $_ = '$' . $_ for ( $src, $exp ); is( PPIx::EditorTools::RenameVariable::_to_camel_case( $src, $ucfirst ), $exp, "to-camel-case '$src' with ucfirst=$ucfirst" ); s/^\$/\$#/ for ( $src, $exp ); is( PPIx::EditorTools::RenameVariable::_to_camel_case( $src, $ucfirst ), $exp, "to-camel-case '$src' with ucfirst=$ucfirst" ); } foreach my $test (@from_camel_tests) { my ( $src, $exp, $ucfirst ) = @$test; is( PPIx::EditorTools::RenameVariable::_from_camel_case( $src, $ucfirst ), $exp, "from-camel-case '$src' with ucfirst=$ucfirst" ); $_ = '$' . $_ for ( $src, $exp ); is( PPIx::EditorTools::RenameVariable::_from_camel_case( $src, $ucfirst ), $exp, "from-camel-case '$src' with ucfirst=$ucfirst" ); s/^\$/\$#/ for ( $src, $exp ); is( PPIx::EditorTools::RenameVariable::_from_camel_case( $src, $ucfirst ), $exp, "from-camel-case '$src' with ucfirst=$ucfirst" ); } PPIx-EditorTools-0.18/t/08-getallvariabledeclarations.t0000644000175000017500000000204611747265241021734 0ustar gaborgabor#!/usr/bin/perl # Test for RT #63107: Finding declared variables fragile and misses loop variables # Courtesy of Ovid++ use strict; use warnings; use Test::Most 'no_plan'; use PPI; use PPIx::EditorTools; diag "PPI version is $PPI::VERSION"; my $code = <<'END_OF_CODE'; use warnings; foreach my $arg (@ARGV) { print $arg; } END_OF_CODE # Test finding variable declaration when on the variable my $declarations; lives_ok { $declarations = PPIx::EditorTools::get_all_variable_declarations( PPI::Document->new( \$code ) ); } 'We should be able to find variable declarations'; explain $declarations; ok exists $declarations->{lexical}{'$arg'}, '... and we should be able to find loop variables'; $code = <<'END_OF_CODE'; foreach my $arg (@ARGV) { print $arg; } END_OF_CODE lives_ok { $declarations = PPIx::EditorTools::get_all_variable_declarations( PPI::Document->new( \$code ) ); } 'We should be able to find variable declarations'; explain $declarations; ok exists $declarations->{lexical}{'$arg'}, '... and we should be able to find loop variables'; PPIx-EditorTools-0.18/t/03-introducetemporaryvariable.t0000644000175000017500000000613711747265241022032 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 10; use PPIx::EditorTools::IntroduceTemporaryVariable; my $code = <<'END_CODE'; use strict; use warnings; my $x = ( 1 + 10 / 12 ) * 2; my $y = ( 3 + 10 / 12 ) * 2; END_CODE my $new_code = PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce( code => $code, start_location => [ 2, 19 ], # or just character position end_location => [ 2, 25 ], # or ppi-style location varname => '$foo', ); isa_ok( $new_code, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $new_code->element, 'PPI::Token' ); location_is( $new_code->element, [ 2, 5, 5 ], 'temp var location' ); eq_or_diff( $new_code->code, <<'RESULT', '10 / 12' ); use strict; use warnings; my $foo = 10 / 12; my $x = ( 1 + $foo ) * 2; my $y = ( 3 + $foo ) * 2; RESULT $new_code = PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce( code => $code, start_location => [ 2, 13 ], # or just character position end_location => [ 2, 27 ], # or ppi-style location varname => '$foo', ); eq_or_diff( $new_code->code, <<'RESULT', '( 1 + 10 / 12 )' ); use strict; use warnings; my $foo = ( 1 + 10 / 12 ); my $x = $foo * 2; my $y = ( 3 + 10 / 12 ) * 2; RESULT $code = <<'END_CODE2'; use strict; use warnings; my $x = ( 1 + 10 / 12 ) * 2; my $y = ( 3 + 10 / 12 ) * 2; END_CODE2 $new_code = PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce( code => $code, start_location => [ 2, 9 ], # or just character position end_location => [ 3, 10 ], # or ppi-style location # varname => '$foo', ); eq_or_diff( $new_code->code, <<'RESULT', '( 1 + 10 \n / 12 )' ); use strict; use warnings; my $tmp = ( 1 + 10 / 12 ); my $x = $tmp * 2; my $y = ( 3 + 10 / 12 ) * 2; RESULT my $code3 = <<'END_CODE3'; use strict; use warnings; sub one { my $x = ( 1 + 10 / 12 ) * 2; my $y = ( 3 + 10 / 12 ) * 2; } sub two { my $y = ( 3 + 10 / 12 ) * 2; } END_CODE3 my $new_code3 = PPIx::EditorTools::IntroduceTemporaryVariable->new->introduce( code => $code3, start_location => [ 3, 19 ], # or just character position end_location => [ 3, 25 ], # or ppi-style location varname => '$foo', ); isa_ok( $new_code3, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $new_code3->element, 'PPI::Token' ); location_is( $new_code3->element, [ 3, 5, 5 ], 'temp var location' ); TODO: { local $TODO = 'Bug: RT#60042 - replace does not respect lexical scope'; eq_or_diff( $new_code3->code, <<'RESULT3', 'lexically scoped' ); use strict; use warnings; sub one { my $foo = 10 / 12; my $x = ( 1 + $foo ) * 2; my $y = ( 3 + $foo ) * 2; } sub two { my $y = ( 3 + 10 / 12 ) * 2; } RESULT3 } sub location_is { my ( $element, $location, $desc ) = @_; my $elem_loc = $element->location; $elem_loc = [ @$elem_loc[ 0 .. 2 ] ] if @$elem_loc > 3; is_deeply( $elem_loc, $location, $desc ); } PPIx-EditorTools-0.18/t/outline/0000755000175000017500000000000012040433503015411 5ustar gaborgaborPPIx-EditorTools-0.18/t/outline/file2.pl0000644000175000017500000000041011747265241016761 0ustar gaborgabor#!/usr/bin/perl use 5.008; use strict; use autodie; use warnings FATAL => 'all'; use lib ('/opt/perl5/lib'); my $global = 42; print "start"; sub abc { print 1; my $private = 42; sub def { } print 2; } print "ok"; sub xyz { } print "end"; PPIx-EditorTools-0.18/t/outline/MooclassVanilla.pm0000644000175000017500000000103611747265241021055 0ustar gaborgaborpackage Moose::Declarations::MethodModifiers::Vanilla; use Moose; has 'moo_att' => ( is => 'rw', ); has [qw/ label progress butWarn butTime start_stop /] => ( isa => 'Ref', is => 'rw' ); has qw(account) => ( is => 'rw', ); has non_quoted_attr => ( is => 'rw' ); sub pub_sub { return; } sub _pri_sub { return; } before 'mm_before' => sub { return; }; after 'mm_after' => sub { return; }; around 'mm_around' => sub { return; }; override 'mm_override' => sub { return; }; augment 'mm_augment' => sub { return; }; 1; __END__ PPIx-EditorTools-0.18/t/outline/test_1435.pl0000644000175000017500000000015012040433172017377 0ustar gaborgaboruse Class::Accessor 'antlers'; has first => ( is => 'rw' ); has ;#comment has second => ( is => 'ro' );PPIx-EditorTools-0.18/t/outline/file1.pl0000644000175000017500000000010411747265241016760 0ustar gaborgaboruse strict; use warnings; use Abc; my $global = 42; sub qwer { } PPIx-EditorTools-0.18/t/outline/Foo.pm0000644000175000017500000000014411747265241016510 0ustar gaborgaborpackage Foo; use Method::Signatures; method new (%data) { } func hello($name, $daytime) { } 1; PPIx-EditorTools-0.18/t/outline/Moofirst.pm0000644000175000017500000000071611747265241017574 0ustar gaborgaboruse MooseX::Declare; role Moofirst { requires '_build_overdraft'; use version; our $VERSION = version->new('1.0.1'); has 'balance' => ( isa => 'Num', is => 'rw', default => 0 ); has 'overdraft' => ( isa => 'Bool', is => 'rw', lazy_build => 1, init_arg => undef, ); } class Mooclass { has 'name' => ( isa => 'Str', is => 'rw', ); has qw(account) => ( is => 'rw', ); method _build_overdraft { return; } } PPIx-EditorTools-0.18/t/outline/Mooclass.pm0000644000175000017500000000075311747265241017553 0ustar gaborgaboruse MooseX::Declare; class Mooclass { has 'moo_att' => ( is => 'rw', ); has [qw/ label progress butWarn butTime start_stop /] => ( isa => 'Ref', is => 'rw' ); has qw(account) => ( is => 'rw', ); has non_quoted_attr => ( is=> 'rw' ); method pub_sub { return; } method _pri_sub { return; } before mm_before { return; } after mm_after { return; } around mm_around { return; } override mm_override { return; } augment mm_augment { return; } } PPIx-EditorTools-0.18/t/outline/Moorole.pm0000644000175000017500000000047411747265241017407 0ustar gaborgaboruse MooseX::Declare; role Moorole { requires '_build_overdraft'; use version; our $VERSION = version->new('1.0.1'); has 'balance' => ( isa => 'Num', is => 'rw', default => 0 ); has 'overdraft' => ( isa => 'Bool', is => 'rw', lazy_build => 1, init_arg => undef, ); } PPIx-EditorTools-0.18/t/rename_variable/0000755000175000017500000000000012040433503017046 5ustar gaborgaborPPIx-EditorTools-0.18/t/rename_variable/1.in0000644000175000017500000000054412012736537017555 0ustar gaborgaboruse MooseX::Declare; class Test { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my %hash; for my $i (1..5) { $hash{$i} = $x_var; } } } PPIx-EditorTools-0.18/t/rename_variable/1.out0000644000175000017500000000054412012736537017756 0ustar gaborgaboruse MooseX::Declare; class Test { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $shiny = 1; print "Do stuff with ${shiny}\n"; $shiny += 1; my %hash; for my $i (1..5) { $hash{$i} = $shiny; } } } PPIx-EditorTools-0.18/t/05-renamepackagefrompath.t0000644000175000017500000000421311747265241020704 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 4; use PPIx::EditorTools::RenamePackageFromPath; my $code = "package TestPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n"; sub new_code { return sprintf "package %s;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", shift; } my $munged = PPIx::EditorTools::RenamePackageFromPath->new->rename( code => $code, filename => './lib/Test/Code/Path.pm', ); eq_or_diff( $munged->code, new_code("Test::Code::Path"), 'simple package' ); eq_or_diff( PPIx::EditorTools::RenamePackageFromPath->new->rename( code => $code, filename => './Test/Code/Path.pm', )->code, new_code("Test::Code::Path"), 'no lib package' ); eq_or_diff( PPIx::EditorTools::RenamePackageFromPath->new->rename( code => $code, filename => 'lib/Test/./Code/Path.pm', )->code, new_code("Test::Code::Path"), 'with /./ part' ); TODO: { local $TODO = 'Does not support /../ path constructs yet'; eq_or_diff( PPIx::EditorTools::RenamePackageFromPath->new->rename( code => $code, filename => 'lib/Test/Ignore/../Code/Path.pm', )->code, new_code("Test::Code::Path"), 'strip .. from package' ); } __END__ my $stuff_replacement = <<'STUFF_REPLACEMENT'; use MooseX::Declare; class Test { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my %stuff; for my $i (1..5) { $stuff{$i} = $x_var; } } } STUFF_REPLACEMENT eq_or_diff( PPIx::EditorTools::RenameVariable->new( code => $code ) ->replace_var( line => 15, column => 13, replacement => 'stuff', ), $stuff_replacement, 'replace hash' ); my $replacer = PPIx::EditorTools::RenameVariable->new( code => $code ); my $doc = $replacer->replace_var( line => 15, column => 13, replacement => 'stuff', ); my $token = $replacer->token; isa_ok( $token, 'PPI::Token::Symbol' ); PPIx-EditorTools-0.18/t/01-findunmatchedbrace.t0000644000175000017500000000213011747265241020156 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 6; use PPIx::EditorTools::FindUnmatchedBrace; my $brace = PPIx::EditorTools::FindUnmatchedBrace->new->find( code => "package TestPackage;\nuse strict;\nuse warnings;\nsub x { 1;\n" ); isa_ok( $brace, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $brace->element, 'PPI::Structure::Block' ); location_is( $brace->element, [ 4, 7, 7 ], 'unclosed sub' ); $brace = PPIx::EditorTools::FindUnmatchedBrace->new->find( code => "package TestPackage;\nfor my \$x (1..2) { 1;\n" ); isa_ok( $brace, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $brace->element, 'PPI::Structure::Block' ); location_is( $brace->element, [ 2, 18, 18 ], 'unclosed for block' ); sub location_is { my ( $element, $location, $desc ) = @_; my $elem_loc = $element->location; $elem_loc = [ @$elem_loc[ 0 .. 2 ] ] if @$elem_loc > 3; is_deeply( $elem_loc, $location, $desc ); } PPIx-EditorTools-0.18/t/07-renamevariable.t0000644000175000017500000001045612012737517017341 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; use File::Temp qw(tempdir); my $tempdir = tempdir( CLEANUP => 1 ); BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 17; use PPIx::EditorTools::RenameVariable; my $code = read_file('t/rename_variable/1.in'); my $shiny_replacement = read_file('t/rename_variable/1.out'); eq_or_diff( eval { PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 8, column => 12, replacement => 'shiny', )->code; } || "", $shiny_replacement, 'replace scalar' ); test_cli($code, "--RenameVariable --line 8 --column 12 --replacement shiny", $shiny_replacement, 'replace scalar on command line'); eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 11, column => 9, replacement => 'shiny', )->code, $shiny_replacement, 'replace scalar' ); test_cli($code, "--RenameVariable --line 11 --column 9 --replacement shiny", $shiny_replacement, 'replace scalar on command line'); my $stuff_replacement = <<'STUFF_REPLACEMENT'; use MooseX::Declare; class Test { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my %stuff; for my $i (1..5) { $stuff{$i} = $x_var; } } } STUFF_REPLACEMENT eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 15, column => 13, replacement => 'stuff', )->code, $stuff_replacement, 'replace hash' ); test_cli($code, "--RenameVariable --line 15 --column 13 --replacement stuff", $stuff_replacement, 'replace hash on command line'); my $munged = PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 15, column => 13, replacement => 'stuff', ); isa_ok( $munged, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $munged->element, 'PPI::Token::Symbol' ); # tests for camel casing $code = <<'END_CODE'; sub foo { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my $_someVariable = 2; $_someVariable++; } END_CODE my $xvar_replacement = $code; $xvar_replacement =~ s/x_var/xVar/g; # yes, this is simple eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 2, column => 8, to_camel_case => 1, )->code, $xvar_replacement, 'camelCase xVar' ); test_cli($code, "--RenameVariable --line 2 --column 8 --to-camel-case 1", $xvar_replacement, 'camelCase xVar on command line'); $xvar_replacement =~ s/x_?var/XVar/gi; # yes, this is simple eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 2, column => 8, to_camel_case => 1, 'ucfirst' => 1, )->code, $xvar_replacement, 'camelCase xVar (ucfirst)' ); my $yvar_replacement = $code; $yvar_replacement =~ s/_someVariable/_some_variable/g; eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 7, column => 8, from_camel_case => 1, )->code, $yvar_replacement, 'from camelCase _some_variable' ); $yvar_replacement =~ s/_some_variable/_Some_Variable/g; eq_or_diff( PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => 7, column => 8, from_camel_case => 1, 'ucfirst' => 1 )->code, $yvar_replacement, 'from camelCase _some_variable (ucfirst)' ); # exerimental test code for experimental command line tool sub test_cli { my ($original, $params, $expected, $title) = @_; my $file = "$tempdir/source.pl"; open my $out, '>', $file or die; print $out $original; close $out; my $cmd = "$^X -Ilib script/ppix_editortools --inplace $params $file"; #diag $cmd; is system($cmd), 0, 'system'; open my $in, '<', $file or die; my $result = do {local $/ = undef; <$in>; }; close $in; eq_or_diff($result, $expected, $title); } sub read_file { my $file = shift; open my $fh, '<', $file or die; local $/ = undef; my $code = scalar <$fh>; $code =~ s/\xD//g; # remove carrige return return $code; } PPIx-EditorTools-0.18/t/04-renamepackage.t0000644000175000017500000000365111747265241017147 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } plan tests => 5; use PPIx::EditorTools::RenamePackage; my $munged = PPIx::EditorTools::RenamePackage->new->rename( code => "package TestPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", replacement => 'NewPackage' ); isa_ok( $munged, 'PPIx::EditorTools::ReturnObject' ); isa_ok( $munged->element, 'PPI::Statement::Package' ); eq_or_diff( $munged->code, "package NewPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", 'simple package' ); eq_or_diff( $munged->ppi->serialize, "package NewPackage;\nuse strict;\nBEGIN { $^W = 1; }\n1;\n", 'simple package' ); my $code = <<'END_CODE'; use MooseX::Declare; class Test { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my %hash; for my $i (1..5) { $hash{$i} = $x_var; } } } END_CODE my $shiny_replacement = <<'SHINY_REPLACEMENT'; use MooseX::Declare; class NewPackage { has a_var => ( is => 'rw', isa => 'Str' ); has b_var => ( is => 'rw', isa => 'Str' ); method some_method { my $x_var = 1; print "Do stuff with ${x_var}\n"; $x_var += 1; my %hash; for my $i (1..5) { $hash{$i} = $x_var; } } } SHINY_REPLACEMENT TODO: { local $TODO = 'RenamePackage does not support MooseX::Declare yet'; # The unimplemented stuff throws warnings local $^W = 0; my $result = eval { my $munged = PPIx::EditorTools::RenamePackage->new->rename( code => $code, replacement => 'NewPackage', ); $munged->code; }; eq_or_diff( $result, $shiny_replacement, 'replace scalar' ); } PPIx-EditorTools-0.18/t/10-lexer.t0000644000175000017500000001000411747265241015466 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Differences; use PPI; BEGIN { if ( $PPI::VERSION =~ /_/ ) { plan skip_all => "Need released version of PPI. You have $PPI::VERSION"; exit 0; } } my @cases = ( { code => <<'END_CODE', use strict; use warnings; use Abc; my $global = 42; sub qwer { } END_CODE expected => [ [ 'keyword', 1, 1, 3 ], [ 'Whitespace', 1, 4, 1 ], [ 'pragma', 1, 5, 6 ], [ 'Structure', 1, 11, 1 ], [ 'Whitespace', 1, 12, 1 ], [ 'keyword', 1, 13, 3 ], [ 'Whitespace', 1, 16, 1 ], [ 'pragma', 1, 17, 8 ], [ 'Structure', 1, 25, 1 ], [ 'Whitespace', 1, 26, 1 ], [ 'keyword', 2, 1, 3 ], [ 'Whitespace', 2, 4, 1 ], [ 'Word', 2, 5, 3 ], [ 'Structure', 2, 8, 1 ], [ 'Whitespace', 2, 9, 1 ], [ 'Whitespace', 3, 1, 1 ], [ 'keyword', 4, 1, 2 ], [ 'Whitespace', 4, 3, 1 ], [ 'Symbol', 4, 4, 7 ], [ 'Whitespace', 4, 11, 1 ], [ 'Operator', 4, 12, 1 ], [ 'Whitespace', 4, 13, 1 ], [ 'Number', 4, 14, 2 ], [ 'Structure', 4, 16, 1 ], [ 'Whitespace', 4, 17, 1 ], [ 'Whitespace', 5, 1, 1 ], [ 'keyword', 6, 1, 3 ], [ 'Whitespace', 6, 4, 1 ], [ 'Word', 6, 5, 4 ], [ 'Whitespace', 6, 9, 1 ], [ 'Structure', 6, 10, 1 ], [ 'Whitespace', 6, 11, 1 ], [ 'Structure', 7, 1, 1 ], [ 'Whitespace', 7, 2, 1 ], [ 'Whitespace', 8, 1, 1 ], ], }, { code => <<'END_CODE', sub return func method before after around override augment END_CODE expected => [ [ 'keyword', 1, 1, 3 ], [ 'Whitespace', 1, 4, 1 ], [ 'keyword', 1, 5, 6 ], [ 'Whitespace', 1, 11, 1 ], [ 'Word', 1, 12, 4 ], [ 'Whitespace', 1, 16, 1 ], [ 'Word', 1, 17, 6 ], [ 'Whitespace', 1, 23, 1 ], [ 'Word', 1, 24, 6 ], [ 'Whitespace', 1, 30, 1 ], [ 'Word', 1, 31, 5 ], [ 'Whitespace', 1, 36, 1 ], [ 'Word', 1, 37, 6 ], [ 'Whitespace', 1, 43, 1 ], [ 'Word', 1, 44, 8 ], [ 'Whitespace', 1, 52, 1 ], [ 'Word', 1, 53, 7 ], [ 'Whitespace', 1, 60, 1 ], ], }, { code => <<'END_CODE', undef shift defined bless END_CODE expected => [ [ 'core', 1, 1, 5 ], [ 'Whitespace', 1, 6, 1 ], [ 'core', 1, 7, 5 ], [ 'Whitespace', 1, 12, 1 ], [ 'core', 1, 13, 7 ], [ 'Whitespace', 1, 20, 1 ], [ 'core', 1, 21, 5 ], [ 'Whitespace', 1, 26, 1 ], ], }, { code => <<'END_CODE', new END_CODE expected => [ [ 'Word', 1, 1, 3 ], [ 'Whitespace', 1, 4, 1 ], ], }, { code => <<'END_CODE', use no END_CODE expected => [ [ 'keyword', 1, 1, 3 ], [ 'Whitespace', 1, 4, 1 ], [ 'keyword', 1, 5, 2 ], [ 'Whitespace', 1, 7, 1 ], ], }, { code => <<'END_CODE', my local our END_CODE expected => [ [ 'keyword', 1, 1, 2 ], [ 'Whitespace', 1, 3, 1 ], [ 'keyword', 1, 4, 5 ], [ 'Whitespace', 1, 9, 1 ], [ 'keyword', 1, 10, 3 ], [ 'Whitespace', 1, 13, 1 ], ], }, { code => <<'END_CODE', if else elsif unless for foreach while my END_CODE expected => [ [ 'keyword', 1, 1, 2 ], [ 'Whitespace', 1, 3, 1 ], [ 'keyword', 1, 4, 4 ], [ 'Whitespace', 1, 8, 1 ], [ 'keyword', 1, 9, 5 ], [ 'Whitespace', 1, 14, 1 ], [ 'keyword', 1, 15, 6 ], [ 'Whitespace', 1, 21, 1 ], [ 'keyword', 1, 22, 3 ], [ 'Whitespace', 1, 25, 1 ], [ 'keyword', 1, 26, 7 ], [ 'Whitespace', 1, 33, 1 ], [ 'keyword', 1, 34, 5 ], [ 'Whitespace', 1, 39, 1 ], [ 'keyword', 1, 40, 2 ], [ 'Whitespace', 1, 42, 1 ], ], }, { code => <<'END_CODE', package END_CODE expected => [ [ 'keyword', 1, 1, 7 ], [ 'Whitespace', 1, 8, 1 ], ], }, ); plan tests => @cases * 1; use PPIx::EditorTools::Lexer; my @result; foreach my $c (@cases) { @result = (); PPIx::EditorTools::Lexer->new->lexer( code => $c->{code}, highlighter => \&highlighter ); #diag explain @result; is_deeply \@result, $c->{expected} or diag explain @result; } sub highlighter { push @result, [@_]; } PPIx-EditorTools-0.18/t/00-ppix-editortools.t0000644000175000017500000000620311747265241017701 0ustar gaborgabor#!/usr/bin/perl use strict; BEGIN { $^W = 1; } use Test::More; use Test::Exception; my @classes = ( 'PPIx::EditorTools', 'PPIx::EditorTools::FindUnmatchedBrace', 'PPIx::EditorTools::FindVariableDeclaration', 'PPIx::EditorTools::IntroduceTemporaryVariable', 'PPIx::EditorTools::RenamePackage', 'PPIx::EditorTools::RenamePackageFromPath', 'PPIx::EditorTools::RenameVariable', 'PPIx::EditorTools::FindUnmatchedBrace', 'PPIx::EditorTools::Outline', 'PPIx::EditorTools::Lexer', 'PPIx::EditorTools::ReturnObject', ); my @subs = qw( new code ppi process_doc find_unmatched_brace get_all_variable_declarations element_depth find_token_at_location find_variable_declaration ); plan tests => 14 + @subs + 2 * @classes; foreach my $class (@classes) { require_ok($class); my $test_object = new_ok($class); } use_ok( 'PPIx::EditorTools', @subs ); foreach my $subs (@subs) { can_ok( 'PPIx::EditorTools', $subs ); } #TODO need more pkg tests ####### # Testing PPIx::EditorTools->process_doc() ####### # Check that something died - we do not care why dies_ok { PPIx::EditorTools->process_doc() } 'expecting PPIx::EditorTools->process_doc() to die'; # check code to ppi my @test_files = ( 't/outline/Foo.pm', 't/outline/file1.pl', 't/outline/file2.pl', 't/outline/Mooclass.pm', 't/outline/Moorole.pm', 't/outline/Moofirst.pm', ); my $obj = PPIx::EditorTools->new(); $obj->ppi(undef); $obj->code(undef); foreach my $file (@test_files) { my $code = do { open my $fh, '<', $file or die "Could not open '$file' $!"; local $/ = undef; <$fh>; }; ok( $obj->process_doc( code => $code ), "process_doc(code) from $file" ); } ## check ppi source my %ppi = ( 'attributes' => [ { 'line' => 7, 'name' => 'balance', }, { 'line' => 13, 'name' => 'overdraft', }, { 'line' => 23, 'name' => 'name', }, { 'line' => 25, 'name' => 'account', }, ], 'line' => 3, 'methods' => [ { 'line' => 27, 'name' => '_build_overdraft', }, ], 'modules' => [ { 'line' => 1, 'name' => 'MooseX::Declare', }, ], 'name' => 'Moofirst', 'pragmata' => [ { 'line' => 5, 'name' => 'version', }, ], ); $obj->ppi('PPI::Document'); $obj->code(undef); ok( $obj->process_doc(%ppi), 'process_doc(ppi)' ); ## check neither ppi or code fails $obj->ppi(undef); $obj->code(undef); my %case = ( one => 'ppi', two => 'code', three => 'PPI::Document', ); throws_ok { $obj->process_doc(%case) } '/arguments ppi or code required/', 'arguments ppi or code required'; #TODO add more tests dies_ok { PPIx::EditorTools->find_unmatched_brace() } 'expecting PPIx::EditorTools->find_unmatched_brace() to die'; #TODO add more tests dies_ok { PPIx::EditorTools->get_all_variable_declarations() } 'expecting PPIx::EditorTools->get_all_variable_declarations() to die'; #TODO add more tests dies_ok { PPIx::EditorTools->element_depth() } 'expecting PPIx::EditorTools->element_depth() to die'; #TODO add more tests dies_ok { PPIx::EditorTools->find_token_at_location() } 'expecting PPIx::EditorTools->find_token_at_location() to die'; #dies_ok { PPIx::EditorTools->find_variable_declaration() } 'expecting PPIx::EditorTools->find_variable_declaration() to die'; PPIx-EditorTools-0.18/script/0000755000175000017500000000000012040433503014773 5ustar gaborgaborPPIx-EditorTools-0.18/script/ppix_editortools0000644000175000017500000000267411747265241020355 0ustar gaborgabor#!/usr/bin/perl use strict; use warnings; use Getopt::Long qw(GetOptions); use Pod::Usage qw(pod2usage); # This is a command line script to use the capabilities of this package # with a temporary API and a temporary name! pod2usage() if not @ARGV; my %opt; GetOptions(\%opt, 'inplace', 'RenameVariable', 'line=i', 'column=i', 'replacement=s', 'to-camel-case=s', 'help', ) or pod2usage(); pod2usage() if $opt{help}; if ($opt{RenameVariable}) { require PPIx::EditorTools::RenameVariable; my $file = shift @ARGV; my $code = read_file($file); my %param; if (exists $opt{replacement}) { $param{replacement} = $opt{replacement}; } elsif (exists $opt{'to-camel-case'}) { $param{'to_camel_case'} = $opt{'to-camel-case'}; } else { die 'Need eiher replacement or to-camel-case'; } my $result = PPIx::EditorTools::RenameVariable->new->rename( code => $code, line => $opt{line}, column => $opt{column}, %param, )->code; ; write_file($file, $result); } else { pod2usage(); } exit; sub read_file { my ($file) = @_; open my $in, '<', $file or die "Could not open file '$file' for reading: $!"; local $/ = undef; return <$in>; } sub write_file { my ($file, $data) = @_; open my $out, '>', $file or die; print $out $data; } =head1 NAME ppix_editortools - command line interface for the PPIx::EditorTools =head1 SYNOPSIS --RenameVariable --line 8 column 12 --replacement NEW_NAME --inplace =cut PPIx-EditorTools-0.18/META.yml0000644000175000017500000000203412040433415014741 0ustar gaborgabor--- abstract: 'Utility methods and base class for manipulating Perl via PPI' author: - 'Steffen Mueller C' - 'Repackaged by Mark Grimes C' - 'Ahmad M. Zawawi ' build_requires: ExtUtils::MakeMaker: 6.59 File::Find: 0 File::Temp: 0 Test::Differences: 0 Test::More: 0.88 Test::Most: 0 Test::NoWarnings: 0.084 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: PPIx-EditorTools no_index: directory: - inc - t requires: Carp: 0 Class::XSAccessor: 1.02 File::Basename: 0 File::Spec: 0 PPI: 1.215 PPI::Find: 0 Try::Tiny: 0.11 perl: 5.008005 resources: bugtracker: http://padre.perlide.org/trac/ homepage: http://padre.perlide.org/ license: http://dev.perl.org/licenses/ repository: http://svn.perlide.org/padre/trunk/PPIx-EditorTools/ version: 0.18