Substitute 2 Non-default lines regular expression in Perl - regex

I'd like to replace the reg expression of "hh:mm:ss" of 2 strings in Perl with "xx:xx:xx" How can I accomplish this?
Code:
use strict;
use warnings;
my $l="12:48:25 - Properties - submitMode : 2";
my $r="54:01:00 - Properties - submitMode : 2";
#my $newLn;
#Find "hh:mm:ss" in $_ :P
if ($l =~ /\d\d:\d\d:\d\d/ || $r=~ /\d\d:\d\d:\d\d/) {
#print "Time found";
s/\d\d:\d\d:\d\d/xx:xx:xx/g; #looking for default $_ , but have $l and $r
s/\d\d:\d\d:\d\d/xx:xx:xx/g;
#substitute with xx: p
print $l,"\n";
print $r,"\n";
} else {
print "No time found found";
}

$l =~ s/\d\d:\d\d:\d\d/xx:xx:xx/g;
$r =~ s/\d\d:\d\d:\d\d/xx:xx:xx/g;

toolic's solution works, but if you want to use the substitution command with the default variable $_, use a foreach loop, like this:
use strict;
use warnings;
my $l="12:04:25 - Properties - submitMode : 2";
my $r="54:01:00 - Properties - submitMode : 2";
#my $newLn;
#Find "hh:mm:ss" in $_ :P
#if ($l =~ /\d\d:\d\d:\d\d/ || $r=~ /\d\d:\d\d:\d\d/) {
for ( $l, $r ) {
s/\d\d:\d\d:\d\d/xx:xx:xx/g ||
do {
print "Not time found in $_\n";
next
};
print $_,"\n";
}

Related

How can I limit this term to a 3 piece hit?

It would be the real task to sadfsadf! Ghfgh% fgh65 %% of this text to replace the first 3 characters that are true for regexp, so replace it with 'o' sadfsadfoghfghofgh65o%
#!/usr/bin/perl -w
#list=<>;
chomp(#list);
foreach(#list) {
if($_ =~ m/\W/) {
# here is the problem because all the characters you find it
# overwrite it, but I only need to translate 3 characters from it
$_ =~ s/\W/o/g;
print $_."\n";
}
else {
print "->\n";
}
}
#start string => sadfsadf!ghfgh%fgh65%%
#result my program => sadfsadfoghfghofgh65oo
#and I need it => sadfsadfoghfghofgh65o%
change only the first 3 results to 'o'
Here is a way to go:
use feature 'say';
my $in = 'sadfsadf!ghfgh%fgh65%%';
$in =~ s/\W/o/ for 1..3;
say $in;
Output:
sadfsadfoghfghofgh65o%
Solved the problem
Code:
#!/usr/bin/perl -w
while ($be=<STDIN>)
{
chomp $be;
push (#list, $be);
}
foreach $a (#list)
{
$count=0;
if ($a=~/\W/)
{
while (($a=~m/\W/g) && ($count < 3))
{
$count++;
$a=~s/\W/o/;
}
print "$a\n";
}
else {print "->\n";}
}
your data in 'list' file
perl -pe 'for $i(1..3){s/\W/o/} ' list
on bash if you put data such list='sadfsadf!ghfgh%fgh65%%'
for((i=1;i<=3;i++)){ list=`echo $list|sed -E "s/\W/Y/"`; }

perl regex not start and end wi

I am trying to write a perl script that get all strings that is does not start and end with a single quote. And a string cannot be a part of comment # and each line in DATA is not necessary at the beginning of a line.
use warnings;
use strict;
my $file;
{
local $/ = undef;
$file = <DATA>;
};
my #strings = $file =~ /(?:[^']).*(?:[^'])/g;
print join ("\n",#strings);
__DATA__
my $string = 'This is string1';
"This is string2"
# comment : "This is string3"
print "This is comment syntax #"."This is string4";
I am getting no where with this regex.
The expected output is
"This is a string2"
"This is comment syntax #"
"This is string 4"
Obviously this is only an exercise, as there are been many students asking about this problem lately. Regex's will only ever get you part of the way there, as there will pretty much always be edge cases.
The following code is probably good enough for your purposes, but it doesn't even successfully parse itself because of quotes inside a qr{}. You'll have to figure out how to get strings that span lines to work on your own:
use strict;
use warnings;
my $doublequote_re = qr{"(?: (?> [^\\"]+ ) | \\. )*"}x;
my $singlequote_re = qr{'(?: (?> [^\\']+ ) | \\. )*'}x;
my $data = do { local $/; <DATA> };
while ($data =~ m{(#.*|$singlequote_re|$doublequote_re)}g) {
my $match = $1;
if ($match =~ /^#/) {
print "Comment - $match\n";
} elsif ($match =~ /^"/) {
print "Double quote - $match\n";
} elsif ($match =~ /^'/) {
print "Single quote - $match\n";
} else {
die "Carp! something went wrong! <$match>";
}
}
__DATA__
my $string = 'This is string1';
"This is string2"
# comment : "This is string3"
print "This is comment syntax #"."This is string4";
Do not know how to achieve that by using regular expression, so here is a simple hand-written lexer:
#!/usr/bin/perl
use strict;
use warnings;
sub extract_string {
my #buf = split //, shift;
while (my $peer = shift #buf) {
if ($peer eq '"') {
my $str = "$peer";
while ($peer = shift #buf) {
$str .= "$peer";
last if $peer eq '"';
}
if ($peer) {
return ($str, join '', #buf);
}
else {
return ("", "");
}
}
elsif ($peer eq '#') {
return ("", "");
}
}
}
my ($str, $buf);
while ($buf = <DATA>) {
chomp $buf;
while (1) {
($str, $buf) = extract_string $buf;
print "$str\n" if $str;
last unless $buf;
}
}
__DATA__
my $string = 'This is string1';
"This is string2"
# comment : "This is string3"
print "This is comment syntax #"."This is string4";
Another option is using Perl module such as PPI.

replace starting characters in string

I have a string in which i need to replace the starting set of characters with mod1.
Its like xyz_gf_111_yz to mod1_111_yz.
bcd_df_222_xx to mod2_222_xx and so on.
can anybody suggest sol, as the starting string is not fixed and im beginner in perl
thanks!
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx asd_cv_333_dd);
my $i = 1;
for my $str (#strings)
{
my $after = $str;
$after =~ s/^\w{3}[_]\w{2}/mod$i/;
$i++;
print "$str -> $after\n";
}
Something like the following could get you started:
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx);
my $i = 0;
for my $str (#strings) {
my $after = $str;
$i++;
$after =~ s/[^_]+/mod$i/;
print "$str -> $after\n";
}
#Miller,
I suggest a different solution, assuming that you want to replace the starting substring (all chars to the left the first digit) and the associated digit to the "mod" string is given by the first digit of the number substring the following could be a way.
my #strings = qw(xyz_gf_111_yz bcd_df_222_xx asd_cv_333_dd);
for my $str (#strings) {
print "bfr:".$str."\n";
$str =~ s/^([^\d]+?)_(\d)/mod$2_$2/;
print "aft:".$str."\n";
}
Here's another option:
use strict;
use warnings;
my $i;
my #strings = ( 'xyz_gf_111_yz', 'bcd_df_222_xx' );
for (#strings) {
print $_, "\n" if s/.+?_[^_]+/'mod'.++$i/e;
}
Output:
mod1_111_yz
mod2_222_xx

Extract word before the 1st occurrence of a special string

I have an array that contains elements like
#array=("link_dm &&& drv_ena&&&1",
"txp_n_los|rx_n_lost",
"eof &&& 2 &&& length =!!!drv!!!0");
I want to get all the characters before the first "&&&", and if the element doesn't have a "&&&", then I need to extract the entire element.
This is what I want to extract:
likn_dm
txp_n_los|rx_n_lost
eof
I used
foreach my $row (#array){
if($row =~ /^(.*)\&{3}/){
push #firstelements,$1;
}
}
But I'm getting
link_dm &&& drv_ena
txp_n_los|rx_n_lost
eof &&& 2
Can somebody please suggest how I can achieve this?
Perhaps just splitting would be helpful:
use strict;
use warnings;
my #array = (
"link_dm &&& drv_ena&&&1",
"txp_n_los|rx_n_lost",
"eof &&& 2 &&& length =!!!drv!!!0"
);
foreach my $row (#array){
my ($chars) = split /\&{3}/, $row, 2;
print $chars, "\n"
}
Output:
link_dm
txp_n_los|rx_n_lost
eof
You can write:
#firstelements = map { m/^(.*?) *&&&/ ? $1 : $_ } #array;
Or, if you prefer foreach over map and if over ?::
foreach my $row (#array){
if($row =~ /^(.*)\&{3}/) {
push #firstelements, $1;
} else {
push #firstelements, $row;
}
}
for (#array) {
print "$1\n" if /([^ ]*)(?: *[&]{3}.*)?$/;
}
If you're using regular expressions, use the minimum spanning pattern: .*?. See perldoc perlre http://perldoc.perl.org/perlre.html
#!/usr/bin/env perl
use strict;
use warnings;
# --------------------------------------
use charnames qw( :full :short );
use English qw( -no_match_vars ); # Avoids regex performance penalty
use Data::Dumper;
# Make Data::Dumper pretty
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Indent = 1;
# Set maximum depth for Data::Dumper, zero means unlimited
local $Data::Dumper::Maxdepth = 0;
# conditional compile DEBUGging statements
# See http://lookatperl.blogspot.ca/2013/07/a-look-at-conditional-compiling-of.html
use constant DEBUG => $ENV{DEBUG};
# --------------------------------------
my #array = (
"link_dm &&& drv_ena&&&1",
"txp_n_los|rx_n_lost",
"eof &&& 2 &&& length =!!!drv!!!0",
);
my #first_elements = ();
for my $line ( #array ){
# check for '&&&'
if( my ( $first_element ) = $line =~ m{ \A (.*?) \s* \&{3} }msx ){
push #first_elements, $first_element;
}else{
push #first_elements, $line;
}
}
print Dumper \#first_elements;

Find text enclosed by # and replace the inside

The problem:
Find pieces of text in a file enclosed by # and replace the inside
Input:
#abc# abc #ABC#
cba #cba CBA#
Deisred output:
абц abc АБЦ
cba цба ЦБА
I have the following:
#!/usr/bin/perl
use strict;
use warnings;
use Encode;
my $output;
open FILE,"<", 'test.txt';
while (<FILE>) {
chomp(my #chars = split(//, $_));
for (#chars) {
my #char;
$_ =~ s/a/chr(0x430)/eg;
$_ =~ s/b/chr(0x431)/eg;
$_ =~ s/c/chr(0x446)/eg;
$_ =~ s/d/chr(0x434)/eg;
$_ =~ s/e/chr(0x435)/eg;
$_ =~ s/A/chr(0x410)/eg;
$_ =~ s/B/chr(0x411)/eg;
$_ =~ s/C/chr(0x426)/eg;
push #char, $_;
$output = join "", #char;
print encode("utf-8",$output);}
print "\n";
}
close FILE;
But I'm stuck on how to process further
Thanks for help in advance!
Kluther
Here my solution. (you will fixed it, yes. It is prototype)
for (my $data = <DATA>){
$data=~s/[#]([\s\w]+)[#]/func($1)/ge;
print $data;
# while($data=~m/[#]([\s\w]+)[#]/g){
# print "marked: ",$1,"\n";
# print "position:", pos();
# }
# print "not marked: ";
}
sub func{
#do your magic here ;)
return "<< #_ >>";
}
__DATA__
#abc# abc #ABC# cba #cba CBA#
What happens here?
First, I read data. You can do it yourself.
for (my $data = <DATA>){...}
Next, I need to search your pattern and replace it.
What should I do?
Use substition operator: s/pattern/replace/
But in interesting form:
s/pattern/func($1)/ge
Key g mean Global Search
Key e mean Evaluate
So, I think, that you need to write your own func function ;)
Maybe better to use transliteration operator: tr/listOfSymbolsToBeReplaced/listOfSymbolsThatBePlacedInstead/
With minimal changes to your algorithm you need to keep track of whether you are inside the #marks or not. so add something like this
my $bConvert = 0;
chomp(my #chars = split(//, $_));
for (#chars) {
my $char = $_;
if (/#/) {
$bConvert = ($bConvert + 1) % 2;
next;
}
elsif ($bConvert) {
$char =~ s/a/chr(0x430)/eg;
$char =~ s/b/chr(0x431)/eg;
$char =~ s/c/chr(0x446)/eg;
$char =~ s/d/chr(0x434)/eg;
$char =~ s/e/chr(0x435)/eg;
$char =~ s/A/chr(0x410)/eg;
$char =~ s/B/chr(0x411)/eg;
$char =~ s/C/chr(0x426)/eg;
}
print encode("utf-8",$char);
}
Try this after $output is processed.
$output =~ s/\#//g;
my #split_output = split(//, $output);
$output = "";
my $len = scalar(#split_output) ;
while ($len--) {
$output .= shift(#split_output);
}
print $output;
It can be done with a single regex and no splitting of the string:
use strict;
use warnings;
use Encode;
my %chars = (
a => chr(0x430),
b => chr(0x431),
c => chr(0x446),
d => chr(0x434),
e => chr(0x435),
A => chr(0x410),
B => chr(0x411),
C => chr(0x426),
);
my $regex = '(' . join ('|', keys %chars) . ')';
while (<DATA>) {
1 while ($_ =~ s|\#(?!\s)[^#]*?\K$regex(?=[^#]*(?!\s)\#)|$chars{$1}|eg);
print encode("utf-8",$_);
}
It does require repeated runs of the regex due to the overlapping nature of the matches.