TCLコードをPerlに変換する

Question

私はPerl "Sub"に変換したい1つの "proc"というTCLスクリプトを持っていますが、私はtcl expertではありません。私はPerlを知っていますが、in 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 {} 
} 

このprocが他のファイルがあります（例：.TXT）のzip内のファイルのzipファイルの名前と内線を取るジップ（元の.DOC）にもありますが、それらのファイルを無視し、唯一の.txtとどこかに一時ファイルを取得します元のファイル名で作成すべてのzipファイルの.txtファイルからすべての内容を書き出して一時ファイルを返すので、すべての.txtのデータと同様にすべての.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

これは、より直接的な翻訳ことがありますテストされていない：あなたはUNLINK => 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; 
     } 
    } 
} 

あなたがサブから戻ったときに、あなたのファイルは、おそらく削除されます。

useコマンドは、サブルーチンに入れてもコンパイル時に実行されるため、コードの先頭にもそれらを収集する可能性があります。