Как перевести оператор switch в Perl

Я портирую csh-скрипт на Perl. Я делаю заявление о переключении в Perl. Я не уверен, правильно ли это, основываясь на различных комментариях, которые указывают, что операторы switch больше не используются в Perl. Можете ли вы дать мне идею, если это правильно? Также в операторе switch мы используем "когда" или "случай"?

Это код csh:

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

Это код Perl:

#!/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
Источник

2 ответа

Ваш given-when похоже пытается обработать аргументы командной строки. Это будет работать, но, вероятно, лучше использовать один из GetOpt модули в зависимости от ваших потребностей.

GetOpt::Long это ядро, и будет делать то, что вы хотите:

#/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";

Это позволяет вам:

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

И устанавливает его в $tag, Он сообщит вам, если вы используете неверный выбор.

Я бы также предположил, что вы злоупотребляете system и клюшки. Вам не нужно system ( "echo ..." ); но может вместо print "Something\n";, (или использовать say который вставляет перевод строки автоматически).

также ls - это плохо по нескольким причинам. анализ ls это по своей сути сложно, и имеет множество крайних случаев, которые вас сбивают с толку. Вы не должны делать это в любом случае.

Но особенно не когда ты порождаешь ls тогда awk чтобы - насколько я могу судить - просто чтобы получить разрешения для одного файла. Если вам нужно расширить путь, вы можете использовать glob (но вы не) И чтобы получить то, что вы хотите, вы можете использовать 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";
}
Источник

Я перевел ваш сценарий для того, что делает ваш сценарий. Я не рекомендую кормить поля, чтобы быть chomp в другом Perl-скрипте. Вероятно, есть лучший способ сделать то, что вы хотите.

Сценарий ниже не пытается выяснить, что вы хотели $logFile был установлен в. Или попробуйте исправить плохую обработку. Он просто показывает вам лучшее преобразование (не считая моих причуд в стиле) того, что вы пытались сделать с таким количеством системных вызовов, и нетрансформированный csh.

  • -e - с указанным путем - может проверить существование.
  • die как вы выходите с ошибкой.
  • File::stat::stat получит вам разрешения
  • Getopt::Long сделает все ваши варианты разбора за вас.
  • Вам не нужно выкладывать на awk, или grep или sed. Все это так, как работает Perl:

И вот код:

#!/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;
Источник
Другие вопросы по тегам