Is this code which is using Switch.pm safe? - perl

Question

In our company we were using this code (given at the end) for about 10 years and it worked fine.
Some days ago we faced some issues and we had to re-code the complete package, we decided to replace this code with Switch module by Damian (in order to improve the readability of code).
Everything is working fine for us.
Later I found on Perlmonks that Damian had put this module under
Damian modules you shouldn't use in production because their purpose
is to explore and prototype future core language features.
But it is working fine for us because we are not hitting the limitations of this module (I guess).
Now I ask you guys to please have a look at the both implementations (nested if else vs switch) and let me know whether using Switch in the newer implementation is fine or are we creating some future problems for us? Is using Switch in the code given below fine or are there any hidden bugs/problems?
I've already read the bugs and reviews of this module on CPAN and Perlmonks and I guess our code is far away from hitting those bugs (I think so).
We are using Perl 5.8.5.
PS: I know the alternatives of Switch, we have given/when in Perl 5.10, we can use dispatch table and other solutions which are specified here, but right now we just want to compare the new implementation which uses Switch.
Using nested if else
if ($command =~ /^enter$/) {
$self->show_main_frames();
}
elsif ($command =~ /^XYZ_MENU/i) {
$self->show_main_menu($manual, $dbot);
}
elsif ($command =~ /^DBOT/i) {
$dbot->process();
}
# XML is used for the reminders-history: Request 2666
elsif ($command =~ /^XML_DBOT/i) {
$dbot->process();
}
elsif ($command =~ /^UGS/i) {
$ugsui->process();
}
elsif ($command eq "kill") {
my $login = $self->{COMMON_HASH}{login} || "";
my $su_login = $self->{CONF}->get("start", "SU_LOGIN");
if ($login eq $su_login) {
# usually only certain user with certain permission will be
# able to do this.
$self->do_error("Daemon was killed by ".$login);
$self->db_connection->disconnect();
$self->{LOG}->write("User $login killed the daemon", 0);
exit; # this 'exit' actually kill the daemon
}
else {
$self->do_error("User $login tried to kill the daemon. ".
"This incident will be reported");
$self->{LOG}->write("User $login tried to kill the daemon", 2);
}
}
elsif ($command eq "logout") {
# check if we should delete the password cookie
my $forget_me = $self->{CGI}->param("forget_me") || 0;
if ($forget_me) {
$self->{DB_PASSWORD_COOKIE}->delete_cookie();
}
$ugsui->do_logout();
# Cliff edit remove id from logged_in
$session->remove_session($session->login());
# delete the session of the user
delete $self->{SESSIONS}{$session->id()};
if ($self->{CACHE_TO_FILE}) {
my $session_data_path =
XYZ_DIR
."/code/cache/session_data"
.$session->id();
unlink($session_data_path);
}
}
# if we just login we should create all the main frames
elsif ($command eq "login") {
# if extra_param holds "command*XXX" the XXX will be placed instead of
# the command. extra_param holds pairs that are astrics-separated
my $extra_param = $cgi->param("extra_param");
$extra_param = "" if (!defined($extra_param));
$extra_param =~ /command\*([^\*]+)/i;
my $other_command = defined($1) ? $1 : "";
if ($other_command =~ /^dbot/i) { # meanwhile - works only on dbot
# commands
$command = $other_command;
# now we will get the other parameters from the extra_param
# (actually including the command that is still in the
# $extra_param)
while ($extra_param =~ /^\*?([^\*]+)\*([^\*]+)(.*)/) {
$extra_param = $3;
my $name = $1;
my $value = $2;
$cgi->param(-name => $name,
-value => $value);
}#end while
}#end if
else{
$self->show_main_frames();
}
}#end elsif
else {
$self->show_main_frames();
}#end outer else
Using Switch
switch ($command)
{
case /^enter$/ { $self->show_main_frames() }
case /^XYZ_MENU/i { $self->show_main_menu($manual, $dbot) }
case /^DBOT/i { $dbot->process() }
case /^XML_DBOT/i { $dbot->process() }
case /^UGS/i { $ugsui->process() }
case "kill" {
my $login = $self->{COMMON_HASH}{login} || "";
my $su_login = $self->{CONF}->get("start", "SU_LOGIN");
if ($login eq $su_login) {
# usually only certain user with certain permission will be
# able to do this.
$self->do_error("Daemon was killed by ".$login);
$self->db_connection->disconnect();
$self->{LOG}->write("User $login killed the daemon", 0);
exit; # this 'exit' actually kill the daemon
}
else {
$self->do_error("User $login tried to kill the daemon. ".
"This incident will be reported");
$self->{LOG}->write("User $login tried to kill the daemon", 2);
}
}
case "logout" {
# check if we should delete the password cookie
my $forget_me = $self->{CGI}->param("forget_me") || 0;
if ($forget_me) {
$self->{DB_PASSWORD_COOKIE}->delete_cookie();
}
$ugsui->do_logout();
# Cliff edit remove id from logged_in
$session->remove_session($session->login());
# delete the session of the user
delete $self->{SESSIONS}{$session->id()};
if ($self->{CACHE_TO_FILE}) {
my $session_data_path =
XYZ_DIR
."/code/cache/session_data"
.$session->id();
unlink($session_data_path);
}
}
case "login" {
# if extra_param holds "command*XXX" the XXX will be placed instead of
# the command. extra_param holds pairs that are astrics-separated
my $extra_param = $cgi->param("extra_param");
$extra_param = "" if (!defined($extra_param));
$extra_param =~ /command\*([^\*]+)/i;
my $other_command = defined($1) ? $1 : "";
if ($other_command =~ /^dbot/i)
{ # meanwhile - works only on dbot
# commands
$command = $other_command;
# now we will get the other parameters from the extra_param
# (actually including the command that is still in the
# $extra_param)
while ($extra_param =~ /^\*?([^\*]+)\*([^\*]+)(.*)/) {
$extra_param = $3;
my $name = $1;
my $value = $2;
$cgi->param(-name => $name,
-value => $value);
}#end while
}#end if
else {$self->show_main_frames();}
}
else {$self->show_main_frames();}
} # end switch

Answer 1

Switch does its own parsing of the source code. This can lead to hard to diagnose errors in the code that directly uses it. The kind of problems Switch creates are not intermittent, so if your code works, you have nothing to worry about.
But really, it doesn't add much at all.
With Switch:
switch ($command) {
case /^enter$/ { $self->show_main_frames() }
case /^XYZ_MENU/i { $self->show_main_menu($manual, $dbot) }
case /^DBOT/i { $dbot->process() }
case /^XML_DBOT/i { $dbot->process() }
case /^UGS/i { $ugsui->process() }
case "kill" {
my $login = $self->{COMMON_HASH}{login} || "";
Without Switch:
for ($command) {
if (/^enter$/) { $self->show_main_frames() }
elsif (/^XYZ_MENU/i) { $self->show_main_menu($manual, $dbot) }
elsif (/^DBOT/i) { $dbot->process() }
elsif (/^XML_DBOT/i) { $dbot->process() }
elsif (/^UGS/i) { $ugsui->process() }
elsif ($_ eq "kill") {
my $login = $self->{COMMON_HASH}{login} || "";
(elsif (/^kill\z/) would also work.)

Answer 2

Actually Switch module does not provide you any "killer feature"; the same can be done with elsif statement which is secure, stable and does not have drawbacks that Switch does. Here is problems with Switch i got in my project (and i dont use it anymore):
Switch is made throgh Perl filters. This technique have following limits:
Your source code actually rewritten on-the-fly and replaces with
sequent elsif statements.
Some Perl error reports will refer wrong line; some of them showing code you dont have in your source (autogenerated code).
Not filter limit, but limit of module itself:
If the file(.pl or .pm) where you call use Swtich excess 1Mbyte size this can lead to "mysterious errors" (as written in doc). I can confirm these errors do not leading to Switch module and is completely unobivious, so you can have hard debug time after some weeks of coding/documentation.
I recommend to use elsif or given..when statements which is available since Perl 5.10. So if you using perl 5.8.x - use elsif.
Also you can read "Limitations" paragraph for Switch documentation.

Answer 3

Because Switch does own source code parsing, it does not work at all in certain circumstances. For example, it is impossible to use it with mod_perl.
However, if you have Perl 5.10 or later, there is much better replacement with effectively the same functionality: given/when
use v5.10;
given ($var) {
when (/^abc/) { $abc = 1 }
when (/^def/) { $def = 1 }
when (/^xyz/) { $xyz = 1 }
default { $nothing = 1 }
}
given is supported by Perl core (and works everywhere, including mod_perl) - you just use v5.10; and it is instantly available to you.