I hate it when requirements are eked out on "a need to know" basis! So no commentary will be provided for the following:
#!/usr/bin/env perl
use Data::Dumper;
use English('-no_match_vars');
use Getopt::Long::Descriptive;
use Params::Validate(':all');
use Readonly;
use Text::Diff;
use Try::Tiny;
use 5.01800;
use warnings;
Readonly my $VALUE_OF=>qr{\| *VALUE *= *};
Readonly my $HASHREF=>{ type=>HASHREF };
use Getopt::Long::Descriptive;
my ($opts,$usage)=describe_options(
"$0 %o <some-arg>",
['input|i=s','path to input file'],
[],
['verbose|v','print extra stuff'],
['help',"print usage message and exit", { shortcircuit => 1 } ],
);
print($usage->text), exit
if ($opts->help || !$opts->input);
warn Data::Dumper->Dump([\$opts],[qw(opts)]),' '
if ($opts->verbose);
my @failed;
open my $INPUT,'<',$opts->input
or die qq{Could NOT open '$opts->input' for reading! $OS_ERROR};
local $INPUT_RECORD_SEPARATOR=qq{\n\n};
while (<$INPUT>) {
chomp;
warn Data::Dumper->Dump([\$ARG],[qw(*_)]),' '
if ($opts->verbose);
my $_href;
=strike: Example of input
NAME|VALUE = a
TASK|VALUE = copy
CAPS|VALUE = 0
PKG_TYPE|VALUE = premium
=cut
()=m{^(?<name>.+?)$VALUE_OF(?<value>\S*) *$(?{$_href->{uc $+{name}
+}=$+{value}})}gsm;
push @failed,treat($_href);
warn "\n\n";
};
close $INPUT
or die qq{Could NOT close '$opts->input' after reading! $OS_ERROR}
+;
# Dump
warn Data::Dumper->Dump([\@failed],[qw(*failed)]),' ';
exit;
sub treat {
my ($_HREF)=Params::Validate::validate_pos(@_,$HASHREF );
warn Data::Dumper->Dump([\$_HREF],[qw(*_HREF)]),' '
if ($opts->verbose);
my @return;
# If NAME and TASK are NOT to be replaced use
#my $file="@{[delete $_HREF->{NAME}]}_@{[delete $_HREF->{TASK}
+]}.txt";
# otherwise use
my $file="$_HREF->{NAME}_$_HREF->{TASK}.txt";
#
my $keys=join q{|},keys %{$_HREF};
my $_re=qr{(?<name>$keys)$VALUE_OF(?<value>\S*)}i;
warn Data::Dumper->Dump([\$_re],[qw(*_re)]),' '
if ($opts->verbose);
try {
my $before;
open my $INPUT,'<',"input/$file"
or die qq{Could NOT open 'input/$file' for reading! $O
+S_ERROR};
local $INPUT_RECORD_SEPARATOR;
$before=<$INPUT>;
close $INPUT
or die qq{Could NOT close 'input/$file' after reading!
+ $OS_ERROR};
my $after=$before=~ s{$_re(?{ warn Data::Dumper->Dump([\%+
+],[qw(*+)]),' 'if $opts->verbose; })}{$+{name}|VALUE = $_HREF->{uc $+
+{name}}}gimrs;
#my $after=$before=~ s{$_re}{$+{name}|VALUE = $_HREF->{uc
+$+{name}}}gimrs;
warn Data::Dumper->Dump([\diff(\$before,\$after)],[qw(*dif
+ference)]),' '
if ($opts->verbose);
open my $OUTPUT,'>',"output/$file"
or die qq{Could NOT open 'output/$file' for writing! $
+OS_ERROR};
print {$OUTPUT} $after;
close $OUTPUT
or die qq{Could NOT close 'output/$file' after writing
+! $OS_ERROR};
# success
@return=();
}
catch { # Record failure
@return=("input/$file\t$OS_ERROR");
Carp::cluck $ARG
if ($opts->verbose);
};
return @return;
}; # treat
...>perl 11116842_02.t --input 11116842.dat --verbose
$opts = \bless( {
'verbose' => 1,
'input' => '11116842.dat'
}, 'Getopt::Long::Descriptive::Opts::__OPT__::1' );
at 11116842_02.t line 27.
$_ = \'NAME|VALUE = a
TASK|VALUE = copy
CAPS|VALUE = 0
PKG_TYPE|VALUE = premium';
at 11116842_02.t line 36, <$INPUT> chunk 1.
$_HREF = \{
'TASK' => 'copy',
'CAPS' => '0',
'PKG_TYPE' => 'premium',
'NAME' => 'a'
};
at 11116842_02.t line 58, <$INPUT> chunk 1.
$_re = \qr/(?<name>TASK|CAPS|PKG_TYPE|NAME)(?^u:\| *VALUE *= *)(?<valu
+e>\S*)/ui;
at 11116842_02.t line 69, <$INPUT> chunk 1.
%+ = (
'name' => 'NAME',
'value' => 'a'
);
at 11116842_02.t line 80.
%+ = (
'name' => 'TASK',
'value' => 'copy'
);
at 11116842_02.t line 80.
%+ = (
'name' => 'CAPS',
'value' => '34'
);
at 11116842_02.t line 80.
%+ = (
'name' => 'PKG_TYPE',
'value' => 'minimal'
);
at 11116842_02.t line 80.
$difference = \'@@ -31,12 +31,12 @@
dskmdsldsdsda
-CAPS|VALUE = 34
+CAPS|VALUE = 0
dksdmlsajdsajdsa
..............................
dsdksld;sads
-PKG_TYPE|VALUE = minimal
+PKG_TYPE|VALUE = premium
dsmds.dsa.d
lsdksadjsldjsdjpos
...........................
';
at 11116842_02.t line 83.
$_ = \'NAME|VALUE = z
TASK|VALUE = cut
CAPS|VALUE = 0
PKG_TYPE|VALUE = premium';
at 11116842_02.t line 36, <$INPUT> chunk 2.
$_HREF = \{
'PKG_TYPE' => 'premium',
'CAPS' => '0',
'NAME' => 'z',
'TASK' => 'cut'
};
at 11116842_02.t line 58, <$INPUT> chunk 2.
$_re = \qr/(?<name>PKG_TYPE|CAPS|NAME|TASK)(?^u:\| *VALUE *= *)(?<valu
+e>\S*)/ui;
at 11116842_02.t line 69, <$INPUT> chunk 2.
Could NOT open 'input/z_cut.txt' for reading! No such file or director
+y at 11116842_02.t line 73, <$INPUT> chunk 2.
at 11116842_02.t line 97.
main::catch {...} ("Could NOT open 'input/z_cut.txt' for readi
+ng! No such file or"...) called at C:/berrybrew/5.18.4_32/perl/site/l
+ib/Try/Tiny.pm line 123
Try::Tiny::try(CODE(0x2e8f57c), Try::Tiny::Catch=REF(0x2d57034
+)) called at 11116842_02.t line 99
main::treat(HASH(0x2e8c8fc)) called at 11116842_02.t line 47
$_ = \'NAME|VALUE = c
TASK|VALUE = paste
STACK|VALUE = 2
SHIP|VALUE = lowtier';
at 11116842_02.t line 36, <$INPUT> chunk 3.
$_HREF = \{
'NAME' => 'c',
'STACK' => '2',
'TASK' => 'paste',
'SHIP' => 'lowtier'
};
at 11116842_02.t line 58, <$INPUT> chunk 3.
$_re = \qr/(?<name>NAME|STACK|TASK|SHIP)(?^u:\| *VALUE *= *)(?<value>\
+S*)/ui;
at 11116842_02.t line 69, <$INPUT> chunk 3.
Could NOT open 'input/c_paste.txt' for reading! No such file or direct
+ory at 11116842_02.t line 73, <$INPUT> chunk 3.
at 11116842_02.t line 97.
main::catch {...} ("Could NOT open 'input/c_paste.txt' for rea
+ding! No such file "...) called at C:/berrybrew/5.18.4_32/perl/site/l
+ib/Try/Tiny.pm line 123
Try::Tiny::try(CODE(0x2e8cbec), Try::Tiny::Catch=REF(0x2e8cbdc
+)) called at 11116842_02.t line 99
main::treat(HASH(0x2e8f57c)) called at 11116842_02.t line 47
@failed = (
'input/z_cut.txt No such file or directory',
'input/c_paste.txt No such file or directory'
);
at 11116842_02.t line 53.
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.