Perl argument switch based on regex - regex

I have a Perl script that takes in arguments. When I had single value arguments, the following code sufficed:
switch ($ARGV[0]) {
case "--cmd1" {
$action = "cmd1";
}
case "--cmd2" {
$action = "cmd2";
}
Now, I have a case where the command, cmd3 has a parameter, as in --cmd3=SOMETHING. Since SOMETHING can vary, the simple switch/case does not work anymore. Basically, I need to do a switch/case on the command itself. I thought I could use a regex with the first matching group being the command and the second being the optional equals. The following does not work, but it illustrates what I'm trying to do.
$ARGV[0] =~ m/(.*?)(=.*){0,1}/;
my $cmd = $1;
my $equals = $2;
switch ($cmd) {
case "--cmd1" {
$action = "cmd1";
}
case "--cmd2" {
$action = "cmd2";
}
case "--cmd3" {
$action = "cmd3";
print $equals;
}
:::::::::::::::::::::::::::::::::::EDIT:::::::::::::::::::::::::::::::::::::::::::::::::::::
I figured it out, but I'll give the guy who answered upvotes and accept anyway. I could not use if because that means restructuring everything. Here's the solution.
switch ($ARGV[0]) {
case "--cmd1" {
$action = "cmd1";
}
case "--cmd2" {
$action = "cmd2";
}
case m/--cmd3(=.*)?/ {
$ARGV[0] =~ m/--cmd3(=.*)?/;
$action = "cmd3";
print $1;
}

Why aren't you using Getopt::Long?

How about something like this?
my $cmd = "";
my $equals = "";
if($ARGV[0] =~ m/^\-\-cmd1$/){$cmd="cmd1"}
if($ARGV[0] =~ m/^\-\-cmd2$/){$cmd="cmd2"}
if($ARGV[0] =~ m/^\-\-cmd3=(.*)$/){$cmd="cmd3";$equals=$1}

Related

Why is this switch deleting an extra line (PowerShell)

This code is supposed to find a line with a regular expression and replace the line with "test". It is finding that line and replace it with "test" but also deleting the line under it, no matter what is in the next line down. I feel like I am just missing something about how a switch works in PowerShell.
Note: This is super boiled down code. There is a larger program this is part of.
$reg = '^HI\*BH'
$appendText = ''
$file = Get-ChildItem (join-path $PSScriptRoot "a.txt.BAK")
foreach ($f in $file){
switch -regex -file $f {
$reg
{
$appendText = "test"
}
default {
If ($appendText -eq '') {$appendText = $_}
$appendText
$appendText = ''
}
}
}
a.txt.BAK
HI*BH>00>D8>0*BH>00>D8>0*BH>A1>D8>0*BH>B1>D8>0000000~
HI*BE>02>>>0.00*BE>00>>>0.00~
NM1*71*1*TTT*NAME****XX*0000000~
PRV*AT*PXC*000V00000X~
Output:
test
NM1*71*1*TTT*NAME****XX*0000000~
PRV*AT*PXC*000V00000X~
The switch is not "deleting" anything - but you explicit ask it to overwrite $appendText on match, and you only ever output (and reset the value of) $appendText when it doesn't.
This code is supposed to find a line with a regular expression and replace the line with "test".
In that case I suggest you simplify your switch:
switch -regex -file $f {
$reg {
"test"
}
default {
$_
}
}
That's it - no fiddling around with variables - just output "test" on match, otherwise output the line as-is.
If you insist on using the intermediate variable, you'll need to output + reset the value in both cases:
switch -regex -file $f {
$reg {
$appendText = "test"
$appendText
$appendText = ''
}
default {
$appendText = $_
$appendText
$appendText = ''
}
}

Powershell SWITCH and REGEX

Hi can anybody help me I am stuck and can't get regex to work with powershell and a switch statement.
Could not find anything on the web that was helpful either.
How can I filter an IP for example or a string of 7 to 8 numbers?
switch -regex ($buffer)
{
($buffer -match '[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}')
{}
($buffer -match {'\d{7,8}'})
{}
}
When used in -regex mode, PowerShell expects the case condition to be a regex pattern, nothing else:
switch -regex ($buffer)
{
'[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}'
{
# looks kinda like an IP
}
'\d{7,8}'
{
# just numbers
}
}
Use braces instead of parenthesis, and omit the variable for switch altogether:
switch (1)
{
{ $buffer -match '[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}' }
{ Write-Output "IP Address" }
{ $buffer -match '\d{7,8}' }
{ Write-Output "7-8 digits" }
}

regex validating telephone number, but chops white space using perl

So I have an HTML field in a form that takes in a phone number. It validates it correctly when I use () or / or - however, if I put in say 555 123 4567, it returns 555. As always your help is greatly appreciates it.
Here is my code
my $userName=param("userName");
my $password=param("password");
my $phoneNumber=param("phoneNumber");
my $email=param("email");
my $onLoad=param("onLoad");
my $userNameReg = "[a-zA-Z0-9_]+";
my $passwordReg = "([a-zA-Z]*)([A-Z]+)([0-9]+)";
my $phoneNumberReg = "((\(?)([2-9]{1}[0-9]{2})(\/|-|\)|\s)?([2-9]{1}[0-9]{2})(\/|-|\s)?([0-9]{4}))";
my $emailReg = "([a-zA-Z0-9_]{2,})(#)([a-zA-Z0-9_]{2,})(.)(com|COM)";
if ($onLoad !=1)
{
#controlValue = ($userName, $password, $phoneNumber, $email);
#regex = ($userNameReg, $passwordReg, $phoneNumberReg, $emailReg);
#validated;
for ($i=0; $i<4; $i++)
{
$retVal= validatecontrols ($controlValue[$i], $regex[$i]);
if ($retVal)
{
$count++;
}
if (!$retVal)
{
$validated[$i]="*"
}
}
sub validatecontrols
{
my $ctrlVal = shift();
my $regexVal = shift();
if ($ctrlVal =~ /^$regexVal$/)
{
return 1;
}
return 0;
}
}
*html code is here*
I realize that this is part of an assignment, so you may be working under specific restraints. However, your attempt to abstract out your data validation is honestly just making things messy and harder to follow. It also ties you down to specifically regex tests, which may not actually be the best bet. As has already been said, email validation should be done via a module.
Also, for this phone validation, an easier solution is just to strip out anything that isn't a number, and then do your validation test. The below code demonstrates what I'm talking about:
my $userName = param("userName");
my $password = param("password");
my $phoneNumber = param("phoneNumber");
my $email = param("email");
my $onLoad = param("onLoad");
my $error = 0;
if ($onLoad !=1)
{
if ($username !~ /^[a-zA-Z0-9_]+$/) {
$username = '*';
$error++;
}
if ($password !~ /^[a-zA-Z]*[A-Z]+[0-9]+$/) {
$password = '*';
$error++;
}
(my $phoneNumOnly = $phoneNumber) =~ s/\D//g;
if ($phoneNumOnly !~ /^1?[2-9]{1}\d{2}[2-9]{1}\d{6}$/) {
$phoneNumber = '*';
$error++;
}
if ($email !~ /^\w{2,}\#\w{2,}\.com$/i) {
$email = '*';
$error++;
}
}
*html code is here*
That regex you're using looks a overly complicated. You have a lot of capturing groups in there, but I get the feeling you're mostly using them to define "OR" statements with the vertical bar. It's usually a lot easier to just use brackets for this purpose if you're only selecting single characters. Also, it's not a good idea to use\s for normal spaces, since this will actually match any whitespace character (tabs and newlines). Maybe try something like this:
(?:\(?[2-9]\d{2}\)?[-\/ ]?)?[2-9]\d{2}[-\/ ]?\d{4}

Threads with subroutines returns nothing

I'm new to threads. I written a script to check the threads module in which i have some modules which do some pattern matching job and returns to two values 1st the input and second match found instance along with its line number. But using the threads it returns nothing.
here is the code
use threads;
sub pattern_finder($){
my $filebuf = shift;
my #threads;
my $pattern_found;
my $thr1 = threads->create(\&sub_pattern1,$filebuf);
push(#threads, $thr1);
my $thr2 = threads->create(\&sub_pattern2,$filebuf);
push(#threads, $thr2);
my $thr3 = threads->create(\&sub_pattern3,$filebuf);
push(#threads, $thr3);
for my $t(#threads){
($filebuf, $tmp)= $t->join();
$pattern_found .= $tmp;
}
return $filebuf, $pattern_found;
}
sub sub_pattern1($)
{
my ($filebuf) = shift;
my $found;
while($filebuf =~ /<LINE(\d+)>Pattern1/gsi)
{
$found .= "Pattern1 found at line $1\n";
}
return $filebuf, $found;
}
sub sub_pattern2($)
{
my ($filebuf) = shift;
my $found;
while($filebuf =~ /<LINE(\d+)>Pattern2/gsi)
{
$found .= "Pattern2 found at line $1\n";
}
return $filebuf, $found;
}
sub sub_pattern3($)
{
my ($filebuf) = shift;
my $found;
while($filebuf =~ /<LINE(\d+)>Pattern3/gsi)
{
$found .= "Pattern3 found at line $1\n";
}
$found = "$pre_checks"."$found";
return $filebuf, $found;
}
Can anyone suggest me what is wrong in the code?
Ah yes, a common problem: The code reference you pass to threads->create is called in the context that the create method was called. Here, this is scalar context. Thus return $filebuf, $found is equivalent to return $found.
As you use that single element in list context when joining the thread, you do something equivalent to $filebuf = $t->join, $tmp = undef which is not what you're expecting.
This can be fixed in two ways:
create the thread in list context:
my ($thr1) = threads->create(...)
explicitly specify the context:
my $thr1 = threads->create({context => 'list'}, \&sub_pattern1, $filebuf);
See also the section on context in the threads documentation.
Note also that there is no reason to return $filebuf at all as you don't really use that value – you just return the $filebuf of the last thread which was joined.
Tip: If you're using multithreading for performance, you should benchmark your code both with and without threads – in your case the non-threaded (sequential) solution is likely to perform better.

How to make perl regex options conditional

DON'T ASK WHY but...
I have a regex that needs to be case insensitive if run on windows BUT case sensitive when run on *nix.
Here is an example snippet of what I am kind-of doing at the moment.
sub relative_path
{
my ($root, $path) = #_;
if ($os eq "windows")
{
# case insensitive with regex option 'i'
if ($path !~ /^\Q$root\E[\\\/](.*)$/i)
{
print "\tFAIL:$root not in $path\n";
}
else
{
return $1;
}
}
else
{
# case sensitive
if ($path !~ /^\Q$root\E[\\\/](.*)$/)
{
print "\tFAIL:$root not in $path\n";
}
else
{
return $1;
}
}
return "";
}
Argh! The repetition hurts my OCD but my perl-fu is weak. Somehow I want to make the regex option 'i' for case-insensitive conditional but I don't now how?
You can use an extended construct to specify the option. For example:
#!/usr/bin/env perl
use warnings; use strict;
my $s = 'S';
print check($s, 'i'), "\n";
print check($s, '-i'), "\n";
sub check {
my ($s, $opt) = #_;
return "Matched" if $s =~ /(?$opt)^s\z/;
return "Did not match";
}
See perldoc perlre.
You can create patterns and store them in scalars using the qr operator:
sub relative_path
{
my ($root, $path) = #_;
my $pattern = ($os eq "windows") ? qr/^\Q$root\E[\\\/](.*)$/i : qr/^\Q$root\E[\\\/](.*)$/;
if ($path !~ $pattern)
{
print "\tFAIL:$root not in $path\n";
}
else
{
return $1;
}
}
This might not be 100% perfect, but hopefully you should get the idea.
Make sure to check out the section "Quote and Quote-Like Operators" in perlop.
EDIT: Okay, here's a DRY solution since people are complaining about it.
sub relative_path
{
my ($root, $path) = #_;
my $base_pattern = qr/^\Q$root\E[\\\/](.*)$/;
my $pattern = ($os eq "windows") ? qr/$base_pattern/i : $base_pattern;
if ($path !~ $pattern)
{
print "\tFAIL:$root not in $path\n";
}
else
{
return $1;
}
}
In addition to achieving the stated objective, this properly handles volumes unlike the regex patterns previously posted.
use Path::Class qw( dir );
sub relative_path {
my ($root, $path) = #_;
if ($^O =~ /Win32/) {
require Win32;
$root = Win32::GetLongPathName($root);
$path = Win32::GetLongPathName($path);
}
$root = dir($root);
$path = dir($path);
if ($root->subsumes($path)) {
return $path->relative($root);
} else {
print "\tFAIL:$root not in $path\n";
return "";
}
}
By the way, it's not very appropriate to handle the error there. The function should return an error signal (return undef, throw an exception, etc) and the caller should handle it as it sees fit. Separations of concerns.
You can also do it using local modifiers (perl extended regexes option):
sub relative_path
{
my ($root, $path) = #_;
my $pattern = "^\Q$root\E[\\\/](.*)$";
$pattern = "(?i)$pattern" if ($os eq "windows");
if ($path =~ /$pattern/)
{
return $1;
}
else
{
print "\tFAIL:$root not in $path\n";
}
}
(after I typed my answer I saw that Sinan also suggested it, but I decided to post my answer as well, since it gives a concreter answer to the question)