#!/usr/bin/perl --
#~ 2012-11-25-06:19:07PDT by Anonymous Monk
#~ perltidy -olq -csc -csci=10 -cscl="sub : BEGIN END" -otr -opr -ce
+-nibc -i=4 -pt=0 "-nsak=*"
use strict;
use warnings;
use autodie; # dies if open/close... fail
Main( @ARGV );
exit( 0 );
sub Main {
if( @_ == 3 ) {
NotDemoMeaningfulName( @_ );
} else {
Demo();
print '#' x 33, "\n", Usage();
}
}
sub NotDemoMeaningfulName {
my( $inputFile, $outputFile, $dataFile ) = @_;
my $DataRegex = MakeRegex( $dataFile );
open my( $inFh ), '<', $inputFile;
open my( $outFh ), '>', $outputFile;
my $this_line = "";
my $do_next = 0;
while( <$inFh> ) {
my $last_line = $this_line;
$this_line = $_;
if( $this_line =~ m{$DataRegex} ) {
print $outFh $last_line unless $do_next;
print $outFh $this_line;
$do_next = 1;
} else {
print $outFh $this_line if $do_next;
$last_line = "";
$do_next = 0;
}
}
close $inFh;
close $outFh;
} ## end sub NotDemoMeaningfulName
sub Usage {
<<"__USAGE__";
$0
$0 infile outfile datafile
perl ${\__FILE__}
perl ${\__FILE__} infile outfile datafile
__USAGE__
} ## end sub Usage
sub MakeRegex {
my( $inputFile ) = @_;
open my( $data ), '<', $inputFile;
my @dForRex;
while( <$data> ) {
chomp;
push @dForRex, quotemeta $_;
}
my $rex = join '|', @dForRex;
qr{$rex};
} ## end sub MakeRegex
sub Demo {
my( $Input, $WantedOutput, $Data ) = DemoData();
NotDemoMeaningfulName( \$Input, \my $Output, \$Data );
require Test::More;
Test::More::is( $Output, $WantedOutput,
' NotDemoMeaningfulName Works Aas Designed' );
Test::More::done_testing();
}
sub DemoData {
#~ http://perlmonks...
my $One = <<'__One__';
0 yes I am
1a Faking it :)
2b with a 4386_7#8
3c then a 4386_7#11
4 cause I go to 12
5a and thirteen too
6b shabba 4350_7#6
7c shabba shooby dooby doo
8 ha cha cha cha
9 hi hi hi
__One__
#~ http://perlmonks...
my $Two = <<'__Two__';
__Two__
#~ http://perlmonks...
my $Three = <<'__Three__';
4386_7#8
4350_7#6
4414_1#6
__Three__
return $One, $Two, $Three;
} ## end sub DemoData
__END__
|