After i parse a large .sql file this is the printed output from a %hashtable:
Key:AS_LINR
Value:
Name:DS_LSNE_DDD_TS_A
Type:view
Parents:DM_LINE_END MINA_TI_GRP_V
This is the %hash :
$hashtable{$name}="Name:$name
Type:$type
Parents:#parents"."\n\n
".
"----------------------------"
;
I need to check each parent if he exists as a key in the %hash . If he does i need to update it and add a new filed named children: , i will add as a value to the field children the name where i first found the parent .Like in this example :
Key:DM_LINE_END
Value:
Name:DS_LSNE_DDD_TS_A
Type:view
Children:AS_LINR
And i need to do this for each Parent . I want to update a hash by adding new elements to it , and if the key of the has does not exist i have to create one .
If i must explain better what i have to do please ask it in comments .
Here is my perl code :
my $var=0;
my #joinparents=();
use warnings;
my %hashtable;
open(DATA,'<','NaViews.sql') or die "Error $!";
open(Writer,'>','ResultFile.txt') or die "Error $!";
open(Writer1,'>','AuxResult.txt') or die "Error $!";
my #create_cmds = ();
my $create_cmd = "";
READ_DATA : while (<DATA>) {
chop;
my $ln = $_;
$ln =~ s/^\s+//;
$ln =~ s/\s+$//;
next READ_DATA if($ln =~ /^\-\-/);
next READ_DATA if($ln =~ /^REM/);
if($create_cmd ne "") {
$create_cmd = $create_cmd." ".$ln;
}
if($ln =~ /^create/i) {
$create_cmd = $ln;
}
elsif($ln =~ /\;$/) {
push #create_cmds, $create_cmd;
$create_cmd = "";
}
}
close DATA;
my #views = ();
foreach my $create_cmd (#create_cmds) {
$create_cmd =~ s/\s+/ /;
$create_cmd =~ s/^\s+//;
$create_cmd =~ s/\s+$//;
my $name = get_view($create_cmd);
my $type = get_type($create_cmd);
my $content = substr($create_cmd, 0, -1);
my #parents =();#get_parents();
my #children = ();#get_children();
#------------------------------------------------------------------------
my #froms = split(/ from\s+/i, $create_cmd);
my #joins = split(/ join /i, $create_cmd);
#parcurge mai multe for in aceeasi structura
#FOR FROM
# body...
foreach my $i (1..#froms-1) {
#print Writer1 "$froms[$i]"."\n\n";
my $from = (split(/ where |select | left | left | right | as /i, $froms[$i])) [0];
$from=~s/^\s+//;
$from=~s/\(+//;
my #Spaces = split(/, | , /,$from);
foreach my $x (0..#Spaces-1) {
my $SpaceFrom = (split(/ /,$Spaces[$x])) [0];
$SpaceFrom=~s/;//;
$SpaceFrom=~s/\)+//;
#print Writer1 $SpaceFrom."\n\n";
push(#parents,$SpaceFrom);
# print "\n\n".$SpaceFrom."\n\n";
# print Writer "\n\n".$SpaceFrom."\n\n";
}
foreach my $x (1..#joins-1){
#print "$joins[$i]"."\n\n";
my $join = (split(/ on /i,$joins[$x])) [0];
my $joinspace = (split(/ /i,$joins[$x])) [0];
#print Writer "\n\n".$join."\n\n";
#print Writer1 $joinspace."\n\n";
#"$joinspace\n\n";
push(#parents,$joinspace);
print Writer1"\n\n".$parents[$_]."\n\n";
}
}
push #views, [$name, $type, $content, #parents, #children];
$hashtable{$name}="[0]Name:$name
[1]Type:$type
[2]Content:$content
[3]Parents:#parents"."\n\n
".
"----------------------------";
}
print Writer "Key:$_
Value:
$hashtable{$_}\n" foreach (keys%hashtable);
#------------------------------------------------------------------------------
print_views(\#views);
exit;
#------------------------------------------------------------------------------
sub get_view {
my $create_cmd = $_[0];
my $tmp = (split(/ view | trigger | table /i, $create_cmd))[1];
$tmp =~ s/^\s+//;
my $view = (split(/\s+/, $tmp))[0];
return $view;
}
#-----------------------------------------------------------------------------
sub get_type{
my $create_cmd = $_[0];
my $tmp = (split(/ replace /i, $create_cmd))[1];
$tmp =~ s/^\s+//;
my $view = (split(/\s+/, $tmp))[0];
return $view;
}
#-----------------------------------------------------------------------------
sub get_parents {
}
sub get_children {
}
get_children();
close Writer1;
close Writer;
This is how a chunk of data i have to parse looks like :
create or replace view MINA_TI_GRP_V
as
select NVL(max(t1.interval_group),(select dm_group from sdate_dm_grp_v)) AS DM_GROUP,
(t2.interval_number) INTERVAL_NUMBER , t2.time_interval_s
from MINA_INTERVAL_CONTROL t2
left join DM_TI_GRP_DATE_TIME t1 on t2.time_interval_s >= t1.time_interval_s
group by t2.interval_number , t2.time_interval_s
order by t2.interval_number;
If you want to easily find out what the parents are for an entry in %hashtable, you'll find it much easier if you store the data as another hash rather than one giant string like this...
$hashtable{$name}={"Name" => $name, "Type" => $type, "Parents" => \#Parent};
Then you can reference $hashtable{$key}->{"Parents"} to get an array ref that contains the parents for that data entry which you could use like this...
foreach my $parent (#{$hashtable{$key}->{"Parents"}})
{
if(defined($hashtable{$parent}))
{
# Parent exists in hashtable
}
else
{
# Parent does not exist in hashtable
}
}
Related
I come to you with my question: what is the best way to replace/remove pieces of C code dynamically? I already did something in Perl using regular expressions and reading what to replace/remove from a configuration file but I can't make it dynamic.
Code:
#autoflush output so it will not interfere with calling application
local $| = 1;
##
#libraries
use warnings;
use strict;
use Switch;
use Cwd;
use File::Find;
##
#global variables
my #config;
my $file;
my $directory;
my $result;
##
if(#ARGV < 1)
{
$directory = cwd();
}
else
{
$directory = $ARGV[0];
}
$result = $directory . "\\result";
if(! -d $result)
{
mkdir ($result);
}
open LOG, ">", $result . "\\log.log";
sub start
{
my $configFile = $_[0];
open CONFIG, $configFile;
local $/;
my $conf = <CONFIG>;
close CONFIG;
foreach my $line (split(/\n\*/, $conf))
{
if(index($line, "*") == 0)
{
$line = substr($line, 1);
}
setConfig($line);
}
processFiles();
}
sub setConfig
{
my $line = $_[0];
my $count = () = $line =~ /\s*==>\s*/;
switch($count)
{
case 0
{
remove($line);
}
case 1
{
replace($line);
}
}
}
sub addSlashes
{
$_[0] =~ s/([\.\\\/\+\*\?\[\^\]\(\)\{\}\=\!\<\>\|\:\-])/\\$1/xg;
if($_[1] == 1)
{
$_[0] =~ s/([\$])/\\$1/xg;
}
return;
}
sub remove
{
my $line = $_[0];
addSlashes($line, 1);
$line =~ s/(\\\$){3}/\.\+/g;
$config[#config][0] = qr/$line/;
$config[#config - 1][1] = q("");
$line = "\\(" . $line . "\\(";
$config[#config - 1][2] = qr/$line/;
}
sub replace
{
my $line = $_[0];
my #split = split(/\s*==>\s*/, $line);
my $original = $split[0];
my $replace = $split[1];
my $regex;
addSlashes($original, 1);
addSlashes($replace, 0);
my $counter = 1;
while($original =~ /\\\$([\d]{1,3})\\\$/g)
{
if($1 <= $counter && $1 > 0)
{
$counter++;
}
else
{
print "Invalid format\n";
return;
}
}
if($counter == 1)
{
$config[#config][0] = qr/$original/;
$config[#config - 1][1] = q(") . $replace . q(");
$original = "\\(" . $original . "\\(";
$config[#config - 1][2] = qr/$original/;
return;
}
while($replace =~ /\$([\d]{1,3})\$/g)
{
if($1 <= 0 && $1 >= $counter)
{
print "Invalid format\n";
return;
}
}
$original =~ s/\\\$\d{1,3}\\\$/\(\.\+\?\)/xg;
$original =~ s/\?\)$/\)/xg;
$replace =~ s/\$(\d{1,3})\$/\$$1/xg;
$config[#config][0] = qr/$original/;
$config[#config - 1][1] = q(") . $replace . q(");
$original = "\\(" . $original . "\\(";
$config[#config - 1][2] = qr/$original/;
}
sub processFiles
{
my #files = grep { ! -d } glob "$directory\\*";
foreach my $file (#files)
{
if($file =~ /\.(h|c)$/)
{
process($file);
}
}
}
sub process
{
my $file = $_[0];
open READ, $file;
local $/;
my $text = <READ>;
close READ;
print LOG "\n--> $file <--\n";
for(my $i = 0; $i < #config; $i++)
{
my $original = $config[$i][0];
my $replace = $config[$i][1];
my $log = $config[$i][2];
while($text =~ /$log/g)
{
print LOG $log . " ----> " . $1 . "\n";
}
$text =~ s/$original/$replace/eeg;
print LOG "\n";
}
$file = $result . substr($file, rindex($file, "\\"));
open WRITE, ">", $file;
print WRITE $text;
close WRITE;
}
start("qm2asil.cfg");
close LOG;
Configuration file content:
*static
*GET_$1$() ==> $1$
*GET_$1$($2$) ==> $1$[$2$]
*SET_$1$($2$,$3$); ==> $1$[$2$] = $3$;
*SET_$1$($2$); ==> $1$ = $2$;
The idea is that there are already a few rules to replace/remove and they work but can exist more complex rules that I couldn't manage.
Example:
SET_VAR1((i),(u8)(((s32)(((s32)GET_VAR2 ((i))) != 0)) && ((s32)((u8)(((s32) (((s32)VAR3[i]) != 0)) ^ ((s32)(((s32) VAR4[i]) != 0)))))));
I want to remove SET function and make it an assignment to the variable (VAR1[i] = ...). This is one of many variations of things that need to be removed/replaced.
What do you advise me to do? Can I make it work using Perl and regex or I should reorientate to another method and/or programming language?
EDIT: I already create regexes based on the configuration file but I have problem matching unknown expressions (currently I use .+). The main idea is that I want to keep the configuration as simple I can.
regexes
I have a 100MB plain text database file which I would like to parse and convert into datastructure for easy access. The environment is perl and cygwin. Since we receive the plain text file with data from third party, I am not able to use any existing parser like xml or google protocol buffers.
Text file looks like below.
Class=Instance1
parameterA = <val>
parameterB = <val>
parameterC = <val>
ref = Instance2
Class=Instance2
parameterA = <val>
parameterB = <val>
parameterC = <val>
The file contains a huge number class variants.
What would be the best option to parse this ? Will yacc/lex help me or should i write my own perl parser ?
This should do the trick. It auto-detects the line ending by checking the first one, and the assumption here is a record is separated by a blank line.
Within each record, key/value pairs are assumed to be joined with an equal sign (=), and maybe some whitespace.
Here's my code:
#!/bin/env perl
use strict;
use warnings;
use Data::Dumper;
use Getopt::Long;
my $db_file;
GetOptions(
'file=s' => \$db_file,
);
sub detect_line_ending {
my ($fh) = #_;
my $line = <$fh>;
# Rewind to the beginning
seek($fh, 0, 0);
my ($ending) = $line =~ m/([\f\n\r]+$)/s;
return $ending;
}
sub process_chunk {
my ($chunk, $line_ending) = #_;
my #lines = split(/$line_ending/, $chunk);
my $section = {};
foreach my $line (#lines) {
my ($key, $value) = split(/[ \t]*=[ \t]*/, $line, 2);
$section->{$key} = $value;
}
return $section;
}
sub read_db_file {
my ($file) = #_;
my $data = [];
open (my $fh, '<', $file) or die $!;
my $line_ending = detect_line_ending($fh);
{
local $/ = $line_ending.$line_ending;
while (my $chunk = <$fh>) {
chomp $chunk;
my $section = process_chunk($chunk, $line_ending);
push #$data, $section;
}
}
close $fh;
return $data;
}
print Dumper read_db_file($db_file);
Is this what you want?
#!/usr/bin/perl
use Data::Dumper;
use Modern::Perl;
my %classes;
my $current;
while(<DATA>) {
chomp;
if (/^Class\s*=\s*(\w+)/) {
$classes{$1} = {};
$current = $1;
} elsif (/^(\w+)\s*=\s*(.+)$/) {
$classes{$current}{$1} = $2;
}
}
say Dumper\%classes;
Output:
$VAR1 = {
'Instance2' => {
'parameterC' => '<val>',
'parameterB' => '<val>',
'parameterA' => '<val>'
},
'Instance1' => {
'parameterC' => '<val>',
'ref' => 'Instance2',
'parameterB' => '<val>',
'parameterA' => '<val>'
}
};
I have this file
affaire,chose,question
chose,emploi,fonction,service,travail,tâche
cause,chose,matière
chose,point,question,tête
chose,objet,élément
chose,machin,truc
I would like to have an associative array like this :
affaire => chose, question
cause => chose, matière
chose => emploi, fonction, service, travail, tache, point, question, tete, objet élément, machin, truc
or even better, whenever I found a new word, save the word as a key and the context (left or/and right) as a value... So for example:
affaire => chose, question
cause => chose, matière
chose => affaire, question, cause, matière, emploi, fonction, service, travail, tache, point, question, tete, objet élément, machin, truc
At present time I'm trying to create the associative array in this way:
$in = "test.txt";
$out = "res_test.txt";
open(IN, "<", $in);
open(OUT, ">", $out);
%list = '';
while(defined($l = <IN>)){
if ($l =~ /((\w+),(.*))/){
#2,3
$list{$2} = $3;
}
}
while(my($k,$v) = each(%list)){
print OUT $k." => ".$v."\n";
}
But the result is:
affaire => chose,question
=>
chose => machin,truc
cause => chose,matière
Why doesn't it add new values?
Thank you for help.
You overwrite old hash values when you actually want to append them, so
solution would be to concatenate strings,
my %list;
while (my $l = <IN>) {
if ($l =~ /((\w+),(.*))/) {
# $list{$2} //= ""; # initialize to empty string
# # add comma in front depending on $list{$2} content
# $list{$2} .= length($list{$2}) ? ",$3" : $3;
if (defined $list{$2}) { $list{$2} .= ",$3" }
else { $list{$2} = $3 }
}
}
or to use more common hash of arrays for storing values,
my %list;
while (my $l = <IN>) {
my ($k, #vals) = split /,/, $l;
push #{ $list{$k} }, #vals;
}
use Data::Dumper; print Dumper \%list;
Each time you have new value, you assigned this new value to hash key's value, causes the old value is overridden.
A simple fix:
#!/usr/bin/perl
use strict;
use warnings;
my $in = "in";
my $out = "out";
open IN, "<", $in
or die "$!";
open OUT, ">", $out
or die "$!";
my %list = ();
while (defined(my $l = <IN>)) {
if ($l =~ /(\w+),(.*)/) {
$list{$1} .= exists($list{$1}) ? ",$2" : $2;
}
}
while(my($k,$v) = each(%list)){
print OUT $k." => ".$v."\n";
}
use Data::Dumper;
$in = "test.txt";
$out = "res_test.txt";
open(IN, "<", $in);
open(OUT, ">", $out);
%list = '';
while(defined($l = <IN>)){
chomp($l);
$list{$k} = [] unless exists $list{$k};
if ($l =~ /((\w+),(.*))/){
#2,3
push #{ $list{$2} }, $3;
}
}
foreach $k (sort keys %list) {
my #val = #{$list{$k}};
print join ', ', sort #val;
print ".\n";
}
It works!
In hash (associate array) the keys must be unique. That is why in your case chose will cause issues.
#!/usr/bin/perl
# your code goes here
use strict;
use warnings;
use Data::Dumper;
my %hash;
while(chomp(my $line = <DATA>)){
my (#values) = split /,/,$line;
my $key = shift #values;
if(exists $hash{$key}){
my $ref_value = $hash{"$key"};
push #values, #$ref_value;
$hash{"$key"} = [#values];
}
else{
$hash{"$key"} = [#values];
}
}
print Dumper %hash;
__DATA__
affaire,chose,question
chose,emploi,fonction,service,travail,tâche
cause,chose,matière
chose,point,question,tête
chose,objet,élément
chose,machin,truc
Demo
This is a follow up to the question posted here: Perl Regex syntax
The results from that discussion yielded this script:
#!/usr/bin/env perl
use strict;
use warnings;
my #lines = <DATA>;
my $current_label = '';
my #ordered_labels;
my %data;
for my $line (#lines) {
if ( $line =~ /^\/(.*)$/ ) { # starts with slash
$current_label = $1;
push #ordered_labels, $current_label;
next;
}
if ( length $current_label ) {
if ( $line =~ /^(\d) "(.*)"$/ ) {
$data{$current_label}{$1} = $2;
next;
}
}
}
for my $label ( #ordered_labels ) {
print "$label <- as.factor($label\n";
print " , levels= c(";
print join(',',map { $_ } sort keys %{$data{$label}} );
print ")\n";
print " , labels= c(";
print join(',',
map { '"' . $data{$label}{$_} . '"' }
sort keys %{$data{$label}} );
print ")\n";
print " )\n";
}
__DATA__
...A bunch of nonsense I do not care about...
...
Value Labels
/gender
1 "M"
2 "F"
/purpose
1 "business"
2 "vacation"
3 "tiddlywinks"
execute .
Essentially, I need to build the Perl to accommodate a syntax shorthand found in the SPSS file. For adjacent columns, SPSS allows one to type something like:
VALUE LABELS
/agree1 to agree5
1 "Strongly disagree"
2 "Disagree"
3 "Neutral"
4 "Agree"
5 "Strongly agree"
As the script currently exists, it will generate this:
agree1 to agree5 <- factor(agree1 to agree5
, levels= c(1,2,3,4,5,6)
, labels= c("Strongly disagree","Disagree","Neutral","Agree","Strongly agree","N/A")
)
and I need it to produce something like this:
agree1 <- factor(agree1
, levels= c(1,2,3,4,5,6)
, labels= c("Strongly disagree","Disagree","Neutral","Agree","Strongly agree","N/A")
)
agree2 <- factor(agree2
, levels= c(1,2,3,4,5,6)
, labels= c("Strongly disagree","Disagree","Neutral","Agree","Strongly agree","N/A")
)
…
use strict;
use warnings;
main();
sub main {
my #lines = <DATA>;
my $vlabels = get_value_labels(#lines);
write_output_delim($vlabels);
}
# Extract the value label information from SPSS syntax.
sub get_value_labels {
my (#vlabels, $i, $j);
for my $line (#_){
if ( $line =~ /^\/(.+)/ ){
my #vars = parse_var_range($1);
$i = #vlabels;
$j = $i + #vars - 1;
push #vlabels, { var => $_, codes => [] } for #vars;
}
elsif ( $line =~ /^\s* (\d) \s+ "(.*)"$/x ){
push #{$vlabels[$_]{codes}}, [$1, $2] for $i .. $j;
}
}
return \#vlabels;
}
# A helper function to handle variable ranges: "agree1 to agree3".
sub parse_var_range {
my $vr = shift;
my #vars = split /\s+ to \s+/x, $vr;
return $vr unless #vars > 1;
my ($stem) = $vars[0] =~ /(.+?)\d+$/;
my #n = map { /(\d+)$/ } #vars;
return map { "$stem" . $_ } $n[0] .. $n[1];
}
sub write_output_delim {
my $vlabels = shift;
for my $vlab (#$vlabels){
print $vlab->{var}, "\n";
print join("\t", '', #$_), "\n" for #{$vlab->{codes}}
}
}
sub write_output_factors {
# You get the idea...
}
__DATA__
/gender
1 "M"
2 "F"
/purpose
1 "business"
2 "vacation"
3 "tiddlywinks"
/agree1 to agree3
1 "Disagree"
2 "Neutral"
3 "Agree"
I have a string such as 'xxox-x' that I want to mask each line in a file against as such:
x's are ignored (or just set to a known value)
o's remain unchanged
the - is a variable length field that will keep everything else unchanged
therefore mask 'xxox-x' against 'deadbeef' would yield 'xxaxbeex'
the same mask 'xxox-x' against 'deadabbabeef' would yield 'xxaxabbabeex'
How can I do this succinctly preferrably using s operator?
$mask =~ s/-/'o' x (length $str - length $mask)/e;
$str =~ s/(.)/substr($mask, pos $str, 1) eq 'o' ? $1 : 'x'/eg;
$ perl -pe 's/^..(.).(.+).$/xx$1x$2x/;'
deadbeef
xxaxbeex
deadabbabeef
xxaxabbabeex
Compile your pattern into a Perl sub:
sub compile {
use feature 'switch';
my($pattern) = #_;
die "illegal pattern" unless $pattern =~ /^[-xo]+$/;
my($search,$replace);
my $i = 0;
for (split //, $pattern) {
given ($_) {
when ("x") {
$search .= "."; $replace .= "x";
}
when ("o") {
$search .= "(?<sub$i>.)";
$replace .= "\$+{sub$i}";
++$i;
}
when ("-") {
$search .= "(?<sub$i>.*)";
$replace .= "\$+{sub$i}";
++$i;
}
}
}
my $code = q{
sub {
local($_) = #_;
s/^SEARCH$/REPLACE/s;
$_;
}
};
$code =~ s/SEARCH/$search/;
$code =~ s/REPLACE/$replace/;
#print $code;
local $#;
my $sub = eval $code;
die $# if $#;
$sub;
}
To be more concise, you could write
sub _patref { '$+{sub' . $_[0]++ . '}' }
sub compile {
my($pattern) = #_;
die "illegal pattern" unless $pattern =~ /^[-xo]+$/;
my %gen = (
'x' => sub { $_[1] .= '.'; $_[2] .= 'x' },
'o' => sub { $_[1] .= "(?<sub$_[0]>.)"; $_[2] .= &_patref },
'-' => sub { $_[1] .= "(?<sub$_[0]>.*)"; $_[2] .= &_patref },
);
my($i,$search,$replace) = (0,"","");
$gen{$1}->($i,$search,$replace)
while $pattern =~ /(.)/g;
eval "sub { local(\$_) = \#_; s/\\A$search\\z/$replace/; \$_ }"
or die $#;
}
Testing it:
use v5.10;
my $replace = compile "xxox-x";
my #tests = (
[ deadbeef => "xxaxbeex" ],
[ deadabbabeef => "xxaxabbabeex" ],
);
for (#tests) {
my($input,$expect) = #$_;
my $got = $replace->($input);
print "$input => $got : ", ($got eq $expect ? "PASS" : "FAIL"), "\n";
}
Output:
deadbeef => xxaxbeex : PASS
deadabbabeef => xxaxabbabeex : PASS
Note that you'll need Perl 5.10.x for given ... when.
x can be translated to . and o to (.) whereas - becomes (.+?):
#!/usr/bin/perl
use strict; use warnings;
my %s = qw( deadbeef xxaxbeex deadabbabeef xxaxabbabeex);
for my $k ( keys %s ) {
(my $x = $k) =~ s/^..(.).(.+?).\z/xx$1x$2x/;
print +($x eq $s{$k} ? 'good' : 'bad'), "\n";
}
heres a quick stab at a regex generator.. maybe somebody can refactor something pretty from it?
#!/usr/bin/perl
use strict;
use Test::Most qw( no_plan );
my $mask = 'xxox-x';
is( mask( $mask, 'deadbeef' ), 'xxaxbeex' );
is( mask( $mask, 'deadabbabeef' ), 'xxaxabbabeex' );
sub mask {
my ($mask, $string) = #_;
my $regex = $mask;
my $capture_index = 1;
my $mask_rules = {
'x' => '.',
'o' => '(.)',
'-' => '(.+)',
};
$regex =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;
$mask =~ s/$_/$mask_rules->{$_}/g for keys %$mask_rules;
$mask =~ s/\./x/g;
$mask =~ s/\([^)]+\)/'$' . $capture_index++/eg;
eval " \$string =~ s/^$regex\$/$mask/ ";
$string;
}
Here's a character by character solution using substr rather that split. It should be efficient for long strings since it skips processing the middle part of the string (when there is a dash).
sub apply_mask {
my $mask = shift;
my $string = shift;
my ($head, $tail) = split /-/, $mask;
for( 0 .. length($head) - 1 ) {
my $m = substr $head, $_, 1;
next if $m eq 'o';
die "Bad char $m\n" if $m ne 'x';
substr($string, $_, 1) = 'x';
}
return $string unless defined $tail;
$tail = reverse $tail;
my $last_char = length($string) - 1;
for( 0 .. length($tail) - 1 ) {
my $m = substr $tail, $_, 1;
next if $m eq 'o';
die "Bad char $m\n" if $m ne 'x';
substr($string, $last_char - $_, 1) = 'x';
}
return $string;
}
sub mask {
local $_ = $_[0];
my $mask = $_[1];
$mask =~ s/-/'o' x (length($_)-(length($mask)-1))/e;
s/(.)/substr($mask, pos, 1) eq 'o' && $1/eg;
return $_;
}
Used tidbits from a couple answers ... this is what I ended up with.
EDIT: update from comments