How to translate switch statement to Perl

Question

I am porting a csh script to Perl. I am doing a switch statement in Perl. I am not sure if this is right, based on the different comments that switch statements are no longer in use in Perl. Can you please give me an idea if this is right? Also in switch statement do we use 'when' or 'case'?

This is the csh code:

set machine = c16991
set pgMachine = lc0140


if ( ! -e /abc/site/home/$USER/.userauthentication) then
echo "-F- .userauthentication file must be created in /abc/site/home/$USER "
echo "-I- .userauthentication file format: <emailaddress> <unix pwd>. 
echo "-I- Please make sure /abc/site/home/$USER/.userauthentication  permission is set to 000"
exit
endif

set permissionCheck = `ls -ltra /abc/site/home/$USER/.userauthentication |  awk '{print $1}' | 
if ($permissionCheck != 'DASHrwDASHDASHDASHDASHDASHDASHDASH') then
echo "-F- /abc/site/home/$USER/.userauthentication permission is set to    $permission1"
exit
endif


@ i = 1

while ($i <= $#argv) 
   switch ($argv[$i])
   case -block:
     shift
     set DBB1 = $argv[$i]
     shift
     breaksw
   case -tag:
     shift
     set tag = $argv[$i]
     shift 
     breaksw
   case -local:
  shift
     set local = $argv[$i]
     shift
     breaksw
   case -ar:
     shift
     set arType = $argv[$i]
     shift
     breaksw  

   default:
     echo "-E- Invalid switch -> {$argv[$i]} found!"
     goto usage
    exit
   endsw
end



if ($local == 'y') then
   if ($tag == "")then
   echo "-F- Please enter tag value to proceed!"
   exit
   endif
endif


set DBB1 = $DBB

### grab data locally

set shipLogFile = "$WARD/ship/log/${DBB1}.ship.log"
set shipUsername = `grep "Username:" $shipLogFile | sed 's/.*Username: //' |    sed 's/;.*//'`
set reviewCloseFile = "$WARD/ship/ip/${DBB1}/swizzled/review/${DBB1}.close"
set accept10SumFile = "$WARD/ship/ip/${DBB1}/swizzled/pds/logs/${DBB1}.ccdo_accept10.iss.log.sum"
set shipDate = `zgrep "::RUNTIME:: SHIP end time/date:" $shipLogFile | sed 's/.*time\/date\://g' | sed 's#"##g'`

else


 ###grab data from archive [DEFAULT]

if ($shipTag == "") then
if ($DBB1 == "") then
# grab DEFAULT hip value from running WARD, $DBB
set DBB1 = $DBB
endif
# grab DEFAULT ship tag value for archive from the latest tag
set shipTag = `ls -t $PROJ_ARCHIVE/noa/${DBB1}/ip_handoff_noa | grep  "^$STEPPING" | grep RTL | grep -v RTL0 | grep -v "_TEMP" | head -n 1`
else
if ($DBB1 == "") then
# grab DEFAULT hip value from running WARD, $DBB
set DBB1 = $DBB
endif
endif

set shipUsername = `zgrep "User Name:"    $PROJ_ARCHIVE/noa/${DBB1}/ip_handoff_noa/$shipTag/${DBB1}.ip_handoff_noa.manifes t.gz | sed 's/.*\.//g' | sed 's/^ \+\| \+$//g'`
set shipLogFile =  "$PROJ_ARCHIVE/noa/${DBB1}/ship_noa/${shipTag}/ship/log/${DBB1}.ship.log"
set reviewCloseFile =   "$PROJ_ARCHIVE/noa/${DBB1}/iphandoff_review_noa/${shipTag}/review/${DBB1}.close. gz"
set accept10SumFile =    "$PROJ_ARCHIVE/noa/${DBB1}/ipqa_noa/${shipTag}/pds/logs/${DBB1}.ccdo_accept10.is s.log.sum.gz"
set shipDate = `zgrep "Current Date:"  $PROJ_ARCHIVE/noa/${DBB1}/ship_noa/${shipTag}/${DBB1}.ship_noa.manifest.gz | sed 's/.*\. //g'`

 endif






 ### create /tmp/transpose_$$.pl script

 touch /tmp/transpose_$$.pl; rm /tmp/transpose_$$.pl

 echo '#\!/usr/intel/pkgs/perl/5.8.5/bin/perl -w' >> /tmp/transpose_$$.pl
 echo 'use strict;' >> /tmp/transpose_$$.pl
 echo 'use English;' >> /tmp/transpose_$$.pl
 echo '(our $PROG_NAME = $0) =~ s#^.*/##;' >> /tmp/transpose_$$.pl
 echo 'my $file = shift;' >> /tmp/transpose_$$.pl
 echo 'open (FILE, $file) or die "***E: Error opening $file for reading: $!\n";' >> /tmp/transpose_$$.pl
 echo 'my @lines;' >> /tmp/transpose_$$.pl
 echo 'while (<FILE>){' >> /tmp/transpose_$$.pl
 echo '    chomp $_;' >> /tmp/transpose_$$.pl
 echo '    push (@lines, $_);' >> /tmp/transpose_$$.pl
 echo '}' >> /tmp/transpose_$$.pl
 echo 'print "@lines";' >> /tmp/transpose_$$.pl
 echo 'print "\n";' >> /tmp/transpose_$$.pl
 echo '1;' >> /tmp/transpose_$$.pl
 chmod 740 /tmp/transpose_$$.pl

This is the Perl code:

#!/usr/bin/perl

 use strict;
 use warnings;

 use Data::Dumper; ##print Dumper()
 use feature qw(switch);

  my $machine = c16991;
  my $pgMachine =lc0140;


  if ( ! -e /abc/site/home/$USER/.userauthentication) 
  system (echo "-F- .userauthentication file must be created in  /abc/site/home/$USER" )
  system (echo "-I- .userauthentication file format: <emailaddress> <unix pwd>.")
  system (echo "-I- Please make sure /abc/site/home/$USER/.userauthentication permission is set to 000")
  exit
  endif

  my $permissionCheck = `ls -ltra /nfs/site/home/$USER/.userauthentication | awk '{print $1}' 
    if ($permissionCheck != 'DASHrwDASHDASHDASHDASHDASHDASHDASH')
    system(echo "-F- /abc/site/home/$USER/.userauthentication permission is         set to $permission1")
    exit
    endif

  @ i = 1

 given ($i <= $#argv) 
 switch ($argv[$i])
  when(block):
  return $argv[$i]

 when(tag):
  return $argv[$i]

 when (local):

  return $argv[$i]

 when (ar):
  return $argv[$i]

 default:
  system(echo "-E- Invalid switch -> {$argv[$i]} found!")
  goto usage
  exit
  endsw
 end

Answer 1

Your given-when seems to be trying to process command line arguments. It'll work, but it's probably better to use one of the various GetOpt modules depending on your need.

GetOpt::Long is core, and will do what you want:

#/usr/bin/env perl
use strict;
use warnings;

use Getopt::Long;

my %opt; 

my $DBB1; 
my $tag;
my $local; 

GetOptions ( "block=s" => \$DBB1,
             "tag=s" => \$tag,
             "local=s" => \$local ) or die "Invalid option specified";

print $tag,"\n";

This allows you to:

myscript.pl --tag=fish
myscript.pl --tag fish
myscript.pl -tag fish

And sets it into $tag. It'll tell you off if you use an invalid opt.

I would also suggest that you're overusing system and backticks. You don't need to system ( "echo ..." ); but can instead print "Something\n";. (or use say which inserts a linefeed automatically).

Likewise ls - it's bad for a couple of reasons. Parsing ls is inherently difficult, and has a bunch of edge cases that'll trip you up. You shouldn't do that anyway.

But especially not when you're spawning an ls then an awk to - as far I can tell - just to get the permissions on a single file. If you need to expand a path, you can use glob (but you don't). And to get what you want, you can use stat.

my $perms = ( stat "/nfs/site/home/$ENV{'USER'}/.userauthentication" )[2] & 07777;
if ( $perms == 0600 ) { 
    print "Is user-rw, no access to anyone else\n";
}

Answer 2

I translated your script for what your script does. I do not recommend feeding fields to be chomp-ed in another perl script. There is probably a better way to do what you want.

The script below doesn't try to find out what you wished $logFile was set to. Or try to correct bad processing. It simply shows you a better transformation (not including my style quirks) of what you tried to do with so many system calls, and un-transformed csh.

• -e—with a quoted path—can check existence.
• die is how you exit with an error.
• File::stat::stat will get you the permissions
• Getopt::Long will do all your option parsing for you.
• You don't need to shell out for awk, or grep or sed. It's all just the way Perl works:

And here's the code:

#!/usr/bin/perl

use strict;
use warnings;

use File::stat;
use Getopt::Long;

my $user      = $ENV{USER} // 'USER NOT SET';
my $home_path = "/abc/site/home/$user";
my $auth_path = "$home_path/.userauthentication";
my $machine   = 'c16991';
my $pgMachine = 'lc0140';

# How you error-out in Perl: just die
die ( "-F- .userauthentication file must be created in $home_path\n"
    . "-I- .userauthentication file format: <emailaddress> <unix pwd>.\n"
    . "-I- Please make sure $auth_path permission is set to 000\n  "
    )
    unless -e $auth_path
    ;

# stat does permissions for Perl. 
my $perms = stat( $auth_path )->mode & 0777;

if ( $perms ) { # non zero
    my $permstr = sprintf "%3.3o", $perms;
    die "-F- $auth_path permission is set to: $permstr";
}

# switch processing already baked-in.
GetOptions ( 'block=s' => \$DBB1
           , 'tag=s'   => \$tag
           , 'local=s' => \$local 
           ) 
    or die "Invalid option specified"
    ;

die '-F- Please enter tag value to proceed!'
    if ( $local = 'y' and not $tag )
    ;
# $logFile is undefined in your script.
open ( my $lh, '<', $logFile ) 
    or die "Could not open $logFile!"
    ;
open ( my $out, '>', "/tmp/transpose_$$.pl" ) 
    or die "Could not open transpose_$$ file!"
    ;

# No need for grep or sed.
while ( <$lh> ) { 
    #next unless s/.*Username: //; # grep + sed
    #s/;.*//; # sed 

    # better yet, this does it all:
    next unless my ( $cap ) = m/\bUsername:\s([^;]+)/;

    # Don't do this. 
    # There should be a better way than outputing another perl script.
    say {$out} "chomp $cap;"; 
    # Do you need to quote what you captured?
    # say {$out} "chomp '$cap';";

}
close $lh;