matching a regular expression

[s_gaurav1091]

Hi monks, I need to match a user input, like for example if a user needs to enter "hsbn" , he can enter "h" or "hs" or "hsbn" or any portion of the string hsbn. Depending upon the user's response some action is being performed. Please refer to the code I have wriiten.But it's working only if we give complete string "hsbn".

my $valid = 0;
my $state;
my $firstAttempt = 1;
while(!$valid){
        if($firstAttempt) {
             $state = promptUser("What network to listen for SNMP trap
+s [hsbn or admin]? ", "admin"); ;
                                $firstAttempt = 0;
                        }
                        else {
                                $state = promptUser("ERROR:$state Inva
+lid Re-enter the network");
                        }
                        if($state =~ /hsbn|admin/) {
                                $valid = 1;
                        }
                }

                
                if ($state =~ /hsbn/i) {
                    //some action
                }

plese suggest something...

[japhy]

You can use Text::Abbrev, which is a core module:

use Text::Abbrev;
use strict;

print "Enter a command: ";
chomp(my $action = <STDIN>);  # they could enter 'adm' or 'h'
my %modes = abbrev(qw( hsbn admin ... ));

# if $modes{$action} is defined, that means it is a
# NON-AMBIGUOUS abbreviation of 'hsbn', 'admin', etc.
if (defined(my $fullaction = $modes{$action})) {
  if ($fullaction eq 'hsbn') { ... }
  elsif ($fullaction eq 'admin') { ... }
  ...
}
else {
  print "$action was ambiguous.\n";
}

You'll have to do more work if you want to print a list of commands that matched the ambiguous action they've entered. In which case you'll probably just want to avoid Text::Abbrev altogether and roll your own solution.

Which reminds me: I think I saw this in the Perl Cookbook... if you reverse the arguments of the pattern match, you can get the desired effect:

if ("hsbn" =~ /^$action/) {
  # $action is "h", "hs", "hsb", or "hsbn"
}

Update (8:30 AM EDT): I just figured out a nifty way to do abbreviation matching and ambiguity reporting at the same time, with a regex, of course.

my $valid = join "\n", qw( hsbn admin help quit ... );
chomp(my $action = <STDIN>);
my @matches = $valid =~ /^($action.*)/mg;

if (@matches == 0) {
  print "No command matched '$action'\n";
}
elsif (@matches > 1) {
  print "Multiple commands matched '$action': [@matches]\n";
}
else {
  print "You selected $matches[0].\n";
}

I think it's pretty clever. $valid is a string with newlines between every complete action name: "hsbn\nadmin\nhelp\nquit". The regex /^($action.*)/mg does a few things. First, the /m modifier means that the ^ in the regex matches at the beginning of the string OR after any internal newline. The ($action.*) part matches not only the abbreviation the user entered, but also the rest of the non-newline characters after it (i.e. the completion of the action name). The /g modifier returns all matches found, so that if they only entered 'h', you'd get back ("hsbn", "help"). I hope that's helpful for you.

UPDATE (9:30 PM EDT): Text::Abbreviate, coming to a CPAN mirror near you...

[pileofrogs]

Brilliant! ++

[blazar]

Hi monks, I need to match a user input, like for example if a user needs to enter "hsbn" , he can enter "h" or "hs" or "hsbn" or any portion of the string hsbn.

I suppose any portion starting from the beginning, right? If so, then how 'bout

print "ok\n" if 0 == index 'hsbn', $userinput;  # ?

[GrandFather]

You can use index to good effect like this:

use strict;
use warnings;

my $state;
my $firstAttempt = 1;

while (1) {
    if($firstAttempt) {
        $state = promptUser("What network to listen for SNMP traps [hs
+bn or admin]? ", "admin"); ;
        $firstAttempt = 0;
    } else {
        $state = lc promptUser("ERROR: $state Invalid Re-enter the net
+work");
    }
    
    if (0 == index 'hsbn', $state) {
        $state = 'hsbn';
        last;
    } elsif (0 == index 'admin', $state) {
        $state = 'admin';
        last;
    }
}

if ($state eq 'hsbn') {
    #some action
}

Note that if you need to disambiguate between two strings that match for the first few characters you can require some number of characters thus:

    if (0 == index 'hsbn', $state and length ($state) >= 2) {

[blazar]

Note that if you need to disambiguate between two strings that match for the first few characters you can require some number of characters thus:

Or else one may proceed like thus:

my @matching=grep { 0 == index $_, $userinput } @commands;

Then take actions according to whether @matching==0, @matching==1 or @matching>=2. In the latter case depending on what the commands are actually supposed to do I would either emit a warning and decide upon priority (which may be given by the ordering of @commands itself) or ask the users to refine their input.

Update: minimal example follows.

#!/usr/bin/perl

use strict;
use warnings;

my @commands=qw/foo bar baz/;
print "Choose command [@commands]\n";
{
    chomp(my $cmd=<STDIN>);
    my @ok=grep { 0 == index $_, $cmd } @commands;
    print "You chose [@ok]\n" and last if @ok==1;
    warn +(@ok>1 ?
        "Ambiguos command [@ok]" :
        "Invalid command"), ", retry!\n";
    redo;
}

__END__

Usage example:

$ ./foo.pl
Choose command [foo bar baz]
fred
Invalid command, retry!
fo
You chose [foo]
$ ./foo.pl
Choose command [foo bar baz]
ba
Ambiguos command [bar baz], retry!
bar
You chose [bar]

[johngg]

This regular expression would do what you want for the choices of "hsbn" or "admin" and capture what the user entered in $1 for later processing.

use strict;
use warnings;

my $rxInput = qr
   {(?x)
      ^
      (
         h(?:s(?:b(?:n)?)?)?
         |
         a(?:d(?:m(?:i(?:n)?)?)?)?
      )
      $
   };

print "What network? ";
my $resp;
chomp($resp = <STDIN>);
print "Invalid response\n" unless $resp =~ $rxInput;

# Do something here with $1
...

I hope this is of use.

Cheers,

JohnGG

Update: Noticed and corrected cut-and-paste error where I initialised a prompt string rather than printing it.

[turo]

... is that what you're asking for?

my $valid = 0;
my $state;
my $firstAttempt = 1;
while(!$valid){
        if($firstAttempt) {
                $state = promptUser("What network to listen for SNMP t
+raps [hsbn or admin]? ", "admin");
                $firstAttempt = 0;
        }
        else {
                $state = promptUser("ERROR:$state Invalid Re-enter the
+ network", "admin");
        }
        if($state =~ /^hsbn|admin$/) {
                $valid = 1;
        }
}


if ($state =~ /^hsbn$/i) {
        //some action for hsbn
} elsif ( $state =~ /^hsb$/ ) {
        //some action for hsb
} elsif ( $state =~ /^hs$/) {
        //some action for hs
} elsif ( $state =~ /^h$/ ) {
        //some action for h
}

good luck

[Jasper]

How about:

"hsbn" =~ /^$state/ || "admin" =~ /^$state/

I think that should work. Unless I'm not seeing something :)

[sgifford]

That's a good trick, as long as the user's input is trusted; otherwise it may cause arbitrary perl code to execute. If you filtered their input to only letters and numbers, it would be safe.

Update:ikegami points out that this is only true if use re 'eval'; is on, and perlre(1) confirms this. \Q/\E should help with the possibility of creating a really slow regex, and reduce the chances of tickling a bug in Perl's regex engion that turns out to be exploitable.

[ikegami]

That's not true. Without use re 'eval', it won't execute Perl code.

my $input = '(?{ print("Hello World!\\n") })';

print(qq{Without "use re 'eval';":\n});
eval {
   '' =~ /$input/;
};
warn($@) if $@;

print("\n");

print(qq{With "use re 'eval';":\n});
eval {
   use re 'eval';
   '' =~ /$input/;
};
warn("Died: $@") if $@;

outputs

Without "use re 'eval';":
Died: Eval-group not allowed at runtime, use re 'eval' in regex m/(?{ 
+print("Hello World!\n") })/.

With "use re 'eval';":
Hello World!

On the other hand, some regexps take forever to execute. Some might even crash perl.

[Jasper]

Ah, yes, I see what you mean. Easily solved with a \Q, though.

[blazar]

Well said: just one more reason to use index instead of a regexp that fundamentally "emulates" index.

[TedPride]

Just insert whatever code words you want to check for, as an array:

$partial = 'sb';
for (qw/hsbn admin/) {
    $valid = 1, last if index($_, $partial) != -1;
}
print $valid ? 'Woohoo!' : 'Blah...';

[HuckinFappy]

Being a "Perl Best Practices" lemming, I think I'd end up with something like this:

#!/usr/bin/perl

use strict;
use warnings;
use IO::Prompt;
use Switch 'Perl6';

my $hsbnNet  = 'h|hs|hsb|hsbn';
my $adminNet = 'a|ad|adm|admi|admin';

my $prompt = "What network to listen for SNMP traps [hsbn or admin]? "
+;

my $response = 
   prompt( $prompt,
           -require => {
              "Must select either hsbn or admin.\n$prompt" =>
                 qr/^(?:$hsbnNet)$|^(?:$adminNet)$/i } );

given ( "$response" ) {
   when /$hsbnNet/  { ListenOnHsbn(); }
   when /$adminNet/ { ListenOnAdmin(); }
}

sub ListenOnHsbn {
   print "Listening on hsbn Net\n";
}

sub ListenOnAdmin {
   print "Listening on Admin Net\n";
}

[japhy]

I've not read PBP, and I don't mean to come off as sounding rude, but how is using Switch -- a source filtering module at heart -- a "best practice"? :|

And, apart from that, your $hsbnNet and $adminNet values should ideally be generated for you out of "hsbn" and "admin".

[HuckinFappy]

You'd have to try a lot harder for me to think you were being rude...with apologies to Douglas Adams, I eat ruder things than you with my breakfast cereal :)

The PBP portion of my post was really the IO::Prompt stuff. That early in the morning, I was confusing PBP and "Perl 6 Now" when I pulled in the Switch module. Thanks for pointing it out, I shouldn't have given the impression that the Switch idea was a Damian recommendation.

As to your other comment, I'm dragging this morning, and am not seeing what you're suggesting. Could you enlighten me?

Thanks,
~jeff