Преобразование кода TCL в Perl

Question

У меня есть сценарий TCL, в котором один «proc» я хочу преобразовать в Perl «Sub», я не эксперт tcl. Я знаю Perl, но в proc некоторые команды используются, которые я не могу преобразовать в Perl.

proc extract_from_zip_by_ext {zip ext} { 
    set low_ext [string tolower $ext] 

    foreach f [zipread_list $zip] { 
     set filename [lindex $f 0] 

     if {[string match -nocase "*.${ext}" $filename]} { 

      # 
      # We leave base alone rather than renaming it to 
      # base.low_ext to make sure no other process uses 
      # the same name. 
      # 
      set tmpname_base [::fileutil::tempfile] 
      set tmpname "${tmpname_base}.${low_ext}" 

      set filebytes [zipread_extract $zip $filename] 

      set fp [open $tmpname w] 
      fconfigure $fp -translation binary 
      puts -nonewline $fp $filebytes 
      close $fp 

      file delete -force $tmpname_base 
      return $tmpname 
     } 
    } 

    return {} 
} 

Эта процедура занимает имя архива и внеш файла внутри ZIP (бывший .txt) есть и другие файлы также в ZIP (бывший .doc), но игнорировать эти файлы и получить только .txt и где-то временный файл созданный с оригинальным именем файла, записывает весь контент из .txt-файлов всех zip-файлов и возвращаемого временного файла, чтобы мы могли получить доступ к его имени, а также данные из всего .txt из всех zip

выше логика, что я понимаю из tcl, но некоторые, как я не мог истолковать в Perl

Мои пытаются до сих пор:

sub extract_from_zip_by_ext ($$){ 
    my($fileName, $ext) = @_; 
    # say "$fileName $ext\n"; 
    use Archive::Zip qw(:ERROR_CODES) ; 
    use File::Temp qw/ tempfile tempdir /; 
    use Archive::Zip::MemberRead; 
    use File::Basename; 

    my @suffixlist = qw(HDR hdr zip ZIP) ; 
    my $zip = Archive::Zip->new($fileName); 
    my $unzipOutput; 
    my ($dtgFname,$dtgFpath,$dtgFsuffix) = fileparse($fileName, @suffixlist); 
    # say "$dtgFname\n"; 
    my $tmpname_base = new File::Temp(UNLINK => 1); 
    my $tmpname = ${dtgFname}.${ext}; 

    open FH, ">>", $tmpname or die "cant write $tmpname: $!\n"; 
    for my $member($zip->members){ 
     $unzipOutput = $member->fileName;  
     if($unzipOutput =~ /\.$ext$/i){ 
      my $fh = Archive::Zip::MemberRead->new($zip, $unzipOutput);   
      while (defined(my $line = $fh->getline())){ 
       say FH $line; 
       # say "$tmpname\n"; 
       return ($tmpname, $line); 
      } 
     } 
    } 
    close FH; 
} 

Answer 1

Это может быть более прямой перевод: непроверенную:

use File::Temp   qw/ tempfile /; 
use Archive::Zip  qw/ :ERROR_CODES /; 
use Archive::Zip::MemberRead; 
use autodie; 

sub extract_from_zip_by_ext { 
    my ($fileName, $ext) = @_; 
    my @suffixlist = qw(HDR hdr zip ZIP) ; 
    my $zip = Archive::Zip->new($fileName); 
    my $tmpname_base = new File::Temp(UNLINK => 1); 
    my $tmpname = "$tmpname_base.$ext"; 

    for my $member($zip->members) { 
     my $memberFilename = $member->fileName; 
     if ($memberFilename =~ /\.$ext$/i) { 
      my $contents; 
      my $fh = Archive::Zip::MemberRead->new($zip, $memberFilename); 
      $fh->read($contents, $member->uncompressedSize); 
      $fh->close(); 

      open my $ftmp, ">", $tmpname; 
      print $ftmp $contents; 
      close $ftmp 

      return $tmpname; 
     } 
    } 
} 

Поскольку вы используете UNLINK => 1, файл, вероятно, удаляется при возврате из суб.

Замечание: команды use выполняются во время компиляции, даже если вы поместили их в подпрограмму, чтобы вы могли собрать их в верхней части кода.