にっきダイアリー

はてなダイアリーからはてなblogに移動してみました。

Archive::Zip を使ってサーバーにアップロードしたzipファイルを解凍するCGI

Perl 俺メモ

サーバーインストール型のCMSとかblogとかってファイル数多すぎて、ちょっとテストしたいってだけでもアップロードが面倒なので作成。

  • zipファイルはcgiと同じディレクトリにアップロード済みであることが必要
  • ファイル名の入力は拡張子なしで
  • 当然ですが、使った後はcgiとzipファイルをサーバーから削除しておくこと。
#!/usr/local/bin/perl
use Archive::Zip;
use CGI;
#------------------------------------------------------------------
BEGIN{
  $| = 1;
  print "Content-type: text/html; charset=Shift_JIS\n\n";
print <<__EOM__;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="ja">
<head>
 <meta http-equiv="Content-Type" content="text/html; charset=Shift_JIS">
 <meta name="ROBOTS" content="NOINDEX,NOFOLLOW,NOARCHIVE">
 <title>unzip</title></head><body>
__EOM__
  open(STDERR, ">&STDOUT");
}
$cgi=substr($0,rindex($0,'/')+1);
$p = new CGI;
$name  = $p->param('name');
if($name and -f $name.'.zip'){
  &unzip($name);
}
else{
  &form;
}
print "</body></html>";

#------------------------------------
sub form {
  print qq(<form action="$cgi" method='get'><input type='submit' value='unzip'>\n);
  print qq(<input type='text' name='name' size='30' value=''></form>\n);
}
#------------------------------------
sub unzip {
  my $zipname = shift || '';
  my $filename = $zipname.'.zip';
  my $zip = Archive::Zip->new();
  if($zip->read($filename) == AZ_OK){
    print "Extracting " . $zip->numberOfMembers($filename) . " files from $fileName<br><br>\n";
    @members = $zip->members();
    foreach (@members) {
      my $fname = $_->fileName;
      print $fname . "<br>\n";
      $zip->extractMember($fname);
    }
  }
}