Commit 262a0b55 authored by Jim Brandt's avatar Jim Brandt
Browse files

Add Test.pm.in and Makefile substitution config

parent 86677dd2
---
abstract: 'RT Extension-MandatoryOnTransition Extension'
author:
- 'Thomas Sibley <trs@bestpractical.com>'
build_requires:
ExtUtils::MakeMaker: 6.36
configure_requires:
ExtUtils::MakeMaker: 6.36
distribution_type: module
dynamic_config: 1
generated_by: 'Module::Install version 1.06'
license: gplv2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
name: RT-Extension-MandatoryOnTransition
no_index:
directory:
- html
- inc
- t
resources:
license: http://opensource.org/licenses/gpl-license.php
version: 0.01
use inc::Module::Install;
RTx 'RT-Extension-MandatoryOnTransition';
all_from 'lib/RT/Extension/MandatoryOnTransition.pm';
readme_from 'lib/RT/Extension/MandatoryOnTransition.pm';
......@@ -8,5 +7,27 @@ license 'gplv2';
requires_rt('4.0.0');
my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
# Straight from perldoc perlvar
use Config;
my $secure_perl_path = $Config{perlpath};
if ($^O ne 'VMS') {
$secure_perl_path .= $Config{_exe}
unless $secure_perl_path =~ m/$Config{_exe}$/i;
}
substitute(
{
RT_LIB_PATH => $lib_path,
PERL => $ENV{PERL} || $secure_perl_path,
},
{
sufix => '.in'
},
qw(lib/RT/Extension/MandatoryOnTransition/Test.pm),
);
sign;
WriteAll;
#line 1
package 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;
#line 89
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;
use strict;
use warnings;
### after: use lib qw(@RT_LIB_PATH@);
use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
package RT::Extension::MandatoryOnTransition::Test;
our @ISA;
BEGIN {
local $@;
eval { require RT::Test; 1 } or do {
require Test::More;
Test::More::BAIL_OUT(
"requires 3.8 to run tests. Error:\n$@\n"
."You may need to set PERL5LIB=/path/to/rt/lib"
);
};
push @ISA, 'RT::Test';
}
sub import {
my $class = shift;
my %args = @_;
$args{'requires'} ||= [];
if ( $args{'testing'} ) {
unshift @{ $args{'requires'} }, 'RT::Extension::MandatoryOnTransition';
} else {
$args{'testing'} = 'RT::Extension::MandatoryOnTransition';
}
$args{'config'} =<<CONFIG;
Set( %MandatoryOnTransition,
'*' => {
'open -> resolved' => [qw(TimeWorked)]
},
);
CONFIG
$class->SUPER::import( %args );
$class->export_to_level(1);
require RT::Extension::MandatoryOnTransition;
}
1;
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment