├── xt ├── perlcriticrc └── perlcritic.t ├── t ├── data │ ├── hello_world │ │ └── hello_world.pl │ ├── dinner │ │ ├── dinner.pl │ │ ├── t │ │ │ ├── 001-my-food._t │ │ │ └── My-Food._t │ │ └── lib │ │ │ └── My │ │ │ ├── Food.pm │ │ │ └── Human.pm │ └── inherit │ │ └── inherit.pl ├── App-PRT.t ├── test.t ├── App-PRT-Command-Help.t ├── test.pm ├── App-PRT-Collector-Files.t ├── App-PRT-Command-DeleteMethod.t ├── App-PRT-Command-ReplaceToken.t ├── App-PRT-CLI.t └── App-PRT-Command-RenameClass.t ├── minil.toml ├── .gitignore ├── .travis.yml ├── lib └── App │ ├── PRT │ ├── Collector │ │ └── Files.pm │ ├── Command │ │ ├── Help.pm │ │ ├── ReplaceToken.pm │ │ ├── DeleteMethod.pm │ │ └── RenameClass.pm │ └── CLI.pm │ └── PRT.pm ├── Changes ├── cpanfile ├── README.md ├── bin └── prt ├── Build.PL ├── META.json └── LICENSE /xt/perlcriticrc: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /t/data/hello_world/hello_world.pl: -------------------------------------------------------------------------------- 1 | print "Hello, World!\n"; 2 | -------------------------------------------------------------------------------- /minil.toml: -------------------------------------------------------------------------------- 1 | name = "App-PRT" 2 | badges = ["travis", "coveralls"] 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /App-PRT-* 2 | /.build 3 | /_build_params 4 | /Build 5 | /Build.bat 6 | !Build/ 7 | !META.json 8 | !LICENSE 9 | -------------------------------------------------------------------------------- /t/data/dinner/dinner.pl: -------------------------------------------------------------------------------- 1 | use strict; 2 | use warnings; 3 | use lib 'lib'; 4 | 5 | use My::Human; 6 | use My::Food; 7 | 8 | my $human = My::Human->new('Alice'); 9 | my $food = My::Food->new('Pizza'); 10 | 11 | $human->eat($food); 12 | -------------------------------------------------------------------------------- /t/App-PRT.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT'; 8 | } 9 | 10 | sub welcome : Tests { 11 | is App::PRT->welcome, 'welcome!!!!'; 12 | } 13 | -------------------------------------------------------------------------------- /xt/perlcritic.t: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use Test::More; 5 | eval { 6 | require Test::Perl::Critic; 7 | Test::Perl::Critic->import( -profile => 'xt/perlcriticrc' ); 8 | }; 9 | plan skip_all => "Test::Perl::Critic is not installed." if $@; 10 | all_critic_ok('lib'); 11 | -------------------------------------------------------------------------------- /t/data/dinner/t/001-my-food._t: -------------------------------------------------------------------------------- 1 | use Test::More tests => 5; 2 | 3 | use_ok 'My::Food'; 4 | require_ok 'My::Food'; 5 | 6 | new_ok 'My::Food'; 7 | isa_ok My::Food->new, 'My::Food'; 8 | 9 | subtest 'name' => sub { 10 | my $pizza = My::Food->new('Pizza'); 11 | is $pizza->name, 'Pizza'; 12 | }; 13 | -------------------------------------------------------------------------------- /t/data/dinner/lib/My/Food.pm: -------------------------------------------------------------------------------- 1 | package My::Food; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, $name) = @_; 7 | 8 | bless { 9 | name => $name, 10 | }, $class; 11 | } 12 | 13 | sub name { 14 | my ($self) = @_; 15 | 16 | $self->{name}; 17 | } 18 | 19 | 1; 20 | -------------------------------------------------------------------------------- /t/data/inherit/inherit.pl: -------------------------------------------------------------------------------- 1 | package Child1 { 2 | use DateTime; 3 | use utf8; 4 | use parent 'Parent'; 5 | }; 6 | 7 | package Child2 { 8 | use parent qw(Parent AnotherParent YetAnother::Parent); 9 | }; 10 | 11 | package Child3 { 12 | use base 'Parent'; 13 | }; 14 | 15 | package GrandChild { 16 | use base 'Child'; 17 | }; 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - 5.10 4 | - 5.12 5 | - 5.14 6 | - 5.16 7 | - 5.18 8 | after_success: 9 | - cpanm --quiet --notest --skip-satisfied Devel::Cover::Report::Coveralls 10 | - cover -delete 11 | - perl Build.PL && ./Build build && HARNESS_PERL_SWITCHES="-MDevel::Cover=+ignore,inc" PERL5LIB="lib" prove t/ 12 | - cover -report coveralls 13 | -------------------------------------------------------------------------------- /t/data/dinner/t/My-Food._t: -------------------------------------------------------------------------------- 1 | package t::My::Food; 2 | use base qw(Test::Class); 3 | use Test::More; 4 | 5 | sub _load : Test(startup => 1) { 6 | use_ok 'My::Food'; 7 | } 8 | 9 | sub instantiate : Test(1) { 10 | isa_ok My::Food->new('banana'), 'My::Food'; 11 | } 12 | 13 | sub name : Test(1) { 14 | my $food = My::Food->new('banana'); 15 | is $food->name, 'banana'; 16 | } 17 | 18 | __PACKAGE__->runtests; 19 | -------------------------------------------------------------------------------- /t/data/dinner/lib/My/Human.pm: -------------------------------------------------------------------------------- 1 | package My::Human; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, $name) = @_; 7 | 8 | bless { 9 | name => $name, 10 | }, $class; 11 | } 12 | 13 | sub name { 14 | my ($self) = @_; 15 | 16 | $self->{name}; 17 | } 18 | 19 | sub eat { 20 | my ($self, $food) = @_; 21 | 22 | print "@{[ $self->name ]} is eating @{[ $food->name ]}.\n"; 23 | } 24 | 25 | 1; 26 | -------------------------------------------------------------------------------- /lib/App/PRT/Collector/Files.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::Collector::Files; 2 | use strict; 3 | use warnings; 4 | 5 | sub new { 6 | my ($class, @files) = @_; 7 | bless { 8 | files => [@files], 9 | }, $class; 10 | } 11 | 12 | sub collect { 13 | my ($self) = @_; 14 | 15 | for my $file (@{$self->{files}}) { 16 | die "$file does not exist" unless -f $file; 17 | } 18 | 19 | $self->{files}; 20 | } 21 | 22 | 1; 23 | -------------------------------------------------------------------------------- /t/test.t: -------------------------------------------------------------------------------- 1 | package t::TestForTest; 2 | use t::test; 3 | 4 | sub _prepare_test_code : Tests { 5 | subtest 'valid input' => sub { 6 | my $directory = t::test::prepare_test_code('hello_world'); 7 | 8 | ok $directory; 9 | ok -d $directory, 'directory exists'; 10 | 11 | ok -f "$directory/hello_world.pl", 'hello_world.pl exists'; 12 | }; 13 | 14 | subtest 'valid input' => sub { 15 | ok exception { 16 | t::test::prepare_test_code('not_defined_name'); 17 | }, 'dies when specified code is not prepared' 18 | }; 19 | } 20 | -------------------------------------------------------------------------------- /Changes: -------------------------------------------------------------------------------- 1 | Revision history for Perl extension App-PRT 2 | 3 | {{$NEXT}} 4 | 5 | 0.07 2014-03-28T08:44:39Z 6 | 7 | - Fix a typo 8 | 9 | 0.06 2014-03-28T07:21:49Z 10 | 11 | - Fix a bug 12 | 13 | 0.05 2014-03-28T07:12:05Z 14 | 15 | - Improve renaming behavior 16 | 17 | 0.04 2014-03-25T04:46:18Z 18 | 19 | - Various fixes by moznion 20 | 21 | 0.03 2014-03-25T03:19:54Z 22 | 23 | - Remove cpanfile.snapshot 24 | 25 | 0.02 2014-03-25T03:16:37Z 26 | 27 | - FAKE_RELEASE succeed at version 0.01 28 | 29 | 0.01 2014-03-25T03:04:47Z 30 | 31 | - original version 32 | 33 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'perl', '5.010001'; 2 | requires 'Class::Load'; 3 | requires 'Getopt::Long', '2.42'; 4 | requires 'PPI'; 5 | requires 'Path::Class'; 6 | 7 | on configure => sub { 8 | requires 'CPAN::Meta'; 9 | requires 'CPAN::Meta::Prereqs'; 10 | requires 'Module::Build'; 11 | }; 12 | 13 | on 'test' => sub { 14 | requires 'Test::More', '0.98'; 15 | requires 'Test::Class'; 16 | requires 'Test::Fatal'; 17 | requires 'Test::Deep'; 18 | requires 'Test::Mock::Guard'; 19 | requires 'Path::Class'; 20 | requires 'File::Temp'; 21 | requires 'File::Copy::Recursive'; 22 | requires 'parent'; 23 | }; 24 | 25 | on develop => sub { 26 | requires 'Test::Perl::Critic'; 27 | }; 28 | -------------------------------------------------------------------------------- /t/App-PRT-Command-Help.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::Command::Help; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::Command::Help'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::Command::Help->new, 'App::PRT::Command::Help'; 12 | } 13 | 14 | sub handle_files : Tests { 15 | ok ! App::PRT::Command::Help->handle_files, "Help doesn't handle files"; 16 | } 17 | 18 | sub execute : Tests { 19 | my $command = App::PRT::Command::Help->new; 20 | 21 | ok $command->execute; 22 | } 23 | 24 | sub parse_arguments : Tests { 25 | my $command = App::PRT::Command::Help->new; 26 | my $args = [qw(foo bar bazz)]; 27 | cmp_deeply [$command->parse_arguments(@$args)], $args, 'NOP'; 28 | } 29 | -------------------------------------------------------------------------------- /lib/App/PRT/Command/Help.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::Command::Help; 2 | use strict; 3 | use warnings; 4 | use PPI; 5 | 6 | sub new { 7 | my ($class) = @_; 8 | bless {}, $class; 9 | } 10 | 11 | sub handle_files { 0 } 12 | 13 | sub parse_arguments { 14 | my ($self, @args) = @_; 15 | # NOP 16 | @args; 17 | } 18 | 19 | sub execute { 20 | my ($self) = @_; 21 | 22 | print $self->help_message; 23 | } 24 | 25 | sub help_message { 26 | return < 28 | 29 | Examples: 30 | prt replace_token foo bar *.pm 31 | replace tokens with content 'foo' with 'bar' in *.pm. 32 | prt rename_class Foo Bar lib/*.pm 33 | Rename Foo class to Bar. This command will rename lib/Foo.pm to lib/Bar.pm. 34 | HELP 35 | } 36 | 37 | 38 | 1; 39 | -------------------------------------------------------------------------------- /lib/App/PRT.pm: -------------------------------------------------------------------------------- 1 | package App::PRT; 2 | use strict; 3 | use warnings; 4 | use 5.010001; 5 | 6 | our $VERSION = "0.07"; 7 | 8 | sub welcome { 9 | 'welcome!!!!'; 10 | } 11 | 12 | 1; 13 | __END__ 14 | 15 | =encoding utf-8 16 | 17 | =head1 NAME 18 | 19 | App::PRT - Command line Perl Refactoring Tool 20 | 21 | =head1 SYNOPSIS 22 | 23 | use App::PRT::CLI; 24 | my $cli = App::PRT::CLI->new; 25 | $cli->parse(@ARGV); 26 | $cli->run; 27 | 28 | =head1 DESCRIPTION 29 | 30 | App::PRT is command line tools for Refactoring Perl. 31 | 32 | =head1 SEE ALSO 33 | 34 | L 35 | 36 | =head1 LICENSE 37 | 38 | Copyright (C) hitode909. 39 | 40 | This library is free software; you can redistribute it and/or modify 41 | it under the same terms as Perl itself. 42 | 43 | =head1 AUTHOR 44 | 45 | hitode909 Ehitode909@gmail.comE 46 | 47 | =cut 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | [![Build Status](https://travis-ci.org/hitode909/App-PRT.png?branch=master)](https://travis-ci.org/hitode909/App-PRT) [![Coverage Status](https://coveralls.io/repos/hitode909/App-PRT/badge.png?branch=master)](https://coveralls.io/r/hitode909/App-PRT?branch=master) 2 | # NAME 3 | 4 | App::PRT - Command line Perl Refactoring Tool 5 | 6 | # SYNOPSIS 7 | 8 | use App::PRT::CLI; 9 | my $cli = App::PRT::CLI->new; 10 | $cli->parse(@ARGV); 11 | $cli->run; 12 | 13 | # DESCRIPTION 14 | 15 | App::PRT is command line tools for Refactoring Perl. 16 | 17 | # SEE ALSO 18 | 19 | [prt](https://metacpan.org/pod/prt) 20 | 21 | # LICENSE 22 | 23 | Copyright (C) hitode909. 24 | 25 | This library is free software; you can redistribute it and/or modify 26 | it under the same terms as Perl itself. 27 | 28 | # AUTHOR 29 | 30 | hitode909 31 | -------------------------------------------------------------------------------- /bin/prt: -------------------------------------------------------------------------------- 1 | #!perl 2 | 3 | use strict; 4 | use warnings; 5 | use App::PRT::CLI; 6 | 7 | my $cli = App::PRT::CLI->new; 8 | $cli->parse(@ARGV); 9 | $cli->run; 10 | __END__ 11 | 12 | =encoding utf-8 13 | 14 | =head1 NAME 15 | 16 | prt - Command line frontend of App::PRT 17 | 18 | =head1 SYNOPSIS 19 | 20 | $ prt 21 | 22 | =head1 DESCRIPTION 23 | 24 | prt is the command line frontend of L. 25 | 26 | =head1 SUBCOMMANDS 27 | 28 | =over 4 29 | 30 | =item * replace_token 31 | 32 | Replace C token with C. 33 | 34 | prt replace_token foo bar path/**/**.pm 35 | 36 | =item * rename_class 37 | 38 | Rename C class to C class. 39 | 40 | prt rename_class Foo Bar lib/**/**.pm 41 | 42 | =item * delete_method 43 | 44 | Delete C method from C class. 45 | 46 | prt delete_method Food eat lib/**/**.pm 47 | 48 | =back 49 | 50 | =head1 LICENSE 51 | 52 | Copyright (C) hitode909. 53 | 54 | This library is free software; you can redistribute it and/or modify 55 | it under the same terms as Perl itself. 56 | 57 | =head1 AUTHOR 58 | 59 | hitode909 Ehitode909@gmail.comE 60 | 61 | =cut 62 | -------------------------------------------------------------------------------- /t/test.pm: -------------------------------------------------------------------------------- 1 | package t::test; 2 | 3 | use strict; 4 | use warnings; 5 | use utf8; 6 | 7 | use Path::Class; 8 | use lib file(__FILE__)->dir->parent->subdir('lib')->stringify; 9 | 10 | use File::Temp qw(tempdir); 11 | use File::Copy::Recursive; 12 | 13 | # use Exporter::Lite (); 14 | 15 | our @EXPORT = qw( 16 | create_hello_world 17 | ); 18 | 19 | sub import { 20 | my ($class) = @_; 21 | 22 | strict->import; 23 | utf8->import; 24 | warnings->import; 25 | 26 | my ($package, $file) = caller; 27 | 28 | my $code = qq[ 29 | package $package; 30 | use strict; 31 | use warnings; 32 | use utf8; 33 | 34 | use parent qw(Test::Class); 35 | use Test::More; 36 | use Test::Fatal; 37 | use Test::Deep; 38 | use Test::Mock::Guard; 39 | 40 | use Path::Class; 41 | 42 | END { $package->runtests } 43 | ]; 44 | 45 | eval $code; 46 | die $@ if $@; 47 | } 48 | 49 | sub prepare_test_code { 50 | my ($name) = @_; 51 | 52 | my $base_directory = file(__FILE__)->dir->subdir('data', $name); 53 | my $tmpdir = tempdir; 54 | 55 | unless (-d $base_directory) { 56 | die "$name is not defined"; 57 | } 58 | 59 | File::Copy::Recursive::dircopy($base_directory, $tmpdir); 60 | $tmpdir; 61 | } 62 | 63 | 1; 64 | -------------------------------------------------------------------------------- /t/App-PRT-Collector-Files.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::Collector::Files; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::Collector::Files'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::Collector::Files->new, 'App::PRT::Collector::Files'; 12 | } 13 | 14 | sub collect : Tests { 15 | my $directory = t::test::prepare_test_code('hello_world'); 16 | 17 | subtest 'when no files specified' => sub { 18 | my $collector = App::PRT::Collector::Files->new; 19 | is_deeply $collector->collect, []; 20 | }, 'result is empty'; 21 | 22 | subtest 'when files specified' => sub { 23 | my $collector = App::PRT::Collector::Files->new("$directory/hello_world.pl"); 24 | is_deeply $collector->collect, ["$directory/hello_world.pl"]; 25 | }, 'specified files returned'; 26 | 27 | subtest 'when not existing file specified' => sub { 28 | my $collector = App::PRT::Collector::Files->new("$directory/not_existd.pl"); 29 | ok exception { 30 | $collector->collect; 31 | }, 'died'; 32 | }; 33 | } 34 | 35 | sub collect_multi_files: Tests { 36 | my $directory = t::test::prepare_test_code('dinner'); 37 | 38 | my $files = [ 39 | "$directory/dinner.pl", 40 | "$directory/lib/My/Food.pm", 41 | "$directory/lib/My/Human.pm", 42 | ]; 43 | 44 | my $collector = App::PRT::Collector::Files->new(@$files); 45 | is_deeply $collector->collect, $files, 'specified files are returned'; 46 | 47 | } 48 | -------------------------------------------------------------------------------- /lib/App/PRT/CLI.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::CLI; 2 | use strict; 3 | use warnings; 4 | 5 | use Class::Load qw(load_class); 6 | use Getopt::Long qw(GetOptionsFromArray); 7 | use App::PRT::Collector::Files; 8 | 9 | sub new { 10 | my ($class) = @_; 11 | 12 | bless {}, $class; 13 | } 14 | 15 | sub parse { 16 | my ($self, @args) = @_; 17 | 18 | my $command = shift @args || 'help'; 19 | 20 | my $command_class = $self->_command_name_to_command_class($command); 21 | load_class $command_class; 22 | $self->{command} = $command_class->new; 23 | 24 | my @rest_args = $self->{command}->parse_arguments(@args); 25 | 26 | if ($self->{command}->handle_files) { 27 | $self->{collector} = App::PRT::Collector::Files->new(@rest_args); 28 | } 29 | 30 | 1; 31 | } 32 | 33 | sub run { 34 | my ($self) = @_; 35 | 36 | if ($self->command->handle_files) { 37 | $self->_run_for_each_files; 38 | } else { 39 | # just run 40 | $self->command->execute; 41 | } 42 | } 43 | 44 | sub _run_for_each_files { 45 | my ($self) = @_; 46 | 47 | my $collector = $self->collector; 48 | my $command = $self->command; 49 | 50 | for my $file (@{$collector->collect}) { 51 | $command->execute($file); 52 | } 53 | } 54 | 55 | sub command { 56 | my ($self) = @_; 57 | 58 | $self->{command}; 59 | } 60 | 61 | sub collector { 62 | my ($self) = @_; 63 | 64 | $self->{collector}; 65 | } 66 | 67 | sub _command_name_to_command_class { 68 | my ($self, $name) = @_; 69 | 70 | my $command_class = join '', map { ucfirst } split '_', $name; 71 | 72 | 'App::PRT::Command::' . $command_class; 73 | } 74 | 75 | 1; 76 | -------------------------------------------------------------------------------- /lib/App/PRT/Command/ReplaceToken.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::Command::ReplaceToken; 2 | use strict; 3 | use warnings; 4 | use PPI; 5 | 6 | sub new { 7 | my ($class) = @_; 8 | bless { 9 | rules => {}, 10 | }, $class; 11 | } 12 | 13 | sub handle_files { 1 } 14 | 15 | # parse arguments from CLI 16 | # arguments: 17 | # @arguments 18 | # returns: 19 | # @rest_arguments 20 | sub parse_arguments { 21 | my ($self, @arguments) = @_; 22 | 23 | die "source and destination tokens required" unless @arguments >= 2; 24 | 25 | $self->register(shift @arguments => shift @arguments); 26 | 27 | @arguments; 28 | } 29 | 30 | # register a replacing rule 31 | # arguments: 32 | # $source: source token 33 | # $dest: destination token 34 | # discussions: 35 | # should consider utf-8 flag ? 36 | sub register { 37 | my ($self, $source, $dest) = @_; 38 | 39 | $self->rules->{$source} = $dest; 40 | } 41 | 42 | # return replacing rules 43 | # returns: 44 | # { source => destination } 45 | sub rules { 46 | my ($self) = @_; 47 | 48 | $self->{rules}; 49 | } 50 | 51 | # find a destination token for a source token 52 | # returns: 53 | # destination token (when regstered) 54 | # undef (when not registered) 55 | sub rule { 56 | my ($self, $source) = @_; 57 | 58 | $self->rules->{$source}; 59 | } 60 | 61 | # refactor a file 62 | # argumensts: 63 | # $file: filename for refactoring 64 | sub execute { 65 | my ($self, $file) = @_; 66 | 67 | my $document = PPI::Document->new($file); 68 | 69 | my $tokens = $document->find('PPI::Token'); 70 | 71 | for my $token (@$tokens) { 72 | my $dest = $self->rule($token->content); 73 | next unless defined $dest; 74 | $token->set_content($dest); 75 | } 76 | 77 | $document->save($file); 78 | } 79 | 80 | 1; 81 | -------------------------------------------------------------------------------- /lib/App/PRT/Command/DeleteMethod.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::Command::DeleteMethod; 2 | use strict; 3 | use warnings; 4 | use PPI; 5 | 6 | sub new { 7 | my ($class) = @_; 8 | bless {}, $class; 9 | } 10 | 11 | sub handle_files { 1 } 12 | 13 | # parse arguments from CLI 14 | # arguments: 15 | # @arguments 16 | # returns: 17 | # @rest_arguments 18 | sub parse_arguments { 19 | my ($self, @arguments) = @_; 20 | 21 | die "class and method required" unless @arguments >= 2; 22 | 23 | $self->register(shift @arguments => shift @arguments); 24 | 25 | @arguments; 26 | } 27 | 28 | # register a replacing rule 29 | # arguments: 30 | # $target_class_name: Target Class Name 31 | # $target_method_name: Target Method Name 32 | sub register { 33 | my ($self, $target_class_name, $target_method_name) = @_; 34 | 35 | $self->{target_class_name} = $target_class_name; 36 | $self->{target_method_name} = $target_method_name; 37 | } 38 | 39 | sub target_class_name { 40 | my ($self) = @_; 41 | 42 | $self->{target_class_name}; 43 | } 44 | 45 | sub target_method_name { 46 | my ($self) = @_; 47 | 48 | $self->{target_method_name}; 49 | } 50 | 51 | # refactor a file 52 | # argumensts: 53 | # $file: filename for refactoring 54 | # todo: 55 | # - normalize new-lines, eg. \n\n\n to \n 56 | sub execute { 57 | my ($self, $file) = @_; 58 | 59 | my $document = PPI::Document->new($file); 60 | 61 | my $package = $document->find_first('PPI::Statement::Package'); 62 | 63 | return unless $package; 64 | return unless $package->namespace eq $self->target_class_name; 65 | 66 | my $subs = $document->find('PPI::Statement::Sub'); 67 | 68 | my $replaced = 0; 69 | for my $sub (@$subs) { 70 | next unless $sub->name eq $self->target_method_name; 71 | $sub->remove; 72 | $replaced++; 73 | } 74 | 75 | $document->save($file) if $replaced; 76 | } 77 | 78 | 1; 79 | -------------------------------------------------------------------------------- /Build.PL: -------------------------------------------------------------------------------- 1 | # ========================================================================= 2 | # THIS FILE IS AUTOMATICALLY GENERATED BY MINILLA. 3 | # DO NOT EDIT DIRECTLY. 4 | # ========================================================================= 5 | 6 | use 5.008_001; 7 | 8 | use strict; 9 | use warnings; 10 | use utf8; 11 | 12 | use Module::Build; 13 | use File::Basename; 14 | use File::Spec; 15 | use CPAN::Meta; 16 | use CPAN::Meta::Prereqs; 17 | 18 | my %args = ( 19 | license => 'perl', 20 | dynamic_config => 0, 21 | 22 | configure_requires => { 23 | 'Module::Build' => 0.38, 24 | }, 25 | 26 | name => 'App-PRT', 27 | module_name => 'App::PRT', 28 | allow_pureperl => 0, 29 | 30 | script_files => [glob('script/*'), glob('bin/*')], 31 | c_source => [qw()], 32 | PL_files => {}, 33 | 34 | test_files => ((-d '.git' || $ENV{RELEASE_TESTING}) && -d 'xt') ? 't/ xt/' : 't/', 35 | recursive_test_files => 1, 36 | 37 | 38 | ); 39 | if (-d 'share') { 40 | $args{share_dir} = 'share'; 41 | } 42 | 43 | my $builder = Module::Build->subclass( 44 | class => 'MyBuilder', 45 | code => q{ 46 | sub ACTION_distmeta { 47 | die "Do not run distmeta. Install Minilla and `minil install` instead.\n"; 48 | } 49 | sub ACTION_installdeps { 50 | die "Do not run installdeps. Run `cpanm --installdeps .` instead.\n"; 51 | } 52 | } 53 | )->new(%args); 54 | $builder->create_build_script(); 55 | 56 | my $mbmeta = CPAN::Meta->load_file('MYMETA.json'); 57 | my $meta = CPAN::Meta->load_file('META.json'); 58 | my $prereqs_hash = CPAN::Meta::Prereqs->new( 59 | $meta->prereqs 60 | )->with_merged_prereqs( 61 | CPAN::Meta::Prereqs->new($mbmeta->prereqs) 62 | )->as_string_hash; 63 | my $mymeta = CPAN::Meta->new( 64 | { 65 | %{$meta->as_struct}, 66 | prereqs => $prereqs_hash 67 | } 68 | ); 69 | print "Merging cpanfile prereqs to MYMETA.yml\n"; 70 | $mymeta->save('MYMETA.yml', { version => 1.4 }); 71 | print "Merging cpanfile prereqs to MYMETA.json\n"; 72 | $mymeta->save('MYMETA.json', { version => 2 }); 73 | -------------------------------------------------------------------------------- /META.json: -------------------------------------------------------------------------------- 1 | { 2 | "abstract" : "Command line Perl Refactoring Tool", 3 | "author" : [ 4 | "This library is free software; you can redistribute it and/or modify" 5 | ], 6 | "dynamic_config" : 0, 7 | "generated_by" : "Minilla/v0.12.0, CPAN::Meta::Converter version 2.133380", 8 | "license" : [ 9 | "perl_5" 10 | ], 11 | "meta-spec" : { 12 | "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", 13 | "version" : "2" 14 | }, 15 | "name" : "App-PRT", 16 | "no_index" : { 17 | "directory" : [ 18 | "t", 19 | "xt", 20 | "inc", 21 | "share", 22 | "eg", 23 | "examples", 24 | "author", 25 | "builder" 26 | ] 27 | }, 28 | "prereqs" : { 29 | "configure" : { 30 | "requires" : { 31 | "CPAN::Meta" : "0", 32 | "CPAN::Meta::Prereqs" : "0", 33 | "Module::Build" : "0.38" 34 | } 35 | }, 36 | "develop" : { 37 | "requires" : { 38 | "Test::CPAN::Meta" : "0", 39 | "Test::MinimumVersion" : "0.10108", 40 | "Test::Perl::Critic" : "0", 41 | "Test::Pod" : "1.41", 42 | "Test::Spellunker" : "v0.2.7" 43 | } 44 | }, 45 | "runtime" : { 46 | "requires" : { 47 | "Class::Load" : "0", 48 | "Getopt::Long" : "2.42", 49 | "PPI" : "0", 50 | "Path::Class" : "0", 51 | "perl" : "5.010001" 52 | } 53 | }, 54 | "test" : { 55 | "requires" : { 56 | "File::Copy::Recursive" : "0", 57 | "File::Temp" : "0", 58 | "Path::Class" : "0", 59 | "Test::Class" : "0", 60 | "Test::Deep" : "0", 61 | "Test::Fatal" : "0", 62 | "Test::Mock::Guard" : "0", 63 | "Test::More" : "0.98", 64 | "parent" : "0" 65 | } 66 | } 67 | }, 68 | "release_status" : "unstable", 69 | "resources" : { 70 | "bugtracker" : { 71 | "web" : "https://github.com/hitode909/App-PRT/issues" 72 | }, 73 | "homepage" : "https://github.com/hitode909/App-PRT", 74 | "repository" : { 75 | "type" : "git", 76 | "url" : "git://github.com/hitode909/App-PRT.git", 77 | "web" : "https://github.com/hitode909/App-PRT" 78 | } 79 | }, 80 | "version" : "0.07", 81 | "x_contributors" : [ 82 | "moznion ", 83 | "hitode909 " 84 | ] 85 | } 86 | -------------------------------------------------------------------------------- /t/App-PRT-Command-DeleteMethod.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::Command::DeleteMethod; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::Command::DeleteMethod'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::Command::DeleteMethod->new, 'App::PRT::Command::DeleteMethod'; 12 | } 13 | 14 | sub handle_files : Tests { 15 | ok App::PRT::Command::DeleteMethod->handle_files, 'DeleteMethod handles files'; 16 | } 17 | 18 | sub register : Tests { 19 | my $command = App::PRT::Command::DeleteMethod->new; 20 | 21 | $command->register('My::Food' => 'name'); 22 | 23 | is $command->target_class_name, 'My::Food'; 24 | is $command->target_method_name, 'name'; 25 | } 26 | 27 | sub parse_arguments : Tests { 28 | subtest "when class and method specified" => sub { 29 | my $command = App::PRT::Command::DeleteMethod->new; 30 | my @args = qw(Class method a.pl lib/B.pm); 31 | 32 | 33 | my @args_after = $command->parse_arguments(@args); 34 | 35 | is $command->target_class_name, 'Class'; 36 | is $command->target_method_name, 'method'; 37 | 38 | cmp_deeply \@args_after, [qw(a.pl lib/B.pm)], 'parse_arguments returns rest arguments'; 39 | }; 40 | 41 | subtest "when arguments are not enough" => sub { 42 | my $command = App::PRT::Command::DeleteMethod->new; 43 | 44 | ok exception { 45 | $command->parse_arguments('Method'); 46 | }, 'died'; 47 | }; 48 | 49 | } 50 | 51 | sub execute : Tests { 52 | my $directory = t::test::prepare_test_code('dinner'); 53 | 54 | my $command = App::PRT::Command::DeleteMethod->new; 55 | 56 | $command->register('My::Human' => 'name'); 57 | 58 | my $human_file = "$directory/lib/My/Human.pm"; 59 | my $food_file = "$directory/lib/My/Food.pm"; 60 | 61 | subtest 'target file' => sub { 62 | $command->execute($human_file); 63 | 64 | is file($human_file)->slurp, <<'CODE', 'name removed'; 65 | package My::Human; 66 | use strict; 67 | use warnings; 68 | 69 | sub new { 70 | my ($class, $name) = @_; 71 | 72 | bless { 73 | name => $name, 74 | }, $class; 75 | } 76 | 77 | 78 | 79 | sub eat { 80 | my ($self, $food) = @_; 81 | 82 | print "@{[ $self->name ]} is eating @{[ $food->name ]}.\n"; 83 | } 84 | 85 | 1; 86 | CODE 87 | 88 | }; 89 | 90 | 91 | subtest 'another file' => sub { 92 | my $before = file($food_file)->slurp; 93 | $command->execute($food_file); 94 | is file($food_file)->slurp, $before, 'nothing happen'; 95 | }; 96 | 97 | } 98 | 99 | -------------------------------------------------------------------------------- /t/App-PRT-Command-ReplaceToken.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::Command::ReplaceToken; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::Command::ReplaceToken'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::Command::ReplaceToken->new, 'App::PRT::Command::ReplaceToken'; 12 | } 13 | 14 | sub handle_files : Tests { 15 | ok App::PRT::Command::ReplaceToken->handle_files, 'ReplaceToken handles files'; 16 | } 17 | 18 | sub register_rules : Tests { 19 | my $command = App::PRT::Command::ReplaceToken->new; 20 | 21 | is_deeply $command->rules, {}, 'empty'; 22 | 23 | is $command->rule('print'), undef, 'not registered'; 24 | 25 | $command->register('print' => 'warn'); 26 | 27 | is $command->rule('print'), 'warn', 'registered'; 28 | 29 | is_deeply $command->rules, { 30 | 'print' => 'warn', 31 | }, 'registered'; 32 | 33 | $command->register('print' => 'say'); 34 | 35 | is_deeply $command->rules, { 36 | 'print' => 'say', 37 | }, 'updated'; 38 | 39 | $command->register('say' => 'print'); 40 | 41 | is_deeply $command->rules, { 42 | 'print' => 'say', 43 | 'say' => 'print', 44 | }, 'added'; 45 | } 46 | 47 | sub execute : Tests { 48 | my $directory = t::test::prepare_test_code('hello_world'); 49 | my $command = App::PRT::Command::ReplaceToken->new; 50 | my $file = "$directory/hello_world.pl"; 51 | 52 | subtest 'nothing happen when no rules are specified' => sub { 53 | $command->execute($file); 54 | is file($file)->slurp, <<'CODE'; 55 | print "Hello, World!\n"; 56 | CODE 57 | }; 58 | 59 | subtest 'tokens will be replaced when a rules is specified' => sub { 60 | $command->register('print' => 'warn'); 61 | $command->execute($file); 62 | is file($file)->slurp, <<'CODE'; 63 | warn "Hello, World!\n"; 64 | CODE 65 | }; 66 | 67 | } 68 | 69 | sub execute_when_many_rules : Tests { 70 | my $directory = t::test::prepare_test_code('hello_world'); 71 | my $command = App::PRT::Command::ReplaceToken->new; 72 | my $file = "$directory/hello_world.pl"; 73 | 74 | $command->register('print' => 'die'); 75 | $command->register('"Hello, World!\n"' => '"Bye!"'); 76 | 77 | $command->execute($file); 78 | 79 | is file($file)->slurp, <<'CODE'; 80 | die "Bye!"; 81 | CODE 82 | 83 | } 84 | 85 | sub parse_arguments : Tests { 86 | subtest "when source and destination specified" => sub { 87 | my $command = App::PRT::Command::ReplaceToken->new; 88 | my @args = qw(foo bar a.pl lib/B.pm); 89 | 90 | 91 | my @args_after = $command->parse_arguments(@args); 92 | 93 | cmp_deeply $command->rules, { 94 | foo => 'bar', 95 | }, 'registered'; 96 | 97 | cmp_deeply \@args_after, [qw(a.pl lib/B.pm)], 'parse_arguments returns rest arguments'; 98 | }; 99 | 100 | subtest "when arguments are not enough" => sub { 101 | my $command = App::PRT::Command::ReplaceToken->new; 102 | 103 | ok exception { 104 | $command->parse_arguments('hi'); 105 | }, 'died'; 106 | }; 107 | 108 | } 109 | -------------------------------------------------------------------------------- /t/App-PRT-CLI.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::CLI; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::CLI'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::CLI->new, 'App::PRT::CLI'; 12 | } 13 | 14 | sub _command_name_to_command_class : Tests { 15 | my $cli = App::PRT::CLI->new; 16 | 17 | is $cli->_command_name_to_command_class('hello'), 'App::PRT::Command::Hello', 'ucfirst'; 18 | is $cli->_command_name_to_command_class('replace_token'), 'App::PRT::Command::ReplaceToken', 'separate by _'; 19 | } 20 | 21 | sub parse : Tests { 22 | subtest 'when empty input' => sub { 23 | my $cli = App::PRT::CLI->new; 24 | ok $cli->parse; 25 | isa_ok $cli->command, 'App::PRT::Command::Help', 'default command is help'; 26 | ok ! $cli->collector; 27 | }; 28 | 29 | subtest 'when command specified' => sub { 30 | my $cli = App::PRT::CLI->new; 31 | $cli->parse(qw{replace_token foo bar}); 32 | cmp_deeply $cli->command, isa('App::PRT::Command::ReplaceToken') & methods( 33 | rules => {foo => 'bar'}, 34 | ), 'ReplaceToken command loaded'; 35 | cmp_deeply $cli->collector, isa('App::PRT::Collector::Files') & methods( 36 | collect => [], 37 | ), 'Files collector loaded'; 38 | }; 39 | 40 | subtest 'when source and destination specified' => sub { 41 | my $cli = App::PRT::CLI->new; 42 | $cli->parse(qw{replace_token foo bar}); 43 | cmp_deeply $cli->command, isa('App::PRT::Command::ReplaceToken') & methods( 44 | rules => {foo => 'bar'}, 45 | ), 'ReplaceToken command loaded and foo => bar registered'; 46 | cmp_deeply $cli->collector, isa('App::PRT::Collector::Files') & methods( 47 | collect => [], 48 | ), 'Files collector loaded'; 49 | }; 50 | 51 | subtest 'when source, destination, target files specified' => sub { 52 | my $cli = App::PRT::CLI->new; 53 | my $directory = t::test::prepare_test_code('dinner'); 54 | $cli->parse( 55 | qw{replace_token foo bar}, 56 | qq{$directory/dinner.pl}, 57 | qq{$directory/lib/My/Food.pm}, 58 | qq{$directory/lib/My/Human.pm} 59 | ); 60 | cmp_deeply $cli->command, isa('App::PRT::Command::ReplaceToken') & methods( 61 | rules => {foo => 'bar'}, 62 | ), 'ReplaceToken command loaded and foo => bar registered'; 63 | cmp_deeply $cli->collector, isa('App::PRT::Collector::Files') & methods( 64 | collect => [ 65 | qq{$directory/dinner.pl}, 66 | qq{$directory/lib/My/Food.pm}, 67 | qq{$directory/lib/My/Human.pm} 68 | ], 69 | ), 'Files collector loaded and files are registered'; 70 | }; 71 | 72 | subtest 'when invalid command specified' => sub { 73 | my $cli = App::PRT::CLI->new; 74 | ok exception { 75 | $cli->parse('invalid_comand'); 76 | }, 'died'; 77 | }; 78 | } 79 | 80 | sub run : Tests { 81 | subtest "command which doesn't handle files" => sub { 82 | my $cli = App::PRT::CLI->new; 83 | my $g = mock_guard 'App::PRT::Command::Help' => { 84 | execute => sub { 85 | 1; 86 | }, 87 | }; 88 | $cli->parse('help'); 89 | $cli->run; 90 | 91 | is $g->call_count('App::PRT::Command::Help', 'execute'), 1, 'execute called'; 92 | }; 93 | 94 | subtest 'command which handles files' => sub { 95 | my $directory = t::test::prepare_test_code('hello_world'); 96 | 97 | my $cli = App::PRT::CLI->new; 98 | $cli->parse(qw(replace_token foo bar), "$directory/hello_world.pl"); 99 | 100 | my $file; 101 | my $g = mock_guard 'App::PRT::Command::ReplaceToken' => { 102 | execute => sub { 103 | (undef, $file) = @_; 104 | }, 105 | }; 106 | 107 | $cli->run; 108 | 109 | is $g->call_count('App::PRT::Command::ReplaceToken', 'execute'), 1, 'execute called'; 110 | is $file, "$directory/hello_world.pl", 'called with file' 111 | }; 112 | } 113 | -------------------------------------------------------------------------------- /lib/App/PRT/Command/RenameClass.pm: -------------------------------------------------------------------------------- 1 | package App::PRT::Command::RenameClass; 2 | use strict; 3 | use warnings; 4 | use PPI; 5 | use Path::Class; 6 | 7 | sub new { 8 | my ($class) = @_; 9 | bless { 10 | rule => undef, 11 | }, $class; 12 | } 13 | 14 | sub handle_files { 1 } 15 | 16 | # parse arguments from CLI 17 | # arguments: 18 | # @arguments 19 | # returns: 20 | # @rest_arguments 21 | sub parse_arguments { 22 | my ($self, @arguments) = @_; 23 | 24 | die "source and destination class are required" unless @arguments >= 2; 25 | 26 | $self->register(shift @arguments => shift @arguments); 27 | 28 | @arguments; 29 | } 30 | 31 | 32 | # register a replacing rule 33 | # arguments: 34 | # $source: source class name 35 | # $dest: destination class name 36 | sub register { 37 | my ($self, $source_class_name, $destination_class_name) = @_; 38 | 39 | $self->{source_class_name} = $source_class_name; 40 | $self->{destination_class_name} = $destination_class_name; 41 | } 42 | 43 | sub source_class_name { 44 | my ($self) = @_; 45 | 46 | $self->{source_class_name}; 47 | } 48 | 49 | sub destination_class_name { 50 | my ($self) = @_; 51 | 52 | $self->{destination_class_name}; 53 | } 54 | 55 | # refactor a file 56 | # argumensts: 57 | # $file: filename for refactoring 58 | # todo: 59 | # - support package block syntax 60 | # - multi packages in one file 61 | sub execute { 62 | my ($self, $file) = @_; 63 | 64 | my $replaced = 0; 65 | 66 | my $document = PPI::Document->new($file); 67 | 68 | my $package_statement_renamed = $self->_try_rename_package_statement($document); 69 | 70 | $replaced += $self->_try_rename_includes($document); 71 | 72 | $replaced += $self->_try_rename_parent_class($document); 73 | 74 | $replaced += $self->_try_rename_quotes($document); 75 | 76 | $replaced += $self->_try_rename_tokens($document); 77 | 78 | if ($package_statement_renamed) { 79 | $document->save($self->_destination_file($file)); 80 | unlink($file); 81 | } else { 82 | return unless $replaced; 83 | $document->save($file); 84 | } 85 | } 86 | 87 | sub _try_rename_package_statement { 88 | my ($self, $document) = @_; 89 | 90 | my $package = $document->find_first('PPI::Statement::Package'); 91 | 92 | return unless $package; 93 | return unless $package->namespace eq $self->source_class_name; 94 | 95 | my $namespace = $package->schild(1); 96 | 97 | return unless $namespace->isa('PPI::Token::Word'); 98 | 99 | $namespace->set_content($self->destination_class_name); 100 | 1; 101 | } 102 | 103 | sub _try_rename_includes { 104 | my ($self, $document) = @_; 105 | 106 | my $replaced = 0; 107 | 108 | my $statements = $document->find('PPI::Statement::Include'); 109 | return 0 unless $statements; 110 | 111 | for my $statement (@$statements) { 112 | next unless defined $statement->module; 113 | next unless $statement->module eq $self->source_class_name; 114 | 115 | my $module = $statement->schild(1); 116 | 117 | return unless $module->isa('PPI::Token::Word'); 118 | 119 | $module->set_content($self->destination_class_name); 120 | $replaced++; 121 | } 122 | 123 | $replaced; 124 | } 125 | 126 | sub _try_rename_quotes { 127 | my ($self, $document) = @_; 128 | 129 | my $replaced = 0; 130 | 131 | my $quotes = $document->find('PPI::Token::Quote'); 132 | return 0 unless $quotes; 133 | 134 | for my $quote (@$quotes) { 135 | next unless $quote->string eq $self->source_class_name; 136 | $quote->set_content("'@{[ $self->destination_class_name ]}'"); 137 | 138 | $replaced++; 139 | } 140 | 141 | $replaced; 142 | } 143 | 144 | # TODO: too complicated 145 | sub _try_rename_parent_class { 146 | my ($self, $document) = @_; 147 | 148 | my $replaced = 0; 149 | 150 | my $includes = $document->find('PPI::Statement::Include'); 151 | return 0 unless $includes; 152 | 153 | for my $statement (@$includes) { 154 | next unless defined $statement->pragma; 155 | next unless $statement->pragma ~~ [qw(parent base)]; # only 'use parent' and 'use base' are supported 156 | 157 | # schild(2) is 'Foo' of use parent Foo 158 | my $parent = $statement->schild(2); 159 | 160 | if ($parent->isa('PPI::Token::Quote')) { 161 | if ($parent->literal eq $self->source_class_name) { 162 | $parent->set_content("'@{[ $self->destination_class_name ]}'"); 163 | $replaced++; 164 | } 165 | } elsif ($parent->isa('PPI::Token::QuoteLike::Words')) { 166 | # use parent qw(A B C) pattern 167 | # literal is array when QuoteLike::Words 168 | my $_replaced = 0; 169 | my @new_literal = map { 170 | if ($_ eq $self->source_class_name) { 171 | $_replaced++; 172 | $self->destination_class_name; 173 | } else { 174 | $_; 175 | } 176 | } $parent->literal; 177 | if ($_replaced) { 178 | $parent->set_content('qw(' . join(' ', @new_literal) . ')'); 179 | $replaced++; 180 | } 181 | } 182 | } 183 | 184 | $replaced; 185 | } 186 | 187 | # discussions: 188 | # seems too wild 189 | sub _try_rename_tokens { 190 | my ($self, $document) = @_; 191 | 192 | my $replaced = 0; 193 | 194 | my $tokens = $document->find('PPI::Token'); 195 | return 0 unless $tokens; 196 | 197 | for my $token (@$tokens) { 198 | next unless $token->content eq $self->source_class_name; 199 | $token->set_content($self->destination_class_name); 200 | $replaced++; 201 | } 202 | 203 | $replaced; 204 | } 205 | 206 | sub _destination_file { 207 | my ($self, $file) = @_; 208 | 209 | my @delimiters = do { 210 | my $pattern = $self->source_class_name; 211 | $pattern =~ s{::}{(.+)}g; 212 | ($file =~ qr/^(.*)$pattern(.*)$/); 213 | }; 214 | my $prefix = shift @delimiters; 215 | my $suffix = pop @delimiters; 216 | 217 | my $fallback_delimiter = $delimiters[-1]; 218 | my $dir = file($file)->dir; 219 | $dir = $dir->parent for grep { $_ eq '/' } @delimiters; 220 | my $basename = $self->destination_class_name; 221 | $basename =~ s{::}{ 222 | shift @delimiters // $fallback_delimiter; 223 | }ge; 224 | $dir->file("$basename$suffix"); 225 | } 226 | 227 | 1; 228 | -------------------------------------------------------------------------------- /t/App-PRT-Command-RenameClass.t: -------------------------------------------------------------------------------- 1 | package t::App::PRT::Command::RenameClass; 2 | use t::test; 3 | 4 | sub _require : Test(startup => 1) { 5 | my ($self) = @_; 6 | 7 | use_ok 'App::PRT::Command::RenameClass'; 8 | } 9 | 10 | sub instantiate : Tests { 11 | isa_ok App::PRT::Command::RenameClass->new, 'App::PRT::Command::RenameClass'; 12 | } 13 | 14 | sub handle_files : Tests { 15 | ok App::PRT::Command::RenameClass->handle_files, 'RenameClass handles files'; 16 | } 17 | 18 | sub register_rule : Tests { 19 | my $command = App::PRT::Command::RenameClass->new; 20 | 21 | $command->register('Foo' => 'Bar'); 22 | 23 | is $command->source_class_name, 'Foo'; 24 | is $command->destination_class_name, 'Bar'; 25 | } 26 | 27 | sub _destination_file : Tests { 28 | for my $case ( 29 | ['Foo', 'Bar', 'Foo.pm', './Bar.pm', 'without directory'], 30 | ['Foo', 'Bar', 'Foo.pm', './Bar.pm', 'with directory'], 31 | ['Foo', 'Bar', 'Foo.txt', './Bar.txt', 'with extname'], 32 | ['Foo::Bar', 'Foo::Bazz', 'Foo/Bar.pm', 'Foo/Bazz.pm', 'move deeper'], 33 | ['Foo::Bar::Bazz', 'Foo::Bar', 'Foo/Bar/Bazz.pm', 'Foo/Bar.pm', 'move lighter'], 34 | ['Foo::Bar::Bazz', 'Foo::Bar', '/tmp/lib/Foo/Bar/Bazz.pm', '/tmp/lib/Foo/Bar.pm', 'absolute path'], 35 | ['Test::Foo', 'Test::Foo::Bar', 't/lib/Test/Foo.pm', 't/lib/Test/Foo/Bar.pm', 't/lib'], 36 | ['t::Foo', 't::Bar', 't/Foo.t', 't/Bar.t', 'test file'], 37 | ['A::B::C', 'D::E::F', 'A-B_C.pm', './D-E_F.pm', 'separated with -, _'], 38 | ['A::B', 'A::B::C::D', 'A-B.pm', './A-B-C-D.pm', 'separated with -, _, move deeper'], 39 | ['A::B::C::D', 'A::B', 'A-B-C-D.pm', './A-B.pm', 'separated with -, _, move lighter'], 40 | ['A::B::C', 'D::E::F::G', 'A/B-C.pm', 'D/E-F-G.pm', 'separated with -, _, mixed with directory'], 41 | ) { 42 | my ($source_class_name, $destination_class_name, $input_file, $expected_file, $description) = @$case; 43 | 44 | my $command = App::PRT::Command::RenameClass->new; 45 | $command->register($source_class_name => $destination_class_name); 46 | is $command->_destination_file($input_file), $expected_file, $description; 47 | } 48 | } 49 | 50 | sub execute : Tests { 51 | my $directory = t::test::prepare_test_code('dinner'); 52 | 53 | my $command = App::PRT::Command::RenameClass->new; 54 | 55 | $command->register('My::Food' => 'My::Meal'); 56 | 57 | subtest 'target class' => sub { 58 | my $food_file = "$directory/lib/My/Food.pm"; 59 | my $meal_file = "$directory/lib/My/Meal.pm"; 60 | 61 | $command->execute($food_file); 62 | 63 | ok ! -f $food_file, "Food.pm doesn't exists"; 64 | ok -e $meal_file, "Meal.pm exists"; 65 | 66 | is file($meal_file)->slurp, <<'CODE', 'package statement was rewritten'; 67 | package My::Meal; 68 | use strict; 69 | use warnings; 70 | 71 | sub new { 72 | my ($class, $name) = @_; 73 | 74 | bless { 75 | name => $name, 76 | }, $class; 77 | } 78 | 79 | sub name { 80 | my ($self) = @_; 81 | 82 | $self->{name}; 83 | } 84 | 85 | 1; 86 | CODE 87 | 88 | }; 89 | 90 | subtest 'client file' => sub { 91 | my $dinner_file = "$directory/dinner.pl"; 92 | $command->execute($dinner_file); 93 | 94 | ok -f $dinner_file, 'dinner.pl exists'; 95 | 96 | is file($dinner_file)->slurp, <<'CODE', 'use statement and class-method invocation were rewritten'; 97 | use strict; 98 | use warnings; 99 | use lib 'lib'; 100 | 101 | use My::Human; 102 | use My::Meal; 103 | 104 | my $human = My::Human->new('Alice'); 105 | my $food = My::Meal->new('Pizza'); 106 | 107 | $human->eat($food); 108 | CODE 109 | 110 | }; 111 | } 112 | 113 | sub execute_with_inherit : Tests { 114 | my $directory = t::test::prepare_test_code('inherit'); 115 | 116 | my $command = App::PRT::Command::RenameClass->new; 117 | 118 | $command->register('Parent' => 'Boss'); 119 | 120 | subtest 'target class' => sub { 121 | my $file = "$directory/inherit.pl"; 122 | 123 | $command->execute($file); 124 | 125 | ok -e $file, "script file exists"; 126 | is file($file)->slurp, <<'CODE', 'use parent, use base statements were rewritten'; 127 | package Child1 { 128 | use DateTime; 129 | use utf8; 130 | use parent 'Boss'; 131 | }; 132 | 133 | package Child2 { 134 | use parent qw(Boss AnotherParent YetAnother::Parent); 135 | }; 136 | 137 | package Child3 { 138 | use base 'Boss'; 139 | }; 140 | 141 | package GrandChild { 142 | use base 'Child'; 143 | }; 144 | CODE 145 | 146 | }; 147 | 148 | } 149 | 150 | sub execute_test_more_style_test_file : Tests { 151 | my $directory = t::test::prepare_test_code('dinner'); 152 | 153 | my $command = App::PRT::Command::RenameClass->new; 154 | 155 | $command->register('My::Food' => 'My::Meal'); 156 | 157 | my $file = "$directory/t/001-my-food._t"; 158 | 159 | $command->execute($file); 160 | 161 | is file($file)->slurp, <<'CODE', 'test replaced'; 162 | use Test::More tests => 5; 163 | 164 | use_ok 'My::Meal'; 165 | require_ok 'My::Meal'; 166 | 167 | new_ok 'My::Meal'; 168 | isa_ok My::Meal->new, 'My::Meal'; 169 | 170 | subtest 'name' => sub { 171 | my $pizza = My::Meal->new('Pizza'); 172 | is $pizza->name, 'Pizza'; 173 | }; 174 | CODE 175 | 176 | } 177 | 178 | sub execute_test_class_style_test_file: Tests { 179 | my $directory = t::test::prepare_test_code('dinner'); 180 | 181 | my $food_file = "$directory/t/My-Food._t"; 182 | my $meal_file = "$directory/t/My-Meal._t"; 183 | 184 | my $command1 = App::PRT::Command::RenameClass->new; 185 | $command1->register('t::My::Food' => 't::My::Meal'); 186 | $command1->execute($food_file); 187 | 188 | ok ! -f $food_file, "Food._t doesn't exists"; 189 | ok -e $meal_file, "Meal._t exists"; 190 | 191 | is file($meal_file)->slurp, <<'CODE', 'package statement replaced'; 192 | package t::My::Meal; 193 | use base qw(Test::Class); 194 | use Test::More; 195 | 196 | sub _load : Test(startup => 1) { 197 | use_ok 'My::Food'; 198 | } 199 | 200 | sub instantiate : Test(1) { 201 | isa_ok My::Food->new('banana'), 'My::Food'; 202 | } 203 | 204 | sub name : Test(1) { 205 | my $food = My::Food->new('banana'); 206 | is $food->name, 'banana'; 207 | } 208 | 209 | __PACKAGE__->runtests; 210 | CODE 211 | 212 | } 213 | 214 | sub parse_arguments : Tests { 215 | subtest "when source and destination specified" => sub { 216 | my $command = App::PRT::Command::RenameClass->new; 217 | my @args = qw(From To a.pl lib/B.pm); 218 | 219 | 220 | my @args_after = $command->parse_arguments(@args); 221 | 222 | is $command->source_class_name, 'From'; 223 | is $command->destination_class_name, 'To'; 224 | 225 | cmp_deeply \@args_after, [qw(a.pl lib/B.pm)], 'parse_arguments returns rest arguments'; 226 | }; 227 | 228 | subtest "when arguments are not enough" => sub { 229 | my $command = App::PRT::Command::RenameClass->new; 230 | 231 | ok exception { 232 | $command->parse_arguments('hi'); 233 | }, 'died'; 234 | }; 235 | 236 | } 237 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | This software is copyright (c) 2014 by hitode909 . 2 | 3 | This is free software; you can redistribute it and/or modify it under 4 | the same terms as the Perl 5 programming language system itself. 5 | 6 | Terms of the Perl programming language system itself 7 | 8 | a) the GNU General Public License as published by the Free 9 | Software Foundation; either version 1, or (at your option) any 10 | later version, or 11 | b) the "Artistic License" 12 | 13 | --- The GNU General Public License, Version 1, February 1989 --- 14 | 15 | This software is Copyright (c) 2014 by hitode909 . 16 | 17 | This is free software, licensed under: 18 | 19 | The GNU General Public License, Version 1, February 1989 20 | 21 | GNU GENERAL PUBLIC LICENSE 22 | Version 1, February 1989 23 | 24 | Copyright (C) 1989 Free Software Foundation, Inc. 25 | 51 Franklin St, Suite 500, Boston, MA 02110-1335 USA 26 | 27 | Everyone is permitted to copy and distribute verbatim copies 28 | of this license document, but changing it is not allowed. 29 | 30 | Preamble 31 | 32 | The license agreements of most software companies try to keep users 33 | at the mercy of those companies. By contrast, our General Public 34 | License is intended to guarantee your freedom to share and change free 35 | software--to make sure the software is free for all its users. The 36 | General Public License applies to the Free Software Foundation's 37 | software and to any other program whose authors commit to using it. 38 | You can use it for your programs, too. 39 | 40 | When we speak of free software, we are referring to freedom, not 41 | price. Specifically, the General Public License is designed to make 42 | sure that you have the freedom to give away or sell copies of free 43 | software, that you receive source code or can get it if you want it, 44 | that you can change the software or use pieces of it in new free 45 | programs; and that you know you can do these things. 46 | 47 | To protect your rights, we need to make restrictions that forbid 48 | anyone to deny you these rights or to ask you to surrender the rights. 49 | These restrictions translate to certain responsibilities for you if you 50 | distribute copies of the software, or if you modify it. 51 | 52 | For example, if you distribute copies of a such a program, whether 53 | gratis or for a fee, you must give the recipients all the rights that 54 | you have. You must make sure that they, too, receive or can get the 55 | source code. And you must tell them their rights. 56 | 57 | We protect your rights with two steps: (1) copyright the software, and 58 | (2) offer you this license which gives you legal permission to copy, 59 | distribute and/or modify the software. 60 | 61 | Also, for each author's protection and ours, we want to make certain 62 | that everyone understands that there is no warranty for this free 63 | software. If the software is modified by someone else and passed on, we 64 | want its recipients to know that what they have is not the original, so 65 | that any problems introduced by others will not reflect on the original 66 | authors' reputations. 67 | 68 | The precise terms and conditions for copying, distribution and 69 | modification follow. 70 | 71 | GNU GENERAL PUBLIC LICENSE 72 | TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 73 | 74 | 0. This License Agreement applies to any program or other work which 75 | contains a notice placed by the copyright holder saying it may be 76 | distributed under the terms of this General Public License. The 77 | "Program", below, refers to any such program or work, and a "work based 78 | on the Program" means either the Program or any work containing the 79 | Program or a portion of it, either verbatim or with modifications. Each 80 | licensee is addressed as "you". 81 | 82 | 1. You may copy and distribute verbatim copies of the Program's source 83 | code as you receive it, in any medium, provided that you conspicuously and 84 | appropriately publish on each copy an appropriate copyright notice and 85 | disclaimer of warranty; keep intact all the notices that refer to this 86 | General Public License and to the absence of any warranty; and give any 87 | other recipients of the Program a copy of this General Public License 88 | along with the Program. You may charge a fee for the physical act of 89 | transferring a copy. 90 | 91 | 2. You may modify your copy or copies of the Program or any portion of 92 | it, and copy and distribute such modifications under the terms of Paragraph 93 | 1 above, provided that you also do the following: 94 | 95 | a) cause the modified files to carry prominent notices stating that 96 | you changed the files and the date of any change; and 97 | 98 | b) cause the whole of any work that you distribute or publish, that 99 | in whole or in part contains the Program or any part thereof, either 100 | with or without modifications, to be licensed at no charge to all 101 | third parties under the terms of this General Public License (except 102 | that you may choose to grant warranty protection to some or all 103 | third parties, at your option). 104 | 105 | c) If the modified program normally reads commands interactively when 106 | run, you must cause it, when started running for such interactive use 107 | in the simplest and most usual way, to print or display an 108 | announcement including an appropriate copyright notice and a notice 109 | that there is no warranty (or else, saying that you provide a 110 | warranty) and that users may redistribute the program under these 111 | conditions, and telling the user how to view a copy of this General 112 | Public License. 113 | 114 | d) You may charge a fee for the physical act of transferring a 115 | copy, and you may at your option offer warranty protection in 116 | exchange for a fee. 117 | 118 | Mere aggregation of another independent work with the Program (or its 119 | derivative) on a volume of a storage or distribution medium does not bring 120 | the other work under the scope of these terms. 121 | 122 | 3. You may copy and distribute the Program (or a portion or derivative of 123 | it, under Paragraph 2) in object code or executable form under the terms of 124 | Paragraphs 1 and 2 above provided that you also do one of the following: 125 | 126 | a) accompany it with the complete corresponding machine-readable 127 | source code, which must be distributed under the terms of 128 | Paragraphs 1 and 2 above; or, 129 | 130 | b) accompany it with a written offer, valid for at least three 131 | years, to give any third party free (except for a nominal charge 132 | for the cost of distribution) a complete machine-readable copy of the 133 | corresponding source code, to be distributed under the terms of 134 | Paragraphs 1 and 2 above; or, 135 | 136 | c) accompany it with the information you received as to where the 137 | corresponding source code may be obtained. (This alternative is 138 | allowed only for noncommercial distribution and only if you 139 | received the program in object code or executable form alone.) 140 | 141 | Source code for a work means the preferred form of the work for making 142 | modifications to it. For an executable file, complete source code means 143 | all the source code for all modules it contains; but, as a special 144 | exception, it need not include source code for modules which are standard 145 | libraries that accompany the operating system on which the executable 146 | file runs, or for standard header files or definitions files that 147 | accompany that operating system. 148 | 149 | 4. You may not copy, modify, sublicense, distribute or transfer the 150 | Program except as expressly provided under this General Public License. 151 | Any attempt otherwise to copy, modify, sublicense, distribute or transfer 152 | the Program is void, and will automatically terminate your rights to use 153 | the Program under this License. However, parties who have received 154 | copies, or rights to use copies, from you under this General Public 155 | License will not have their licenses terminated so long as such parties 156 | remain in full compliance. 157 | 158 | 5. By copying, distributing or modifying the Program (or any work based 159 | on the Program) you indicate your acceptance of this license to do so, 160 | and all its terms and conditions. 161 | 162 | 6. Each time you redistribute the Program (or any work based on the 163 | Program), the recipient automatically receives a license from the original 164 | licensor to copy, distribute or modify the Program subject to these 165 | terms and conditions. You may not impose any further restrictions on the 166 | recipients' exercise of the rights granted herein. 167 | 168 | 7. The Free Software Foundation may publish revised and/or new versions 169 | of the General Public License from time to time. Such new versions will 170 | be similar in spirit to the present version, but may differ in detail to 171 | address new problems or concerns. 172 | 173 | Each version is given a distinguishing version number. If the Program 174 | specifies a version number of the license which applies to it and "any 175 | later version", you have the option of following the terms and conditions 176 | either of that version or of any later version published by the Free 177 | Software Foundation. If the Program does not specify a version number of 178 | the license, you may choose any version ever published by the Free Software 179 | Foundation. 180 | 181 | 8. If you wish to incorporate parts of the Program into other free 182 | programs whose distribution conditions are different, write to the author 183 | to ask for permission. For software which is copyrighted by the Free 184 | Software Foundation, write to the Free Software Foundation; we sometimes 185 | make exceptions for this. Our decision will be guided by the two goals 186 | of preserving the free status of all derivatives of our free software and 187 | of promoting the sharing and reuse of software generally. 188 | 189 | NO WARRANTY 190 | 191 | 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY 192 | FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN 193 | OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES 194 | PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED 195 | OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF 196 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS 197 | TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE 198 | PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, 199 | REPAIR OR CORRECTION. 200 | 201 | 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING 202 | WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR 203 | REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, 204 | INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING 205 | OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED 206 | TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY 207 | YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER 208 | PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE 209 | POSSIBILITY OF SUCH DAMAGES. 210 | 211 | END OF TERMS AND CONDITIONS 212 | 213 | Appendix: How to Apply These Terms to Your New Programs 214 | 215 | If you develop a new program, and you want it to be of the greatest 216 | possible use to humanity, the best way to achieve this is to make it 217 | free software which everyone can redistribute and change under these 218 | terms. 219 | 220 | To do so, attach the following notices to the program. It is safest to 221 | attach them to the start of each source file to most effectively convey 222 | the exclusion of warranty; and each file should have at least the 223 | "copyright" line and a pointer to where the full notice is found. 224 | 225 | 226 | Copyright (C) 19yy 227 | 228 | This program is free software; you can redistribute it and/or modify 229 | it under the terms of the GNU General Public License as published by 230 | the Free Software Foundation; either version 1, or (at your option) 231 | any later version. 232 | 233 | This program is distributed in the hope that it will be useful, 234 | but WITHOUT ANY WARRANTY; without even the implied warranty of 235 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 236 | GNU General Public License for more details. 237 | 238 | You should have received a copy of the GNU General Public License 239 | along with this program; if not, write to the Free Software 240 | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA 241 | 242 | 243 | Also add information on how to contact you by electronic and paper mail. 244 | 245 | If the program is interactive, make it output a short notice like this 246 | when it starts in an interactive mode: 247 | 248 | Gnomovision version 69, Copyright (C) 19xx name of author 249 | Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. 250 | This is free software, and you are welcome to redistribute it 251 | under certain conditions; type `show c' for details. 252 | 253 | The hypothetical commands `show w' and `show c' should show the 254 | appropriate parts of the General Public License. Of course, the 255 | commands you use may be called something other than `show w' and `show 256 | c'; they could even be mouse-clicks or menu items--whatever suits your 257 | program. 258 | 259 | You should also get your employer (if you work as a programmer) or your 260 | school, if any, to sign a "copyright disclaimer" for the program, if 261 | necessary. Here a sample; alter the names: 262 | 263 | Yoyodyne, Inc., hereby disclaims all copyright interest in the 264 | program `Gnomovision' (a program to direct compilers to make passes 265 | at assemblers) written by James Hacker. 266 | 267 | , 1 April 1989 268 | Ty Coon, President of Vice 269 | 270 | That's all there is to it! 271 | 272 | 273 | --- The Artistic License 1.0 --- 274 | 275 | This software is Copyright (c) 2014 by hitode909 . 276 | 277 | This is free software, licensed under: 278 | 279 | The Artistic License 1.0 280 | 281 | The Artistic License 282 | 283 | Preamble 284 | 285 | The intent of this document is to state the conditions under which a Package 286 | may be copied, such that the Copyright Holder maintains some semblance of 287 | artistic control over the development of the package, while giving the users of 288 | the package the right to use and distribute the Package in a more-or-less 289 | customary fashion, plus the right to make reasonable modifications. 290 | 291 | Definitions: 292 | 293 | - "Package" refers to the collection of files distributed by the Copyright 294 | Holder, and derivatives of that collection of files created through 295 | textual modification. 296 | - "Standard Version" refers to such a Package if it has not been modified, 297 | or has been modified in accordance with the wishes of the Copyright 298 | Holder. 299 | - "Copyright Holder" is whoever is named in the copyright or copyrights for 300 | the package. 301 | - "You" is you, if you're thinking about copying or distributing this Package. 302 | - "Reasonable copying fee" is whatever you can justify on the basis of media 303 | cost, duplication charges, time of people involved, and so on. (You will 304 | not be required to justify it to the Copyright Holder, but only to the 305 | computing community at large as a market that must bear the fee.) 306 | - "Freely Available" means that no fee is charged for the item itself, though 307 | there may be fees involved in handling the item. It also means that 308 | recipients of the item may redistribute it under the same conditions they 309 | received it. 310 | 311 | 1. You may make and give away verbatim copies of the source form of the 312 | Standard Version of this Package without restriction, provided that you 313 | duplicate all of the original copyright notices and associated disclaimers. 314 | 315 | 2. You may apply bug fixes, portability fixes and other modifications derived 316 | from the Public Domain or from the Copyright Holder. A Package modified in such 317 | a way shall still be considered the Standard Version. 318 | 319 | 3. You may otherwise modify your copy of this Package in any way, provided that 320 | you insert a prominent notice in each changed file stating how and when you 321 | changed that file, and provided that you do at least ONE of the following: 322 | 323 | a) place your modifications in the Public Domain or otherwise make them 324 | Freely Available, such as by posting said modifications to Usenet or an 325 | equivalent medium, or placing the modifications on a major archive site 326 | such as ftp.uu.net, or by allowing the Copyright Holder to include your 327 | modifications in the Standard Version of the Package. 328 | 329 | b) use the modified Package only within your corporation or organization. 330 | 331 | c) rename any non-standard executables so the names do not conflict with 332 | standard executables, which must also be provided, and provide a separate 333 | manual page for each non-standard executable that clearly documents how it 334 | differs from the Standard Version. 335 | 336 | d) make other distribution arrangements with the Copyright Holder. 337 | 338 | 4. You may distribute the programs of this Package in object code or executable 339 | form, provided that you do at least ONE of the following: 340 | 341 | a) distribute a Standard Version of the executables and library files, 342 | together with instructions (in the manual page or equivalent) on where to 343 | get the Standard Version. 344 | 345 | b) accompany the distribution with the machine-readable source of the Package 346 | with your modifications. 347 | 348 | c) accompany any non-standard executables with their corresponding Standard 349 | Version executables, giving the non-standard executables non-standard 350 | names, and clearly documenting the differences in manual pages (or 351 | equivalent), together with instructions on where to get the Standard 352 | Version. 353 | 354 | d) make other distribution arrangements with the Copyright Holder. 355 | 356 | 5. You may charge a reasonable copying fee for any distribution of this 357 | Package. You may charge any fee you choose for support of this Package. You 358 | may not charge a fee for this Package itself. However, you may distribute this 359 | Package in aggregate with other (possibly commercial) programs as part of a 360 | larger (possibly commercial) software distribution provided that you do not 361 | advertise this Package as a product of your own. 362 | 363 | 6. The scripts and library files supplied as input to or produced as output 364 | from the programs of this Package do not automatically fall under the copyright 365 | of this Package, but belong to whomever generated them, and may be sold 366 | commercially, and may be aggregated with this Package. 367 | 368 | 7. C or perl subroutines supplied by you and linked into this Package shall not 369 | be considered part of this Package. 370 | 371 | 8. The name of the Copyright Holder may not be used to endorse or promote 372 | products derived from this software without specific prior written permission. 373 | 374 | 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED 375 | WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF 376 | MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. 377 | 378 | The End --------------------------------------------------------------------------------