[Rt-commit] r7873 - in rtfm/branches/2.1-TESTING: . inc/Module inc/Module/Install

ruz at bestpractical.com ruz at bestpractical.com
Tue May 15 19:27:17 EDT 2007


Author: ruz
Date: Tue May 15 19:27:16 2007
New Revision: 7873

Added:
   rtfm/branches/2.1-TESTING/inc/Module/Install/Substitute.pm
   rtfm/branches/2.1-TESTING/t/utils.pl
Modified:
   rtfm/branches/2.1-TESTING/   (props changed)
   rtfm/branches/2.1-TESTING/META.yml
   rtfm/branches/2.1-TESTING/Makefile.PL
   rtfm/branches/2.1-TESTING/inc/Module/Install.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/AutoInstall.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Base.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Can.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Fetch.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Include.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Makefile.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Metadata.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/Win32.pm
   rtfm/branches/2.1-TESTING/inc/Module/Install/WriteAll.pm
   rtfm/branches/2.1-TESTING/t/00smoke.t
   rtfm/branches/2.1-TESTING/t/01harness.t
   rtfm/branches/2.1-TESTING/t/02regression.t
   rtfm/branches/2.1-TESTING/t/04interface.t
   rtfm/branches/2.1-TESTING/t/2basic_api.t
   rtfm/branches/2.1-TESTING/t/3upload-customfields.t

Log:
 r311 at cubic-pc:  cubic | 2007-05-16 03:14:41 +0400
 * update inc/
 r312 at cubic-pc:  cubic | 2007-05-16 03:16:36 +0400
 * add t/utils.pl
 * use M::I::Substitute
 r313 at cubic-pc:  cubic | 2007-05-16 03:18:02 +0400
 * update tests, so we don't have to play with lib paths
 r314 at cubic-pc:  cubic | 2007-05-16 03:18:31 +0400
 * update meta


Modified: rtfm/branches/2.1-TESTING/META.yml
==============================================================================
--- rtfm/branches/2.1-TESTING/META.yml	(original)
+++ rtfm/branches/2.1-TESTING/META.yml	Tue May 15 19:27:16 2007
@@ -1,7 +1,11 @@
+--- 
 abstract: RT FM Extension
 distribution_type: module
-generated_by: Module::Install version 0.64
+generated_by: Module::Install version 0.65
 license: GPL version 2
+meta-spec: 
+  url: http://module-build.sourceforge.net/META-spec-v1.3.html
+  version: 1.3
 name: RTFM
 no_index: 
   directory: 

Modified: rtfm/branches/2.1-TESTING/Makefile.PL
==============================================================================
--- rtfm/branches/2.1-TESTING/Makefile.PL	(original)
+++ rtfm/branches/2.1-TESTING/Makefile.PL	Tue May 15 19:27:16 2007
@@ -14,4 +14,19 @@
     YAML              => 0,
 );
 auto_install();
-&WriteAll;
+
+my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
+my $sbin_path = $RT::SbinPath || "$RT::BasePath/sbin" || "/opt/rt3/sbin";
+my $bin_path = $RT::BinPath || "$RT::BasePath/bin" || "/opt/rt3/bin";
+
+substitute(
+    {
+        RT_LIB_PATH  => $lib_path,
+        RT_BIN_PATH  => $bin_path,
+        RT_SBIN_PATH => $sbin_path,
+    },
+    qw(t/utils.pl),
+);
+
+WriteAll();

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install.pm	Tue May 15 19:27:16 2007
@@ -28,7 +28,7 @@
     # 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.64';
+    $VERSION = '0.65';
 }
 
 # Whether or not inc::Module::Install is actually loaded, the

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/AutoInstall.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/AutoInstall.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/AutoInstall.pm	Tue May 15 19:27:16 2007
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Base.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Base.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Base.pm	Tue May 15 19:27:16 2007
@@ -1,7 +1,7 @@
 #line 1
 package Module::Install::Base;
 
-$VERSION = '0.64';
+$VERSION = '0.65';
 
 # Suspend handler for "redefined" warnings
 BEGIN {

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Can.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Can.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Can.pm	Tue May 15 19:27:16 2007
@@ -11,7 +11,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Fetch.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Fetch.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Fetch.pm	Tue May 15 19:27:16 2007
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Include.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Include.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Include.pm	Tue May 15 19:27:16 2007
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Makefile.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Makefile.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Makefile.pm	Tue May 15 19:27:16 2007
@@ -7,7 +7,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
@@ -136,9 +136,13 @@
                 . "but we need version >= $perl_version";
     }
 
+    $args->{INSTALLDIRS} = $self->installdirs;
+
     my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
-    if ($self->admin->preop) {
-        $args{dist} = $self->admin->preop;
+
+    my $user_preop = delete $args{dist}->{PREOP};
+    if (my $preop = $self->admin->preop($user_preop)) {
+        $args{dist} = $preop;
     }
 
     my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
@@ -205,4 +209,4 @@
 
 __END__
 
-#line 334
+#line 338

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Metadata.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Metadata.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Metadata.pm	Tue May 15 19:27:16 2007
@@ -6,14 +6,14 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }
 
 my @scalar_keys = qw{
     name module_name abstract author version license
-    distribution_type perl_version tests
+    distribution_type perl_version tests installdirs
 };
 
 my @tuple_keys = qw{
@@ -56,6 +56,11 @@
     };
 }
 
+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 !@_;
@@ -279,9 +284,11 @@
 
     if (
         $self->_slurp($file) =~ m/
-        =head \d \s+
-        (?:licen[cs]e|licensing|copyright|legal)\b
-        (.*?)
+        (
+            =head \d \s+
+            (?:licen[cs]e|licensing|copyright|legal)\b
+            .*?
+        )
         (=head\\d.*|=cut.*|)
         \z
     /ixms
@@ -298,6 +305,7 @@
             'LGPL'                                            => 'lgpl',
             'BSD'                                             => 'bsd',
             'Artistic'                                        => 'artistic',
+            'MIT'                                             => 'MIT',
         );
         while ( my ( $pattern, $license ) = splice( @phrases, 0, 2 ) ) {
             $pattern =~ s{\s+}{\\s+}g;

Added: rtfm/branches/2.1-TESTING/inc/Module/Install/Substitute.pm
==============================================================================
--- (empty file)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Substitute.pm	Tue May 15 19:27:16 2007
@@ -0,0 +1,128 @@
+#line 1
+package Module::Install::Substitute;
+
+use vars qw(@ISA);
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use strict;
+use warnings;
+
+$Module::Install::Substitute::VERSION = '0.02';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 64
+
+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 ) {
+			my ($action, $nstr) = ($1,$2);
+			$nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+			$action = 'before' 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;

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/Win32.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/Win32.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/Win32.pm	Tue May 15 19:27:16 2007
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/inc/Module/Install/WriteAll.pm
==============================================================================
--- rtfm/branches/2.1-TESTING/inc/Module/Install/WriteAll.pm	(original)
+++ rtfm/branches/2.1-TESTING/inc/Module/Install/WriteAll.pm	Tue May 15 19:27:16 2007
@@ -6,7 +6,7 @@
 
 use vars qw{$VERSION $ISCORE @ISA};
 BEGIN {
-	$VERSION = '0.64';
+	$VERSION = '0.65';
 	$ISCORE  = 1;
 	@ISA     = qw{Module::Install::Base};
 }

Modified: rtfm/branches/2.1-TESTING/t/00smoke.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/00smoke.t	(original)
+++ rtfm/branches/2.1-TESTING/t/00smoke.t	Tue May 15 19:27:16 2007
@@ -1,8 +1,11 @@
 #!/usr/bin/perl
 
+use strict;
+use warnings;
+
 use Test::More qw(no_plan);
+BEGIN { require 't/utils.pl' }
 
-use lib "/opt/rt3/lib";
 use RT;
 ok(RT::LoadConfig);
 ok(RT::Init, "Basic initialization and DB connectivity");

Modified: rtfm/branches/2.1-TESTING/t/01harness.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/01harness.t	(original)
+++ rtfm/branches/2.1-TESTING/t/01harness.t	Tue May 15 19:27:16 2007
@@ -1,8 +1,11 @@
 #!/usr/bin/perl
 
+use strict;
+use warnings;
+
 use Test::More qw(no_plan);
+BEGIN { require 't/utils.pl' }
 
-use lib "/opt/rt3/lib";
 use RT;
 ok(RT::LoadConfig);
 ok(RT::Init, "Basic initialization and DB connectivity");

Modified: rtfm/branches/2.1-TESTING/t/02regression.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/02regression.t	(original)
+++ rtfm/branches/2.1-TESTING/t/02regression.t	Tue May 15 19:27:16 2007
@@ -1,8 +1,11 @@
 #!/usr/bin/perl
 
+use strict;
+use warnings;
+
 use Test::More qw(no_plan);
+BEGIN { require 't/utils.pl' }
 
-use lib "/opt/rt3/lib";
 use RT;
 ok(RT::LoadConfig);
 ok(RT::Init, "Basic initialization and DB connectivity");

Modified: rtfm/branches/2.1-TESTING/t/04interface.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/04interface.t	(original)
+++ rtfm/branches/2.1-TESTING/t/04interface.t	Tue May 15 19:27:16 2007
@@ -1,6 +1,10 @@
 #!/usr/bin/perl
 
+use strict;
+use warnings;
+
 use Test::More qw(no_plan);
+BEGIN { require 't/utils.pl' }
 
 use lib "/opt/rt3/lib";
 use RT;
@@ -12,9 +16,9 @@
 use RT::Queue;
 use RT::Ticket;
 use Test::WWW::Mechanize;
-use_ok(RT::FM::Class);
-use_ok(RT::FM::Topic);
-use_ok(RT::FM::Article);
+use_ok 'RT::FM::Class';
+use_ok 'RT::FM::Topic';
+use_ok 'RT::FM::Article';
 
 # Variables to test return values
 my ($ret, $msg);

Modified: rtfm/branches/2.1-TESTING/t/2basic_api.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/2basic_api.t	(original)
+++ rtfm/branches/2.1-TESTING/t/2basic_api.t	Tue May 15 19:27:16 2007
@@ -2,8 +2,9 @@
 
 use warnings;
 use strict;
-use Test::More tests => 38;
 
+use Test::More tests => 38;
+BEGIN { require 't/utils.pl' }
 
 use_ok('RT');
 RT::LoadConfig();

Modified: rtfm/branches/2.1-TESTING/t/3upload-customfields.t
==============================================================================
--- rtfm/branches/2.1-TESTING/t/3upload-customfields.t	(original)
+++ rtfm/branches/2.1-TESTING/t/3upload-customfields.t	Tue May 15 19:27:16 2007
@@ -1,12 +1,16 @@
-#!/usr/bin/perl -w
+#!/usr/bin/perl
+
 use strict;
+use warnings;
+
+use Test::More qw/no_plan/;
+BEGIN { require 't/utils.pl' }
 
 BEGIN {
     use RT;
     RT::LoadConfig;
     RT::Init;
 }
-use Test::More qw/no_plan/;
 use Test::WWW::Mechanize;
 BEGIN { 
 $RT::WebPort ||= '80';

Added: rtfm/branches/2.1-TESTING/t/utils.pl
==============================================================================
--- (empty file)
+++ rtfm/branches/2.1-TESTING/t/utils.pl	Tue May 15 19:27:16 2007
@@ -0,0 +1,11 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+BEGIN {
+### after:     push @INC, qw(@RT_LIB_PATH@);
+    push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
+}
+
+1;


More information about the Rt-commit mailing list