This is my code which has switch statement works fine but if user enters greater than 3 or blank text then it should stay in first sub routine how can i do this in perl
use strict;
use warnings;
use Switch;
my $input = "Enter the number:";
sub input(){
print "Choose You Input Method"."\n";
print "1.UPC"."\n";
print "2.URL"."\n";
print "3.Elastic Search"."\n";
print $input;
$input = <>;
chomp($input);
switch($input){
case 1 {print "UPC"."\n"}
case 2 {print "URL"."\n"}
case 3 {print "Elastic Search"."\n"}
else {print "Enter the correct value"."\n"}
}
}
input();
my $pinput = "Enter the number:";
sub pinput(){
print "Choose Your Process Method"."\n";
print "1.API"."\n";
print "2.Mongo"."\n";
print $pinput;
$pinput = <>;
chomp($pinput);
switch($pinput){
case 1 {print "API"."\n"}
case 2 {print "MONGO"."\n"}
else {print "Enter the correct value"."\n"}
}
}
pinput();
if user enters something like 4 or blank data it should not pass to another sub routine it should stay on the same sub routine how can i do this?
Wrap the prompt code into a block with redo:
#!/usr/bin/perl
use warnings;
use strict;
use Switch::Plain;
PROMPT: {
chomp(my $input = <>);
nswitch ($input) {
case 1 : { print "UPC\n" }
case 2 : { print "URL\n" }
case 3 : { print "Elastic Search\n" }
default : { print "Enter the correct value\n" ; redo PROMPT }
}
}
I used Switch::Plain instead of Switch, as it is much safer (it doesn't use a source filter) and sufficient for your case.
perlfaq7 - How do I create a switch or case statement?
Using the builtin function since 5.10
use 5.010;
use strict;
use warnings;
PROMPT: {
chomp(my $input = <>);
given ( $input ) {
when( '1' ) { say "UPC" }
when( '2' ) { say "URL" }
when( '3' ) { say "Elastic Search" }
default { print "Enter the correct value"; redo PROMPT }
};
}
Related
I am making a score-keeping script in Perl, and would like to have it ask how many players there are, and ask for a name, then score, for each player. I have a good bit of this script done, but only for 3 players. the current script can be found on github here: skore
(from link:)
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my #p1name = prompt("Player 1 name?\n");
my #p2name = prompt("Player 2 name?\n");
my #p3name = prompt("Player 3 name?\n");
print "\n";
print "••• Player names locked: #p1name #p2name #p3name\n\n";
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
print "\n";
print "••• Game: #game\n";
print "••• #p1name\n";
print "••••• \e[1;32m#p1score\e[0m\n";
print "••• #p2name\n";
print "••••• \e[1;32m#p2score\e[0m\n";
print "••• #p3name\n";
print "••••• \e[1;32m#p3score\e[0m\n";
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I'd like to also point out that I'm new to perl.
OK, wow. Stop for a moment, step back and put the code down. Think about what you're trying to accomplish here.
There's a bunch of things you're doing in your code that's really going to benefit from taking a step back, and understanding what's going on, before proceeding.
First off:
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
What is this intended to do? You only use $arg 3 times here, and one of those is to copy it to $subname.
This could be quite simplified by:
my $subname = shift;
cmd_go() unless defined $subname;
Now this:
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
Where did that come from? Because I'm pretty sure that - as a beginner to perl - you didn't write that yourself, not least because you don't have any subroutines prefixed with dev_ or hid. And this sort of redirect is serious overkill for a program that basically does just one thing.
(And normally, you'd use flags like getopt rather than a command that you leave blank in a default state).
You are also massively overusing arrays - which suggests you're not really sure the difference between #game and $game.
E.g. this:
my #game = prompt("What game are we scoring?\n");
prompt does this though:
chomp(my $answer = <STDIN>); return $answer;
It returns a scalar (a single line) and you're putting it into an array for - as far as I can tell - no particular reason.
Likewise this:
my #p1score = prompt_num("score for #p1name?\n");
my #p2score = prompt_num("score for #p2name?\n");
my #p3score = prompt_num("score for #p3name?\n");
First off - you're using a bunch of single element arrays. But then you're numbering them. When ... actually, the whole point of arrays is to have numbered values.
So how about instead:
print "Num players?:\n";
chomp ( my $num = <STDIN> );
my #players;
my %scores;
for ( 1..$num ) {
print "Player name\n";
chomp ( my $name = <STDIN> );
push ( #players, $name );
}
foreach my $person ( #players ) {
print "Score for $person:\n";
chomp ( my $score = <STDIN> );
while ( $score =~ /\D/ ) {
print "Invalid - please enter numeric value\n";
chomp ( $score = <STDIN> );
}
$scores{$person} = $score;
}
foreach my $person ( #players ) {
print "$person => $score{$person}\n";
}
There are a bunch of other things that you're doing that is more complicated than it needs to be.
What I would suggest you do:
go re-read the perl basics. perldata in particular.
have a look at getopt which is a good (and standard) way to take program 'flag' style input. (e.g. showing version, if that's what you really want.
it looks a lot like you've cargo-culted the code here. I would suggest you re-write from the ground up, and when you hit a problem - ask about it on Stack Overflow, if you can't figure it out from the perl docs.
Try this. Hope this is what you wanted.
#!/usr/bin/env perl
use strict;
my $version = "1.0";
my $arg = shift(#ARGV);
my $subname = $arg;
if (!defined($arg)){
cmd_go();
}
$subname =~ s/-/_/g;
my $sub = main->can("cmd_$subname") || main->can("dev_$subname") || main->can("hid_$subname");
if (!defined($sub))
{
print STDERR "Invalid command given.\nUse \e[1;32m./skore help\e[0m for a list of commands.\n";
exit 1;
}
else
{
$sub->(#ARGV);
exit 0;
}
# Main command
sub cmd_go()
{
print "\e[2J\e[0G\e[0d"; # J = Erase in Display, 2 = Entire Screen, (G, d) = Move cursor to (..,..)
print "••••••••••••••••••••\n";
print "• Welcome to \e[1;32mskore\e[0m •\n";
print "••••••••••••••••••••\n\n";
my #game = prompt("What game are we scoring?\n");
print "••• Game name locked: #game\n\n";
my $players= prompt("Enter total number of players:\n");
my #players_list;
for(my $i=0;$i<$players;$i++){
push(#players_list , prompt("Enter Player ".($i+1)." name\n"));
}
print "\n";
print "••• Player names locked: ";
for(my $i=0;$i<$players;$i++){
print $players_list[$i]."\t";
}
print "\n\n";
my #players_score;
for(my $i=0;$i<$players;$i++){
push(#players_score, prompt("score for $players_list[$i]?\n"));
}
print "\n";
print "••• Game: #game\n";
for(my $i=0;$i<$players;$i++){
print "$players_list[$i]\n";
print "••••• \e[1;32m$players_score[$i]\e[0m\n";
}
exit 1;
}
sub cmd_help()
{
print "To get right into using skore, simply type ./skore\n";
print "For details about skore, such as version, use ./skore pkg\n";
}
sub cmd_pkg()
{
print "skore version: $version\n";
print "Detected OS: ";
exec "uname -r";
}
sub prompt {
my ($query) = #_; # take a prompt string as argument
local $| = 1; # activate autoflush to immediately show the prompt
print $query;
chomp(my $answer = <STDIN>); return $answer;
}
sub prompt_num {
NSTART:
my ($querynum) = #_;
print $querynum;
chomp(my $pnum = <STDIN>);
if ($pnum eq $pnum+0) { return $pnum; }
else { print "Error: That is not a number. Try again.\n"; goto NSTART; }
}
sub prompt_yn {
my ($queryyn) = #_;
my $answer = prompt("$queryyn (y/N): ");
return lc($answer) eq 'y';
}
I am attempting to write a code that will encrypt letters with a basic cyclic shift cipher while leaving any character that is not a letter alone. I am trying to do this through the use of a sub that finds the new value for each of the letters. When I run the code now,it formats the result so there is a single space between every encrypted letter instead of keeping the original formatting. I also cannot get the result to be only in lowercase letters.
sub encrypter {
my $letter = shift #_;
if ($letter =~ m/^[a-zA-Z]/) {
$letter =~ y/N-ZA-Mn-za-m/A-Za-z/;
return $letter;
}
else {
return lc($letter);
}
}
print "Input string to be encrypted: ";
my $input = <STDIN>;
chomp $input;
print "$input # USER INPUT\n";
my #inputArray = split (//, $input);
my $i = 0;
my #encryptedArray;
for ($i = 0; $i <= $#inputArray; $i++) {
$encryptedArray[$i] = encrypter($inputArray[$i]);
}
print "#encryptedArray # OUTPUT\n";
You might try changing this line:
if ($letter = m/[^a-zA-Z]/ ) {
To something more like this:
if ($letter =~ m/^[a-zA-Z]/) {
In the original line you are doing an assignment to the variable $letter, and the ^ will need to be before the [a-zA-Z] for the comparison.
You're attempting to do a rot13 translation on your characters. This can be done a little easier using tr:
use strict;
use warnings;
sub rot13 {
my $string = shift;
$string =~ tr/a-zA-Z/n-zA-Za-m/;
return $string;
}
print "Input string to be encrypted: ";
chomp(my $input = <STDIN>);
print "$input # USER INPUT\n";
print "Cycle of 4:\n";
for (1..4) {
$input = rot13($input);
print " $input\n";
}
Outputs
Input string to be encrypted: asdf
asdf # USER INPUT
Cycle of 4:
nFqs
ASDF
NfQS
asdf
Here is a some kind of more general implementation of it, it is easier to adapt it to something like, for example, using different rotation places for different letter:
#!/usr/bin/perl
use strict;
use warnings;
use feature qw(switch say);
sub rotateBy {
my ($letter, $rotate_places) = #_;
$rotate_places = $rotate_places ? $rotate_places : 13;
my $width = (ord 'z') - (ord 'a') + 1;
sub rotate {
my ($let, $base, $places, $width) = #_;
my $i = (ord $let) - (ord $base);
return chr((ord $base) + ($i + $places) % $width);
}
given ($letter) {
when (m/[a-z]/) {
return rotate ($letter, 'a', $rotate_places, $width);
}
when (m/A-Z/) {
return rotate ($letter, 'A', $rotate_places, $width);
}
default {
return $letter;
}
}
}
while (<>) {
chomp;
print "PLAINTEXT : $_\n";
print "CIPHERTEXT: ";
foreach my $let (split //) {
print rotateBy($let);
}
print "\n";
}
By the way, the above code looks too verbose to me, maybe there is a better way to do it.
I am new to perl, and am trying out code which uses a simple switch. The school server runs only Perl 5.12.4, so I am coding accordingly.
The issue I am having is that the variable controlling the switch will not throw any of the cases, no matter how I describe them, and is always falling through to the default case.
Ignore the contents of each case switch, I am just trying to get it to throw the print command at least so I know that the switch is operating.
# I have tried: case "1", case 1, case [1], case '1', and other variations.
#!/usr/bin/perl
# script name: phonebook.pl
while ( 1 ) {
print "Welcome to the Registry Searcher!\n";
print "Please enter a command matching one of the options below.\n";
print "1) List records alphabetically\n";
print "2) List records reverse alphabetically\n";
print "3) Search the Registry by Name\n";
print "4) Search the Registry by Birthday\n";
print "5) Exit\n";
print "Choice: ";
$in = <>;
# user enters "1".
use Switch;
switch ($in) {
case 1 {
print "Please choose either first or last name (f/l): ";
$type = <>;
if ( $type == f ) {
sort list.txt;
} elsif ( $type == "l" ) {
sort -k2 list.txt;
} else {
print "Choice not recognized.\n";
}
print "Please press enter to continue...";
$cont = <>;
}
case 2 {
print "Please choose either first or last name (f/l): ";
$type = <>;
if ( $type == "f" ) {
sort -r list.txt
} elsif ( $type == "l" ) {
sort -rk2 list.txt
} else {
print "Choice not recognized.\n";
}
print "Please press enter to continue...";
$cont = <>;
}
case 3 {
print "Please enter a last name to search for: ";
$name = <>;
# awk '/^[A-Z][a-z]+ '$name'/{print}' list.txt;
print "Please press enter to continue...";
$cont = <>;
}
else {
print "not found\n";
}
}
}
You must add chomp($in); before the switch to remove the newline.
<> read a line in a stream and include the linefeed, the behaviour is different from a scanf-like function.
You really don't want to be using Switch; that's a very old source-filter module that's unreliable, and in any case was removed from Perl a long time ago.
For better modern alternatives see Switch::Plain, or the given/when built-in operators, though beware of the latter's behaviour with "experimental" warnings.
I am trying to get parameters from command line and parse it and if the parameters are right call certain functions based on it.I am new to perl, can some one let know how to achieve this
script.pl aviator #switch is valid and should call subroutine aviator()
script.pl aviator debug #valid switch and should call subroutine aviator_debug
script.pl admin debug or script.pl debug admin #valid switch and should call subroutine admin_debug()
script.pl admin #valid switch and should call subroutine admin()
script.pl dfsdsd ##invalid switch ,wrong option
Since you are dealing with plain words (and not --switches), just look at #ARGV, which is an array of the command line options. Applying a simple if/elsif/etc to that data should serve your needs.
(For more complex requirements, I'd suggest the Getopt::Long::Descriptive module.)
Having lots of checks against specific strings is a recipe for a maintenance nightmare as your system grows more and more complex. I strongly recommend implementing some kind of dispatch table.
#!/usr/bin/perl
use strict;
use warnings;
use 5.010;
my %commands = (
aviator => \&aviator,
aviator_debug => \&aviator_debug,
admin => \&admin,
admin_debug => \&admin_debug,
debug_admin => \&admin_debug,
);
my $command = join '_', #ARGV;
if (exists $commands{$command}) {
$commands{$command}->();
} else {
die "Illegal options: #ARGV\n";
}
sub aviator {
say 'aviator';
}
sub aviator_debug {
say 'aviator_debug';
}
sub admin {
say 'admin';
}
sub admin_debug {
say 'admin debug';
}
variant 1:
#!/usr/bin/perl
my $command=join(' ',#ARGV);
if ($command eq 'aviator') { &aviator; }
elsif ($command eq 'aviator debug' or $command eq 'debug aviator') { &aviator_debug; }
elsif ($command eq 'admin debug' or $command eq 'debug admin') { &admin_debug; }
elsif ($command eq 'admin') { &admin; }
else {print "invalid option ".$command."\n";exit;}
variant 2:
#!/usr/bin/perl
if (grep /^aviator$/, #ARGV ) {
if (grep /^debug$/, #ARGV) { &aviator_debug; }
else { &aviator; }
} elsif (grep /^admin$/, #ARGV ) {
if (grep /^debug$/, #ARGV) { &admin_debug; }
else { &admin; }
} else { print "invalid option ".join(' ',#ARGV)."\n";exit;}
exit;
variant 3:
#!/usr/bin/perl
use Switch;
switch (join ' ',#ARGV) {
case 'admin' { &admin();}
case 'admin debug' { &admin_debug; }
case 'debug admin' { &admin_debug; }
case 'aviator' { &aviator; }
case 'aviator debug' { &aviator_debug; }
case 'debug aviator' { &aviator_debug; }
case /.*/ { print "invalid option ".join(' ',#ARGV)."\n";exit; }
}
Here is my take on the problem
#!/usr/bin/perl
use 5.14.0;
my $arg1 = shift;
my $arg2 = shift;
given ($arg1) {
when ($arg1 eq 'aviator') {say "aviator"}
when ($arg1 eq 'admin' && !$arg2) {say "admin"}
when ($arg1 =~ /^admin|debug$/ && $arg2 =~ /^admin|debug$/) {say "admin debug"}
default {say "error";}
}
I'd written a Perl script to generate a table of contents from HTML pages which is working fine (and generating valid HTML) except for that the Perl output is removing closing tags for some elements like p. This is not validating against DocType of strict.
Please scroll down the post to see the Perl code.
What should I do to correct it?
#!/usr/bin/perl -w
#Copyright anurag gupta ; free to use under GNU GPL License
use strict;
use feature "switch";
use Common;
use HTML::Element;
use HTML::TreeBuilder;
#"F:/anurag/work/indiacustomercare/airtel/recharge.html";
my $filename="F:/tmp/t9.html";
my $index=0;
my $labelprefix="anu555ltg-";
my $tocIndex=100001;
my $toc;
my #stack;
my $prevHtag="h2";
sub hTagEncountered($)
{
my $hTag=shift;
my $currLevel=(split //, $hTag)[1];
given($hTag)
{
when(/h1/)
{
break;
}
default{
my $countCurr= (split /h/,$hTag)[1];
my $countPrev= (split /h/,$prevHtag)[1];
if($countCurr>$countPrev)
{
push #stack,($currLevel);
$toc.="<ul>";
}
elsif($countCurr<$countPrev)
{
# Now check in the stack
while ( #stack and $currLevel < $stack[$#stack])
{
pop #stack;
$toc.="</ul>";
}
}
}
}
$prevHtag=$hTag;
}
sub getLabel
{
my $name=$labelprefix.++$tocIndex;
}
sub traversehtml
{
my $node=$_[0];
# $node->dump();
# print "-----------------\n";
# print $node->tag()."\n";
# print ref($node),"->\n";
if((ref(\$node) ne "SCALAR" )and ($node->tag() =~m/^h[2-7]$/i)) #it's an H Element!
{
my #h = $node->content_list();
if(#h==1 and ref(\$h[0]) eq "SCALAR") #H1 contains simple string and nothing else
{
hTagEncountered($node->tag());
my $label=getLabel();
my $a = HTML::Element->new('a', name => $label);
my $text=$node->as_trimmed_text();
$a->push_content($text);
$node->delete_content();
$text=HTML::Entities::encode_entities($text);
$node->push_content($a);
$toc.=<<EOF;
<li>$text
EOF
}
elsif ( #h==1 and ($h[0]->tag() eq "a")) # <h1>ttt</h1> case
{
#See if any previous label already exists
my $prevlabel = $h[0]->attr("name");
$h[0]->attr("name",undef) if(defined($prevlabel) and $prevlabel=~m/$labelprefix/); #delete previous name tag if any
#set the new label
my $label=getLabel();
$h[0]->attr("name",$label);
hTagEncountered($node->tag());
my $text=HTML::Entities::encode_entities($node->as_trimmed_text());
$toc.=<<EOF;
<li>$text
EOF
}
elsif (#h>1) #<h1>some text herettt</h1> case
{
die "h1 must not contain any html elements";
}
}
my #h = $node->content_list();
foreach my $item (#h)
{
if(ref(\$item) ne "SCALAR") {traversehtml($item); } #skip scalar items
}
}
die "File $filename not found" if !-r $filename;
my $tree = HTML::TreeBuilder->new();
$tree->parse_file($filename);
my #h = $tree->content_list();
traversehtml($h[1]);
while(pop #stack)
{
$toc.="</ul>";
}
$toc="<ul>$toc</ul>";
print qq{<div id="icctoc"><h2>TOC</h2>$toc</div>};
my #list1=$tree->content_list();
my #list2=$list1[1]->content_list();
for(my $i=0;$i<#list2;++$i){
if(ref(\$list2[$i]) eq "SCALAR")
{
print $list2[$i]
}
else{
print $list2[$i]->as_HTML();
}
}
# Finally:
Try passing {} for the \%optional_end_tags argument to as_HTML. See the documentation for details.