[Bps-public-commit] r8713 - in RT-Extension-TicketLocking: .
ruz at bestpractical.com
ruz at bestpractical.com
Fri Aug 24 08:23:42 EDT 2007
Author: ruz
Date: Fri Aug 24 08:23:41 2007
New Revision: 8713
Added:
RT-Extension-TicketLocking/META.yml
RT-Extension-TicketLocking/inc/Module/Install/Substitute.pm
Modified:
RT-Extension-TicketLocking/Makefile.PL
RT-Extension-TicketLocking/TODO
RT-Extension-TicketLocking/inc/Module/Install/RTx.pm
Log:
* cleanup items from TODO
Added: RT-Extension-TicketLocking/META.yml
==============================================================================
--- (empty file)
+++ RT-Extension-TicketLocking/META.yml Fri Aug 24 08:23:41 2007
@@ -0,0 +1,18 @@
+---
+abstract: Enables users to place advisory locks on tickets
+author: Turner Hayes <thayes at bestpractical.com>
+distribution_type: module
+generated_by: Module::Install version 0.67
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
+name: RT-Extension-TicketLocking
+no_index:
+ directory:
+ - html
+ - inc
+ - t
+requires:
+ Test::More: 0
+version: 0.01
Modified: RT-Extension-TicketLocking/Makefile.PL
==============================================================================
--- RT-Extension-TicketLocking/Makefile.PL (original)
+++ RT-Extension-TicketLocking/Makefile.PL Fri Aug 24 08:23:41 2007
@@ -5,6 +5,25 @@
version_from ('lib/RT/Extension/TicketLocking.pm');
abstract_from('lib/RT/Extension/TicketLocking.pm');
license('perl');
+
requires('Test::More');
-&WriteAll;
+{ # check RT version
+ my @v = split /\./, "$RT::VERSION";
+ unless ($v[0]>=3 && $v[1]>=7) {
+ die "this extension needs RT 3.7.0 at least, you have $RT::VERSION";
+ }
+}
+
+my ($lib_path) = $INC{'RT.pm'} =~ /^(.*)[\\\/]/;
+my $local_lib_path = "$RT::LocalPath/lib";
+unshift @INC, $local_lib_path, $lib_path;
+
+substitute( {
+ RT_LIB_PATH => join( ' ', $local_lib_path, $lib_path ),
+ },
+ 't/test_suite.pl',
+);
+
+
+WriteAll();
Modified: RT-Extension-TicketLocking/TODO
==============================================================================
--- RT-Extension-TicketLocking/TODO (original)
+++ RT-Extension-TicketLocking/TODO Fri Aug 24 08:23:41 2007
@@ -4,8 +4,3 @@
** add description of portlet 'Element/MyLocks',
how to add to home page, how to setup config...
-* add check for RT version to Makefile.PL
-
-* use M::I::Substitute, in tests we need correct lib paths
-
-
Modified: RT-Extension-TicketLocking/inc/Module/Install/RTx.pm
==============================================================================
--- RT-Extension-TicketLocking/inc/Module/Install/RTx.pm (original)
+++ RT-Extension-TicketLocking/inc/Module/Install/RTx.pm Fri Aug 24 08:23:41 2007
@@ -40,7 +40,7 @@
until ( eval { require RT; $RT::LocalPath } ) {
warn "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
$_ = $self->prompt("Path to your RT.pm:") or exit;
- push @INC, $_, "$_/rt3/lib", "$_/lib/rt3";
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
}
}
Added: RT-Extension-TicketLocking/inc/Module/Install/Substitute.pm
==============================================================================
--- (empty file)
+++ RT-Extension-TicketLocking/inc/Module/Install/Substitute.pm Fri Aug 24 08:23:41 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;
More information about the Bps-public-commit
mailing list