How to do multiple substitution using perl scripts - perl

I have a bunch of scripts I wanted to replace some texts.
Context : We are using selenium for UI Automation. We used to store the references to the UiElements in a map. But we are now moving to use PageFactory (a class with all the UiElements declared as a string)
So when we used map, we had to call the UIelements as objectMap.getIdentifier("navigate.leftsidebar"). But now with PageFactory (its like instantiating a object, and the UIElements are declared as a string), I can access these UIelements objectPageFactory.navigate_leftsidebar (here navigate_leftsidebar is a String)
So I will need to go modify all my existing scripts. Is there a way I can write a script to get this replaced, than doing it manually ?
Below are the 3 scenarios that I will encounter :
Click(getElement(objectMap.getIdentifier("navigate.leftsidebar").replace("$Page", "Inbox")), "clicking on an element");
objectMap.getIdentifier("navigate.leftsidebar")
Click(objectMap.getIdentifier("navigate.leftsidebar"), "clicking on an element");
This is the expected output:
Click((objectPageFactory.navigate_leftsidebar("Inbox")), "clicking on an element");
objectPageFactory.navigate_leftsidebar
Click(objectPageFactory.navigate_leftsidebar, "clicking on an element");
Changes are :
"objectMap" to be renamed as "objectPageFactory"
There could be different types of map. if objectMap , it should be replaced as objectPageFactory; if loginMap, it should be changed as loginPageFactory
objectMap.getIdentifier("navigate.leftsidebar") >>>> objectFactory.navigate_leftsidebar (the String literal inside the bracket is separated by underscore instead of dots
getElement is not needed now
we used to have some dynamic UiElements (navigate.leftsidebar in this case), for which we used to call String.replace, now we are writing functions which will internally do a String.format
getElement(objectMap.getIdentifier("navigate.leftsidebar").replace("$Page", "Inbox")) >>>>> objectPageFactory.navigate_leftsidebar("Inbox")
I got a perl script from this link, which will do partial job sed command to replace dots.
I just need to add the different scenarios to this, is there a way ? the output should now have a pageFactory text too, based on which map
#! /usr/bin/perl
use strict ;
sub fix { $_ = shift ; s/"//g ; s/\./_/g ; return $_ }
while ( <> ) {
s/getElement\(objectMap\.getIdentifier\(("?[a-z.]+"?)\)/fix($1)/e ;
s/objectMap\.getIdentifier\(("?[a-z.]+"?)\)/fix($1)/e ;
print
}

This seems to provide the output you requested. I don't understand the language you're changing, so there might be corner cases it processes wrong. Make a backup before you change the files!
#!/usr/bin/perl
use warnings;
use strict;
sub fix {
my ($id) = #_;
return $id =~ s/[.]/_/gr
}
while (<>) {
s{getElement\((object|login)Map\.getIdentifier\("([^"]*)"\)\.replace\("\$Page", "([^"]*)"\)\)}
{"$1PageFactory." . fix($2) . qq(("$3"))}ge;
s{(object|login)Map\.getIdentifier\("([^"]*)"\)}
{"$1PageFactory." . fix($2)}ge;
print;
}

Related

how to find multiple regex patterns in a single way using Perl

Question Updated
I have list of (few more) regex patterns like: (Note: Sequence is very Important)
([a-z]+)(\d+)
\}([a-z]+)
([a-z]+)(\+|\-)
([0-9])\](\+|\-)
...
...
my input file like :
\ce{CO2}
\ce{2CO}
\ce{H2O}
\ce{Sb2O3}
...
...
In my code I am finding the each and every regex patterns like
if($string=~m/([a-z]+)(\d+)/g) { my statements ... }
if($string=~m/\}([a-z]+)/g) { my statements ... }
if($string=~m/([a-z]+)(\+|\-)/g) { my statements ... }
if($string=~m/([0-9])\](\+|\-)/g) { my statements ... }
Instead of doing the above code Is there any other way to simplify the code?
Could you someone please share your thoughts for my improvement for better coding.
Disclaimer: Your question is very hard to read, so this is pretty much guesswork. I am not sure I understand what you want to do.
When you are processing data in a dynamic way, a typical approach is to use a dispatch table. We can do something similar here. Often a hash or hash reference is used for that, but since we want a specific order, I will be using an array instead.
my #dispatch = (
{
pattern => qr/f(o)(o)/,
callback => sub {
my ($one, $two) = #_;
print "Found $one and $two\n";
},
},
{
pattern => qr/(bar)/,
callback => sub {
my $capture = shift;
print "Saw $capture";
},
},
);
This basically is a list of search patterns and associated instructions. Each pattern has a callback, which is a code reference. I decided it would make sense to pass in the capture variables, because your patterns have capture groups.
Now in order to call them, we iterate over the dispatch array, match the pattern and then call the associated callback, passing in all the captures.
my $text = "Foo bar foo bar baz.";
foreach my $search (#dispatch) {
if ($text =~ $search->{pattern}) {
$search->{callback}->(#{^CAPTURE}); # this requires Perl 5.26
}
}
Please note that I am using #{^CAPTURE}, which was added to Perl in version 5.25.7, so you would require at least the stable Perl 5.26 release to use it. (On an older Perl, my #capture = $t =~ $search->{pattern} and $search->{callback}->(#capture) will behave similarly).
This is way more elegant than having a list of if () {} statement because it's very easy to extend. The dispatch table could be created on the fly, based on some input, or entirely read from disk.
When we run this code, it creates the following output
Found o and o
Saw bar
This is not very spectacular, but you should be able to adapt it to your patterns. On the other hand I don't know what you are actually trying to do. If you wanted to modify the string instead of only matching, you might need additional arguments for your callbacks.
If you want to learn more about dispatch tables, I suggest you read the second chapter of Mark Jason Dominus' excellent book Higher Order Perl, which is available for free as a PDF on his website.
Your question is hard to read, mainly because you have the /g at the end of your regex searches (which returns a list), however, you only check if it matches once.
I'm making the following assumptions
All matches are required
the code can be a single or double match
both groups captured in one line
i think you want
while ( $string =~ /(([a-z]+)(\d+)|\}([a-z]+)|([a-z]+)(\+|\-)|([0-9])\](\+|\-))/g )
{
#$1 has the whole match
#$2 has the first group if defined
#$3 has the second group if defined
}
However, I prefer the method below. this will capture in one line
while ($string =~ /([a-z]+\d+|\}[a-z]+|[a-z]+\+|\-|[0-9]\]\+|\-)/g )
{
# in here split the match if required
}
I recommend you use regex comments to make this clearer.
if you just want a single match, use
if(
$string=~m/([a-z]+)(\d+)/ ||
$string=~m/\}([a-z]+)/ ||
$string=~m/([a-z]+)(\+|\-)/ ||
$string=~m/([0-9])\](\+|\-)/
)
{
#some code
}

Not enough arguments when redefining a subroutine

When I redefine my own subroutine (and not a Perl built-in function), as below :
perl -ce 'sub a($$$){} sub b {a(#_)}'
I get this error :
Not enough arguments for main::a at -e line 1, near "#_)"
I'm wondering why.
Edit :
The word "redefine" is maybe not well chosen. But in my case (and I probably should have explained what I was trying to do originally), I want to redefine (and here "redefine" makes sense) the Test::More::is function by printing first Date and Time before the test result.
Here's what I've done :
Test::More.pm :
sub is ($$;$) {
my $tb = Test::More->builder;
return $tb->is_eq(#_);
}
MyModule.pm :
sub is ($$;$) {
my $t = gmtime(time);
my $date = $t->ymd('/').' '.$t->hms.' ';
print($date);
Test::More::is(#_);
}
The prototype that you have given your subroutine (copied from Test::More::is) says that your subroutine requires two mandatory parameters and one optional one. Passing in a single array will not satisfy that prototype - it is seen as a single parameter which will be evaluated in scalar context.
The fix is to retrieve the two (or three) parameters passed to your subroutine and to pass them, individually, to Test::More::is.
sub is ($$;$) {
my ($got, $expected, $test_name) = #_;
my $t = gmtime(time);
my $date = $t->ymd('/').' '.$t->hms.' ';
print($date);
Test::More::is($got, $expected, $test_name);
}
The problem has nothing to do with your use of a prototype or the fact that you are redefining a subroutine (which, strictly, you aren't as the two subroutines are in different packages) but it's because Test::More::is() has a prototype.
You are not redefining anything here.
You've set a prototype for your sub a by saying sub a($$$). The dollar signs in the function definition tell Perl that this sub has exactly three scalar parameters. When you call it with a(#_), Perl doesn't know how many elements will be in that list, thus it doesn't know how many arguments the call will have, and fails at compile time.
Don't mess with prototypes. You probably don't need them.
Instead, if you know your sub will need three arguments, explicitly grab them where you call it.
sub a($$$) {
...
}
sub b {
my ($one, $two, $three) = #_;
a($one, $two, $three);
}
Or better, don't use the prototype at all.
Also, a and b are terrible names. Don't use them.
In Perl, prototypes don't validate arguments so much as alter parsing rules. $$;$ means the sub expects the caller to match is(EXPR, EXPR) or is(EXPR, EXPR, EXPR).
In this case, bypassing the prototype is ideal.
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
return &Test::More::is(#_);
}
Since you don't care if Test::More::is modifies yours #_, the following is a simple optimization:
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
return &Test::More::is;
}
If Test::More::is uses caller, you'll find the following useful:
sub is($$;$) {
print gmtime->strftime("%Y/%m/%d %H:%M:%S ");
goto &Test::More::is;
}

How can I use a Perl variable in my Log::Log4perl config file?

I would like to use a Perl variable from my script in a Log::Log4perl config file. I read the documentation and found that I can use a subroutine, but I would like to do it a little bit simpler, if possible.
I want to set the filename for my appender:
log4perl.appender.av_std_LOGFILE.filename="whateverfilename.log"
But doing this this way, it is a fixed value.
I have the filename in a variable within my script and would like to use this at runtime:
log4perl.appender.av_std_LOGFILE.filename=\
sub { return &av_getLogfileName(); }
Where this is the subroutine:
sub av_getLogfileName
{
return $av_std_LOGFILE;
}
This works, but I would like to avoid the sub inside my script since the return value is very simple.
The documentation says:
Each value starting with the string sub {... is interpreted as Perl code to be executed at the time the application parses the configuration...
So I tried something like this, but it did not work:
log4perl.appender.av_std_LOGFILE.filename=\
sub { print "$av_std_LOGFILE"; }
Is there a way to get result of the variable without the sub inside my script?
print returns 1 on success, so
sub { print "$av_std_LOGFILE"; }
returns 1, not the value of $av_std_LOGFILE. You also have to fully qualify variable names in hooks, which means you'll have to make $av_std_LOGFILE a package global.
Change your hook to:
sub { return $main::av_std_LOGFILE; } # double quotes are unnecessary
and set $av_std_LOGFILE in your script like this (before calling Log::Log4perl::init):
our $av_std_LOGFILE = '/path/to/logfile';
Generally, you should avoid global variables, so I would prefer using a subroutine.

Returning a hash value

I have .ini file (config file for the database operations):
[Section1]
SQL1=select * from <tablename>
SQL2=insert into table <table name>
I have written below code to read the each section of .ini file and its working perfect. I have to use below subroutine in my mail file, I want to call it and pass the each value in each section into the hash over there and do the database operations.
below is code:
sub Read_INI_files_get_initialData {
my ( %ini_file, $ini_sect );
tie %ini_file, 'IniFiles',( -file => "/home/testtool/config/InitialData.ini" );
for $ini_sect ( keys %ini_file ) {
%$ini_sect = %{ $ini_file{$ini_sect} };
}
print "$Section1{SQL1}\n"; # output prints the 1st SQL1 statement return in .ini file.
return (\%Section1);
}
When I call this subroutine from main file, I don't get any return value which I could use for further database opration.
You have a mixup with your variables. Also I'm not sure what you are trying to do. If you only want to read Section1, consider this example (which I have not tested).
use strict;
use warnings;
use feature 'say';
sub Read_INI_files_get_initialData {
tie my %ini_file, 'IniFiles',( -file => "/home/testtool/config/InitialData.ini" );
say "$ini_file{Section1}->{SQL1}";
# return a hashref
return { $ini_file{Section1} };
}
Basically what you did was the following:
for $ini_sect ( keys %ini_file ) {
%$ini_sect = %{ $ini_file{$ini_sect} };
}
print "$Section1{SQL1}\n"; # output prints the 1st SQL1 statement return in .ini file.
return (\%Section1);
The $ini_sect is declared above, but then you use it to iterate over the keys. So the first time the for is run, it will get a key of %ini_file. Now in the loop you asume it is actually a hashref, dereference it and assign another hash (which you dereferenced from a hash ref using the key). There are two issues here.
First, you are overwriting the variable that holds the key. In the next iteration, that value would be gone.
Second, and more important, you are trying to dereference a string. That won't work. If you add use strict and use warnings to you program (as I did above), it will tell you Can't use string ("Section1") as a HASH ref.... So there lies another problem.
What it will also tell you is that Global symbol "%Section1" requires explicit package name in the return, because you never declared it.
Think about what you want to do in your function. Use as many variables as you need, and give them meaningful names. Do you just want to read the first section of the file? Go ahead, reference it directly.
Do you want to make a copy of the whole thing? Maybe tie is not the best option. See Config::IniFiles how to do it with an OOp interface.
If I understand you correctly, you want to use the tied hash to access the SQL statements specified in your config file. This can be done by using the nested hash structure $ini_file{SectionName}{VariableName}:
use strict;
use warnings;
use Config::IniFiles;
my %initialData = Read_INI_files_get_initialData();
print $initialData{Section1}{SQL1} . "\n"; # Prints the Section1 SQL1 statement from .ini file.
sub Read_INI_files_get_initialData {
my %ini_file;
tie %ini_file, 'Config::IniFiles', ( -file => "InitialData.ini" );
return %ini_file;
}

What does "Useless use of a variable in void context" mean in this Perl script?

The following script gives me what I want but Perl also throws me a warning saying "Useless use of a variable in void context". What does it mean?
use strict;
use warnings;
my $example = 'http\u003a//main\u002egslb\u002eku6\u002ecom/c0/q7LmJPfV4DfXeTYf/1260269522170/93456c39545857a15244971e35fba83a/1279582254980/v632/6/28/a14UAJ0CeSyi3UTEvBUyMuBxg\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c1/q7LmJPfV4DfXeTYf/1260269522170/3cb143612a0050335c0d44077a869fc0/1279582254980/v642/10/20/7xo2MJ4tTtiiTOUjEpCJaByg\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c2/q7LmJPfV4DfXeTYf/1260269522170/799955b45c8c32c955564ff9bc3259ea/1279582254980/v652/32/4/6pzkCf4iqTSUVElUA5A3PpMAoA\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c3/q7LmJPfV4DfXeTYf/1260269522170/cebbb619dc61b3eabcdb839d4c2a4402/1279582254980/v567/36/19/MBcbnWwkSJu46UoYCabpvArA\u002ef4v\u002chttp\u003a//main\u002egslb\u002eku6\u002ecom/c4/q7LmJPfV4DfXeTYf/1260269522170/1365c39355424974dbbe4ae8950f0e73/1279582254980/v575/17/15/EDczAa0GTjuhppapCLFjtaQ\u002ef4v';
my #raw_url = $example =~ m{(http\\u003a.+?f4v)}g;
my #processed_url = map {
s{\\u003a}{:}g,$_;
s{\\u002e}{.}g,$_;
s{\\u002d}{#}g,$_;
} #raw_url;
print join("\n",#processed_url);
And why this map thing doesn't work if I omit those dollar underscores like so?
my #processed_url = map {
s{\\u003a}{:}g;
s{\\u002e}{.}g;
s{\\u002d}{#}g;
} #raw_url;
When I omit those dollar underscores, I get nothing except for a possibly success flag "1". What am I missing? Any ideas? Thanks like always :)
What you want is...
my #processed_url = map {
s{\\u003a}{:}g;
s{\\u002e}{.}g;
s{\\u002d}{#}g;
$_;
} #raw_url;
A map block returns the value composed of the last statement evaluated as its result. Thats why we pass the $_ as the last statement. The substitution operator s{}{} returns the number of substitutions made.
In your prior setup, you had by itself the following statement. Which is pretty much meaningless and that is what Perl is warning about.
s{\\u003a}{:}g, $_;
You already have the answer you were looking for, but I wanted to point out a subtlety about using the substitution operator inside a map block: your original array is also being modified. If you want to preserve the original array, one way to do it is to make a copy of the array, then modify only the copy:
my #processed_url = #raw_url;
for (#processed_url) {
s{\\u003a}{:}g;
s{\\u002e}{.}g;
s{\\u002d}{#}g;
}
Or, if you only need one array, and you want the original to be modified:
for (#raw_url) {
s{\\u003a}{:}g;
s{\\u002e}{.}g;
s{\\u002d}{#}g;
}