Module-Install-Substitute-0.03/0000755000175000006270000000000011030024306015361 5ustar cubiccubicModule-Install-Substitute-0.03/t/0000755000175000006270000000000011030024306015624 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/0000755000175000006270000000000011030024306016535 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/output/0000755000175000006270000000000011030024306020075 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/output/02basics/0000755000175000006270000000000011030024306021503 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/output/02basics/inline10000644000175000006270000000005311030017467022775 0ustar cubiccubicbar ###before: @TEST@ ###after: @TEST@ bar Module-Install-Substitute-0.03/t/data/output/02basics/inline20000644000175000006270000000005311030017467022776 0ustar cubiccubiczoo ###before: @TEST@ ###after: @TEST@ zoo Module-Install-Substitute-0.03/t/data/input/0000755000175000006270000000000011030024306017674 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/input/02basics/0000755000175000006270000000000011030024306021302 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/input/02basics/sufix.in0000644000175000006270000000005311030017467023000 0ustar cubiccubiczoo ###before: @TEST@ ###after: @TEST@ zoo Module-Install-Substitute-0.03/t/data/input/02basics/inline0000644000175000006270000000005311030017467022513 0ustar cubiccubiczoo ###before: @TEST@ ###after: @TEST@ zoo Module-Install-Substitute-0.03/t/data/input/02basics/from/0000755000175000006270000000000011030024306022245 5ustar cubiccubicModule-Install-Substitute-0.03/t/data/input/02basics/from/inline0000644000175000006270000000005311030017467023456 0ustar cubiccubiczoo ###before: @TEST@ ###after: @TEST@ zoo Module-Install-Substitute-0.03/t/02basics.t0000644000175000006270000000277511030022420017425 0ustar cubiccubic#!/usr/bin/perl use strict; use warnings; use Test::More no_plan => 1; use Test::File::Contents; use_ok( 'Module::Install::Substitute' ); my $obj = new Module::Install::Substitute; isa_ok($obj, 'Module::Install::Substitute'); $obj->substitute( { TEST => 'bar'}, 't/data/input/02basics/inline' ); file_contents_identical('t/data/input/02basics/inline', 't/data/output/02basics/inline1' ); $obj->substitute( { TEST => 'zoo'}, 't/data/input/02basics/inline' ); file_contents_identical('t/data/input/02basics/inline', 't/data/output/02basics/inline2' ); $obj->substitute( { TEST => 'bar'}, { sufix => '.in' }, 't/data/input/02basics/sufix' ); file_contents_identical('t/data/input/02basics/sufix', 't/data/output/02basics/inline1' ); $obj->substitute( { TEST => 'zoo'}, { sufix => '.in' }, 't/data/input/02basics/sufix' ); file_contents_identical('t/data/input/02basics/sufix', 't/data/output/02basics/inline2' ); mkdir 't/data/input/02basics/to' unless -d 't/data/input/02basics/to'; $obj->substitute( { TEST => 'bar'}, { from => 't/data/input/02basics/from', to => 't/data/input/02basics/to' }, 'inline' ); file_contents_identical('t/data/input/02basics/to/inline', 't/data/output/02basics/inline1' ); $obj->substitute( { TEST => 'zoo'}, { from => 't/data/input/02basics/from', to => 't/data/input/02basics/to' }, 'inline' ); file_contents_identical('t/data/input/02basics/to/inline', 't/data/output/02basics/inline2' ); Module-Install-Substitute-0.03/t/01load.t0000644000175000006270000000024510254140071017077 0ustar cubiccubic# -*- perl -*- # t/001_load.t - check module loading and create testing directory use Test::More tests => 1; BEGIN { use_ok( 'Module::Install::Substitute' ); } Module-Install-Substitute-0.03/inc/0000755000175000006270000000000011030024306016132 5ustar cubiccubicModule-Install-Substitute-0.03/inc/Module/0000755000175000006270000000000011030024306017357 5ustar cubiccubicModule-Install-Substitute-0.03/inc/Module/Install.pm0000644000175000006270000002054511030022136021330 0ustar cubiccubic#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 # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; 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 = '0.75'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # 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 # 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 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. 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)); use Cwd (); use File::Find (); use File::Path (); use FindBin; 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; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ( $self, $1 ); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { 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"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $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 ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # 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) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $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; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } 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]): $!"; } sub _version { my $s = shift || 0; $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; } 1; # Copyright 2008 Adam Kennedy. Module-Install-Substitute-0.03/inc/Module/Install/0000755000175000006270000000000011030024306020765 5ustar cubiccubicModule-Install-Substitute-0.03/inc/Module/Install/Fetch.pm0000644000175000006270000000463011030022136022356 0ustar cubiccubic#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.75'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } 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; Module-Install-Substitute-0.03/inc/Module/Install/Makefile.pm0000644000175000006270000001412111030022136023036 0ustar cubiccubic#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.75'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } 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, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ($self->{makemaker_args} ||= {}); %$args = ( %$args, @_ ) if @_; $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; 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 ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } 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"; } $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)) { $args{dist} = $preop; } 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: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $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; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; 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 371 Module-Install-Substitute-0.03/inc/Module/Install/Base.pm0000644000175000006270000000203511030022136022174 0ustar cubiccubic#line 1 package Module::Install::Base; $VERSION = '0.75'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 138 Module-Install-Substitute-0.03/inc/Module/Install/Metadata.pm0000644000175000006270000002235011030022136023044 0ustar cubiccubic#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.75'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version license distribution_type perl_version tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } foreach my $key (@scalar_keys) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{configure_requires} }, [ $module, $version ]; } $self->{values}->{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{recommends} }, [ $module, $version ]; } $self->{values}->{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}->{bundles} }, [ $module, $version ]; } $self->{values}->{bundles}; } # Resource handling sub resources { my $self = shift; while ( @_ ) { my $resource = shift or last; my $value = shift or next; push @{ $self->{values}->{resources} }, [ $resource, $value ]; } $self->{values}->{resources}; } sub repository { my $self = shift; $self->resources( repository => shift ); return 1; } # 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 sign { my $self = shift; return $self->{'values'}{'sign'} if defined wantarray and ! @_; $self->{'values'}{'sign'} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config, skipping\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return $self; } 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; die "all_from: cannot find $file from $name" unless -e $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) ); } 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 perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $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; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die "Cannot find script '$_'"; } } } 1; Module-Install-Substitute-0.03/inc/Module/Install/Can.pm0000644000175000006270000000337411030022136022032 0ustar cubiccubic#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.75'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # 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}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # 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 157 Module-Install-Substitute-0.03/inc/Module/Install/WriteAll.pm0000644000175000006270000000132111030022136023042 0ustar cubiccubic#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.75'; @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->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; Module-Install-Substitute-0.03/inc/Module/Install/Win32.pm0000644000175000006270000000340211030022136022223 0ustar cubiccubic#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.75'; @ISA = qw{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; Module-Install-Substitute-0.03/MANIFEST0000644000175000006270000000076711030022434016524 0ustar cubiccubicCHANGES 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/Module/Install/Substitute.pm Makefile.PL MANIFEST This list of files META.yml README t/01load.t t/02basics.t t/data/input/02basics/from/inline t/data/input/02basics/inline t/data/input/02basics/sufix.in t/data/output/02basics/inline1 t/data/output/02basics/inline2 Module-Install-Substitute-0.03/CHANGES0000644000175000006270000000055511030023560016362 0ustar cubiccubic0.03 2008-06-24 * tiny format adjustments * replace action is not allowed when source and destination are equal * docs update * create a dir in a test to avoid false failures thanks to Diab Jerius and cpan testers for kicking me 0.02 2006-04-26 * changes for versions 0.02 are missing, sorry. 0.01 2004-07-27 * original version Module-Install-Substitute-0.03/META.yml0000644000175000006270000000075011030022136016633 0ustar cubiccubic--- abstract: 'substitute values into files before install' author: - 'Ruslan Zakirov ' build_requires: Test::File::Contents: 0 Test::More: 0 distribution_type: module generated_by: 'Module::Install version 0.75' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 name: Module-Install-Substitute no_index: directory: - inc - t requires: Cwd: 0 File::Spec: 0 File::Temp: 0 perl: 5.8.0 version: 0.03 Module-Install-Substitute-0.03/lib/0000755000175000006270000000000011030024306016127 5ustar cubiccubicModule-Install-Substitute-0.03/lib/Module/0000755000175000006270000000000011030024306017354 5ustar cubiccubicModule-Install-Substitute-0.03/lib/Module/Install/0000755000175000006270000000000011030024306020762 5ustar cubiccubicModule-Install-Substitute-0.03/lib/Module/Install/Substitute.pm0000644000175000006270000001144511030022105023473 0ustar cubiccubicpackage Module::Install::Substitute; use strict; use warnings; use 5.008; # I don't care much about earlier versions use Module::Install::Base; our @ISA = qw(Module::Install::Base); our $VERSION = '0.03'; require File::Temp; require File::Spec; require Cwd; =head1 NAME Module::Install::Substitute - substitute values into files before install =head1 SYNOPSIS ... Makefile.PL ... substitute( { LESS => '/usr/bin/less', APXS => '/usr/bin/apxs2', }, 'bin/my-app' ); ... bin/my-app ... ### after: my $less_path = '@LESS@'; my $less_path = '/usr/bin/less'; =head1 DESCRIPTION This is extension for L system that allow you to substitute values into files before install, for example paths to libs or binary executables. =head1 METHODS =head2 substitute {SUBSTITUTIONS} [{OPTIONS}] @FILES Takes a hash reference with substituations key value pairs, an optional hash reference with options and a list of files to deal with. =head3 Options Several options are available: =over 3 =item sufix Sufix for source files, for example you can use sufix C<.in> and results of processing of F would be writen into file F. Note that you don't need to specify sufixes in the list of files. =item from Source base dir. By default it's the current working directory (L). All files in the list are treated as relative to this directory. =item to Destination base dir. By default it's the current working directory (L). =back =head3 File format In the files the following constructs are replaced: ###\s*after:\s?some string with @KEY@ some string with @KEY@ some string with value ###\s*before:\s?some string with @KEY@ ###\s*replace:\s?some string with @KEY@ So string should start with three # characters followed by optional spaces, action keyword and some string where @SOME_KEY@ are substituted. This module can replace lines after or before above constructs based on action keyword to allow you to change files in place without moving them around and to make it possible to run substitution multiple times. =cut sub substitute { my $self = shift; $self->{__subst} = shift; $self->{__option} = {}; if( UNIVERSAL::isa( $_[0], 'HASH' ) ) { my $opts = shift; while( my ($k,$v) = each( %$opts ) ) { $self->{__option}->{ lc( $k ) } = $v || ''; } } $self->_parse_options; my @file = @_; foreach my $f (@file) { $self->_rewrite_file( $f ); } return; } sub _parse_options { my $self = shift; my $cwd = Cwd::getcwd(); foreach my $t ( qw(from to) ) { $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t}; my $d = $self->{__option}->{$t}; die "Couldn't read directory '$d'" unless -d $d && -r _; } } sub _rewrite_file { my ($self, $file) = @_; my $source = File::Spec->catfile( $self->{__option}{from}, $file ); $source .= $self->{__option}{sufix} if $self->{__option}{sufix}; unless( -f $source && -r _ ) { print STDERR "Couldn't find file '$source'\n"; return; } my $dest = File::Spec->catfile( $self->{__option}{to}, $file ); return $self->__rewrite_file( $source, $dest ); } sub __rewrite_file { my ($self, $source, $dest) = @_; my $mode = (stat($source))[2]; open my $sfh, "<$source" or die "Couldn't open '$source' for read"; print "Open input '$source' file for substitution\n"; my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1); $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 ); close $sfh; seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file"; open my $dfh, ">$dest" or die "Couldn't open '$dest' for write"; print "Open output '$dest' file for substitution\n"; while( <$tmpfh> ) { print $dfh $_; } close $dfh; chmod $mode, $dest or "Couldn't change mode on '$dest'"; } sub __process_streams { my ($self, $in, $out, $replace) = @_; my @queue = (); my $subst = $self->{'__subst'}; my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } ); while( my $str = <$in> ) { if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) { my ($action, $nstr) = ($1,$2); $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge; die "Replace action is bad idea for situations when dest is equal to source" if $replace && $action eq 'replace'; if( $action eq 'before' ) { die "no line before 'before' action" unless @queue; # overwrite prev line; pop @queue; push @queue, $nstr; push @queue, $str; } elsif( $action eq 'replace' ) { push @queue, $nstr; } elsif( $action eq 'after' ) { push @queue, $str; push @queue, $nstr; # skip one line; <$in>; } } else { push @queue, $str; } while( @queue > 3 ) { print $out shift(@queue); } } while( scalar @queue ) { print $out shift(@queue); } } 1; =head1 AUTHOR Ruslan Zakirov Eruz@cpan.orgE =head1 Module-Install-Substitute-0.03/Makefile.PL0000644000175000006270000000043011030022121017321 0ustar cubiccubicuse inc::Module::Install; name ('Module-Install-Substitute'); license ('perl'); all_from ('lib/Module/Install/Substitute.pm'); requires('File::Spec'); requires('File::Temp'); requires('Cwd'); build_requires('Test::More'); build_requires('Test::File::Contents'); WriteAll(); Module-Install-Substitute-0.03/README0000644000175000006270000000240710171632630016256 0ustar cubiccubicNAME Module::Install::Skip - Module::Install extension that allow skip files with regexp. SYNOPSIS Makefile.PL use inc::Module::Install; ... # will skip *.in files from installation skip('\.in$'); ... METHODS skip Takes one argument - regexp. Returns nothing. Files that match regexp wouldn't be installed. Subsequent requests override previous so use complex regular expression instead. NOTES preamble This extension doesn't cover drop-ins into Makefile that was done directly, for example with ExtUtils::MakeMaker->preamble call. For example: Module::Install::RTx use preamble call for all dirs except libs, you can filter lib files but not bin/sbin. libscan M::I::Skip uses libscan overriding. I didn't test with other Module::Install extensions which uses libscan too because I don't know no such extensions on CPAN yet. AUTHOR Ruslan U. Zakirov cubic@wildgate.miee.ru COPYRIGHT This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. The full text of the license can be found in the LICENSE file included with perl distribution. SEE ALSO Module::Install.