#!/usr/bin/env perl

# unz v1.09	Public Domain.	NIDE lab @ Nara-WU.

# ϲ:
#   ܸΥե̾ФѤʡѴ򤷤ʤunzip
#   (âե̾ФʸѴϥǥեȤǤϹԤ
#    եƤФƤϲѴ⤷ʤ)
#   ߤΤȤΤŸ뵡ǽΤ
#   (եΤꤷΤФ褦ʵǽѰդƤʤ)
#   Ź沽ZIPŸˤPerlΥ⥸塼Archive::ZIPŹ沽бǤ뤳Ȥɬ

# ˡ:
#   unz [-lvqrJw] [-d ǥ쥯ȥ] ZIPե̾
#	-l: list only
#	-v: verbose list only
#	-q: quiet
#	-r: ե̾ФʸѴޤѴԤʤ
#	-J: MacOSX/WindowsǺ줿֤˴ޤޤ줬ʥ(.DS_Store
#	    Ȥ__MACOSXʤ)Ÿ(ǥեȤǤϤŸʤ)
#	-d: Ÿǥ쥯ȥλ
#	-w: Ÿ줿ե˥ʤɤ߽񤭸¤ղ

# 󥹥ȡˡ:
#   ưɬפʤΡפ򥤥󥹥ȡ
#   ʤPATH̤äǥ쥯ȥ֤

# ưɬפʤ:
#   Perl, Perl饤֥Archive::Zip(Linuxǥȥӥ塼Ǥ
#   Фlibarchive-zip-perlΤ褦ʥѥå̾)

# ȯηа:
#   UNIXOSunzip7zjar xfϤ⡢ܸΥե̾
#   եޤ֤Ÿݤˡե̾ФѤѴ
#   Ԥ(ʤ虜虜;פʤȤ򤹤Τ!)ΤǡȤʪˤʤʤ
#   ǡunzipʤȤơŸ˥ե̾ФƥѴ
#   ʳ;פʤȤ򤷤ʤ褦˺äΤ
#
#   Ź沽ZIPˤv1.01б
#   âArchive::ZipŹ沽ZIP̤бСξ硢Ź沽ZIPϰʤ
#
#   ĿŪˤϡ(jarΤ褦˥֤Τޤ޸ġΥե˥
#   ӤƤ)ZIPtar+gzipΤ褦ʤΤȤ٤Ȼפ(Nide)

# :
#   Perlɸ饤֥ZIPŸԤˡȤƤ
#	use Archive::Extract;
#	Archive::Extract -> new(archive=>$ARGV[0]) -> extract;
#   ȤΤ⤢
#   âѥˡ..פäƤꥷܥå󥯤äƤꤹ
#   ˡǤϴ Ƥδ򤱤뤦ޤˡʤ

# :
# v1.00 
# v1.01 Ź沽ZIPб
# v1.02 rxw°ȤʤΥǥ쥯ȥ꤬֤˴ޤޤƤн
#	-wץɲ
# v1.03 utf8ޤPerlArchive::ZipλͤѤäƤ褦ǡե̾
#	ʸѴޤʤʤäƤΤн
# v1.04 ˡ.localizedǥեȤŸ褦ˤ
# v1.05 zipΥեΥ󥳡ǥ󥰤եJISξˡArchive::Zip
#	ѥ̾Ρ\פ2ХʸΤΤޤơ/פѴƤ
#	($LANGեJISξ)ᡢunzguessؿե̾Υ
#	ǥ󥰤Ƚ˼Ԥ礬äΤн
# v1.06 $LC_ALL$LANG˸褦ˤ
# v1.07 Archive::ZipextractMember()Ź沽ZIPξ˥ХäƤƤĤޤ
#	äƤľʤȤн
# v1.08 Archive::Zip->new()ΰ'0'ΤȤΥХб
# v1.09 guess()ؿɽ٤äΤȡĹХϤԶ
#	ؤн

my @moddirs;	# ENDǻȤ

$arczip_buggy = 1; # Archive::ZipextractMember()Ź沽ZIPФƥХ

sub usage{
	my $msg = <<'EOF';
Usage: %s [-lvqrJw] [-d dir] zipfile
	-l: list only
	-v: verbose list only
	-q: quiet
	-r: raw (i.e. no filename conversion)
	-J: extract also MacOSX/Windows junks
	-d: dir to extract into
	-w: force extracrted files/directories rw(x)-able to owner
EOF
	my($cmd) = $0; $cmd =~ s/^.*\///;
	die sprintf($msg, $cmd);
}

sub failed{
	die "Failed extracting $_[0]\n";
}

use Archive::Zip (':ERROR_CODES');
use Getopt::Long;
use Encode;
use Fcntl ':mode';

Getopt::Long::Configure('bundling');
GetOptions('l', 'v', 'q', 'r', 'd=s', 'J', 'w') || usage;

usage if @ARGV != 1;
$ARGV[0] .= '.zip' if ! -e $ARGV[0] && -e "$ARGV[0].zip";
$opt_d .= '/' if $opt_d =~ /[^\/]$/; # $opt_d줫ġ/װʳǽü

BEGIN{
# ʸutf8ե饰򳰤asbytes()ǶArchive::Zip֤ե̾
# utf8ե饰ĤƤꡢХȤưΤʤᡣArchive::Zip֤
# ե̾¤EUC-JPǤͤȡencodeФ˥ե饰
# ɬפ롣ˡȤ (1) use bytes; ȤƶʸϢ (2) thread
# Ѥöѥפ˽񤤤ɤ Ȥ2ʤ⡢(1)Ȥ(1)Ǥʤ
# (2)Ȥ(2)϶use bytes;ʤʤѰդƤ

	eval 'sub asbytes($){use bytes; $_[0] . "";}';
	# Ȥʤ餳Ȥ
	$@ eq '' && return;	

	use threads; use threads::shared;
	my $wr1, $rd2;
	my $flg = 0;
	my $s :shared;

	sub asbytes($){
		if(!$flg){ # ¹
			$flg = 1;

			local *subr = sub{
				my($rd, $wr) = @_;
				open my $err, '>&', STDERR;
				open my $nul, '>', '/dev/null';
				while(1){
					read $rd, my $dummy, 1;
					# Wide character in print Ĥ
					# åФʤ
					open STDERR, '>&', $nul;
					print $wr $s;
					open STDERR, '>&', $err;
					print $wr "\0";
				}
			};

			my $rd1, $wr2;
			pipe $rd1, $wr1;
			pipe $rd2, $wr2; binmode $rd2; binmode $wr2;
			$wr1->autoflush(1);
			$wr2->autoflush(1);
			my $thr = threads->create(\&subr, $rd1, $wr2);
			$thr->detach();
			close $rd1; close $wr2;
		}

		($s = $_[0]) =~ s/[\0\01]/$& eq "\0" ? "\01\01" : "\01\02"/eg;
		print $wr1 "\0";
		local($/) = "\0";
		chomp(my $ret = <$rd2>);
		$ret =~ s/\01./$& eq "\01\01" ? "\0" : "\01"/eg;
		$ret;
	}
}

sub cmdwhich($){ # File::WhichȤ鷺ꤷޥɤμºߤå
	for my $p (split(/:/, $ENV{'PATH'})){
		return "$p/$_[0]" if -x "$p/$_[0]";
	}
	undef;
}

sub readterm($){
# ü1ɤ֤IO:TtyIO:Ptyˤ餺sttyޥɤȤ
	my($tty, $tmode, $ret) = '/dev/tty';
	open(my $TTY, "+<$tty") || return undef;
	print $TTY $_[0];
	chomp($tmode = `exec <$tty; stty -g; exec stty -isig -echo`);
	chomp($ret = <$TTY>);
	close($TTY);
	system("stty $tmode <$tty; echo >$tty");
	$ret;
}

sub rmsymln_mkpdir($){
# Ϳ줿ѥ뤤ϤޤǤˤĤơܥå󥯤
# Υǥ쥯ȥ꤬ʤкԻϵ֤($!ꤵϤ)
# Τϥǥ쥯ȥ(ΤƤ¦umask0300򳰤Ƥ)
	my($path, @part);
	@part = split(/(?<=.)\/+/s, $_[0]);
	while(@part){
		$path .= ($path eq '' ? '' : '/') . shift(@part);
		if(-l $path){
			warn "removing symbolic link: $path\n"; # λݷٹ
			return undef if !unlink $path;
		} else { # $pathƤʤ˸¤ -d _ Ȥ
			next if -d _;
		}
		# Ǹʳǥ쥯ȥ
		return undef if @part && !mkdir $path;
	}
	1;
}

sub guess($){
# Encode::GuessȤ鷺EUC-JPSJISUTF-8ߴ֤Ǥο
	(local $_ = asbytes($_[0])) =~ s/^[\x00-\x7f]+//; # Ƭ7bitʸ
	(my $s = $_) =~ s/[\x00-\x7f]//g;	# 7bitʸ
	return '' if $s eq '';
	return 'euc-jp' if $s =~ /^(\x8f?[\xa1-\xfe]{2}|\x8e[\xa0-\xdf])*$/;
	return 'shiftjis' if
		/^([\x00-\x7f]|[\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])*$/;
	return 'utf8' if $s =~ /^([\xc2-\xdf][\x80-\xbf]|(?#
		)[\xe0-\xef][\x80-\xbf]{2}|[\xf0-\xf7][\x80-\xbf]{3}|(?#
		)[\xf8-\xfb][\x80-\xbf]{4}|[\xfc-\xfd][\x80-\xbf]{5})*$/;
	return 'shiftjis' if /^([\x00-\x7f\xa0-\xdf]|(?#
		)[\x81-\x9f\xe0-\xfc][\x40-\x7e\x80-\xfc])*$/;
	# Archive::ZipfileName()ShiftJISǤäƤ\פ/פ
	# Ѵ֤(LANGja_JP.sjisξ)ΤǡΤ
	# ֤äƤSJISȽꡣ˥ե̾Ѵ̰򤵤
	return 'alt_sjis' if /^([\x00-\x7f\xa0-\xdf]|(?#
		)[\x81-\x9f\xe0-\xfc][\/\x40-\x7e\x80-\xfc])*$/;
	'';
}

sub langguess(){
	my $lang = $ENV{'LC_ALL'} || $ENV{'LANG'};
	return 'shiftjis' if $lang =~ /^ja.*(mscode|sjis|pck)($|\@)/i;
	return 'utf8'	  if $lang =~ /^ja.*utf-?8($|\@)/i;
	return 'euc-jp'	  if $lang =~ /^ja/i;
	'';
}

# ʬŪEncodeȰ㤦Ѵ򤹤ʬ UTF8UTF8
my(%localcnv) = (
	"\xef\xbd\x9e" => "\xe3\x80\x9c",	# 
	"\xe2\x88\xa5" => "\xe2\x80\x96",	# ʿԵ
	"\xe3\x82\x99" => "\xe3\x82\x9b",	# 
	"\xe3\x82\x9a" => "\xe3\x82\x9c",	# Ⱦ
	"\xef\xbc\x82" => "\xe2\x80\x9d",	# ֥륯
	"\xef\xbc\x87" => "\xe2\x80\x99",	# 󥰥륯
	"\xef\xbc\x8d" => "\xe2\x88\x92",	# ޥʥ
	"\xef\xbf\xa0" => "\xc2\xa2",		# 
	"\xef\xbf\xa1" => "\xc2\xa3",		# ݥ
	"\xef\xbf\xa2" => "\xc2\xac",		# 국
	"\xef\xbf\xa4" => "\xc2\xa6",		# 
);
my($localcnv) = join('|', keys %localcnv);

sub anymemEncrypted(@){
	$_ -> isEncrypted() && return 1 for (@_);
	return 0;
}
sub anymemSymln(@){
	S_ISLNK($_ -> unixFileAttributes()) && return 1 for (@_);
	return 0;
}

# ֤Υץ
-r $ARGV[0] || die "Cannot read $ARGV[0]\n";
$ARGV[0] = "./$ARGV[0]" if $ARGV[0] !~ /^\//;
# Archive::Zip->newˤϡְĥҤʤ'0'ץǤʤ
# ȤХ(1.68)ΤǡƬ'./'Ϣܤ뤳ȤǤ
# ѤȤơ$ARGV[0]'-'ǻϤޤʤʤΤǡޥ
# zipcloak˥ץȤκƱʤ˰ȤϤ
my $zip = Archive::Zip -> new($ARGV[0]);
my @mems = $zip -> members();
	
# Ź沽ZIPξ硢Archive::ZipΥС1.68λǤʤextractMember()
# ХäƤ ٰʾ礭եޤǤŸǤʤ礬
#  zipcloakϤ餫᤽ǰŹ沽ZIPե
#  ФƽԤ zipcloakϥե̾˲ѹäʤ
if(!$opt_v && !$opt_l && $arczip_buggy && anymemEncrypted(@mems)){{
	last unless my $zipcloak = cmdwhich('zipcloak');
	my($dummy, $tmpzip) = Archive::Zip::tempFile();
	open(my $TMPO, '>&STDOUT') && open STDOUT, '>', '/dev/null';
	die "Decryption failed.\n" if
		system($zipcloak, '-d', '-O', $tmpzip, $ARGV[0]) != 0;
	open STDOUT, '>&', $TMPO;
	close $TMPO;
	$zip = Archive::Zip -> new($tmpzip);
	@mems = $zip -> members();
	die "Decryption failed.\n" if anymemEncrypted(@mems);
}}

# ե̾ʸɤ˴ؤ
my $tcode = $opt_r ? '' : langguess();
my $fcode = $tcode eq '' ? '' : guess(join("\n", $zip -> memberNames()));
my $alt_sjis = 0; 
$fcode = 'shiftjis', $alt_sjis = 1 if $fcode eq 'alt_sjis';
$fcode = $tcode = '' if $fcode eq $tcode || !$fcode || !$tcode;
print STDERR "filename conversion: $fcode -> $tcode\n" if $fcode;

sub fnmconv($){ # $fcode, $tcode, $alt_sjis: global
	my $f = $_[0];
	return asbytes($f) if !$fcode;

	$f =~ s/$localcnv/$localcnv{$&}/oeg if $fcode eq 'utf8';
	$f = asbytes($f); # utf8ե饰
	$f =~ s!([\x81-\x9f\xe0-\xfc])(.)|.!
		$2 eq '/' ? $1 . '\\' : $&!eg if $alt_sjis;
	# $futf8ե饰ƤʤWide character at /Encode.pm 
	# 顼
	Encode::from_to($f, $fcode, $tcode);

	$f; # $fcodeǤ⵶Ǥutf8ե饰ϳ֤
}

# Ÿ
my $pass;
if(anymemEncrypted(@mems)){{
	last if $opt_l || $opt_v && !anymemSymln(@mems);
	#  Ź沽ZIPݡȤƤʤФǽλ
	die "Encrypted zip is not supported.\n"
		if !defined(eval{$mems[0] -> password('')});
	$pass = readterm('Enter password: '); # 1
}}
for my $m (@mems){
	$m -> password($pass) if $m -> isEncrypted();
	# ѥɤϤƤȤϸ¤ʤ

	my $f = $m -> fileName();
	next if !$opt_J &&
		$f =~ /^__MACOSX($|\/)|(?#
			)(^|\/)(\.(DS_Store|localized)|(\._)?Thumbs\.db)$/;
	if($opt_v){
		my @t = localtime($m -> lastModTime());
		my $l;
		if(S_ISLNK($m -> unixFileAttributes())){
			$l = $zip -> contents($m);
			$l = ' -> ' . ($l ne '' ? fnmconv($l) : '?');
			# ܥå󥯤Ǥ˸¤ɽ 
			# Ź沽ZIPѥɤϤƤʤ
			# ɤ᤺ˤʤäƤΤǡ?פɽ
		}
		printf "%06o %10d %02d-%02d-%02d %02d:%02d:%02d %s%s\n",
			$m -> unixFileAttributes(), $m -> uncompressedSize(),
			$t[5]%100, $t[4]+1, @t[3,2,1,0], fnmconv($f), $l;
	}
	elsif($opt_l){
		print fnmconv($f), "\n";
	} else {
		my($ff) = $fcode ? fnmconv($f) : $f;
		# $fcodeξ$ffutf8ե饰ϳ Ǥʤϲ
		# ưƤǤȺƱˤ뤿ᤳǤutf8ե饰
		# Ƥʤ Ƥʤǽ⤢

		# Хѥ..פ̵ˤ
		$ff =~ s!^((\.\.)?/)+|(^|(?<=/))\.\.($|(?=/))!!g;
		# Τ$opt_d
		$ff = "$opt_d$ff";
		if(!$opt_q){
			my $fb = asbytes($f);
			# !$fcodeʤ$ffutf8ե饰ϳƤʤ $ffb
			my $ffb = $fcode ? $ff : asbytes($ff);
			print STDERR "x $fb", $fb eq $ffb ? "\n" : " -> $ffb\n";
		}

		# ܥå󥯤ˤ񤭤ɤΤ˲äޤǤ
		# ǥ쥯ȥ˺äƤ(umask 0777ǥǥ쥯ȥ꤬
		# Ȥ˥եʤʤ뤿)
		my($oumask) = umask(~0300 & umask);
		rmsymln_mkpdir $ff || die "$ff: $!\n";
		umask($oumask);

		if(S_ISLNK($m -> unixFileAttributes())){
			# ܥå ñextractMember()Ǥ̤
			# եȤŸƤޤ
			my $l = $zip -> contents($m);
			# $lundefǤ˲äǤ(Ź沽ZIP
			# ĥѥɤ㤦絯)ˤ⤳ǥ顼λ
			failed($ff) if $l eq '';
			eval {symlink(fnmconv($l), $ff)} || die "$ff: $!\n";
		} else { # 嵭ʳ
			# ʪunzipArchive::ZipumaskθƤʤ
			my($oumask) = umask(0777);
			if($arczip_buggy && $m -> isEncrypted()){
				# ҤΤ褦 Ź沽ZIPξextractMember()
				# ХäƤ뤿 zipcloakʤä
				# ˤcontents()ȤȤн
				# ȤưŹ沽ZIPŸ϶ü٤ʤ
				open(my $OUT, '>', $ff) || failed($ff);
				my($ct, $st) = $m -> contents();
				failed($ff) if $st != AZ_OK;
				print $OUT $ct;
				close $OUT || failed($ff);
			} else {
				$zip -> extractMember($m, $ff) == AZ_OK || 
					failed($ff);
			}
			umask($oumask);

			my($mode) = $m -> unixFileAttributes();
			# ǥ쥯ȥǤpermissionS_IFMTʤ0666ξ
			# 0777 jar륢֤ʤ뤿
			$mode = 0777 if $mode == 0666 && -d $ff;

			# ºݤ˥åȤ⡼ɤ
			$mode |= (-d $ff ? 0700 : 0600) if $opt_w;
			$mode &= ($> ? (0777 & ~umask) : 07777);
			# ǥ쥯ȥξ硢Ū˼ʬrwxĤ
			# (˥եŸݤλپɤ)
			push(@moddirs, [$ff, $mode]), $mode |= 0700
				if -d $ff && ($mode & 0700) != 0700;
			chmod($mode, $ff);

			# Ź沽ZIPǥѥɤְäƤ硢ե뤬
			# ФΤǡΥȰäƤ齪λ
			# ѥɴְ㤤ͭʸˡޤʤ
			# ѥɤְäƤե뤬Ĥꡢ
			# ӸΥե뤬ȥѥɤְäƤƤ
			# ǽλʤ꤬
			failed($ff) if -f $ff &&
				$m -> uncompressedSize() != (stat($ff))[7];
		} # üեϸθ
	}
}

END{ # Ū˸¤ѹƤǥ쥯ȥθ¤
	chmod($_->[1], $_->[0])
		for(sort {length($b->[0]) <=> length($a->[0])} @moddirs);
}

# ʬѥ:
#   ѡ桼¤Τʤ(i.e. Archive::Zipsystem-wide˥󥹥ȡ
#   Ǥʤ)ĶξArchive::ZipĿѤ˥󥹥ȡ뤹ˤ
#   perl -MCPAN -e shell Ȥ
#     o conf makepl_arg "LIB=~/lib/perl/lib PREFIX=~/lib/perl/lib (³)
#	INSTALLMAN1DIR=~/lib/perl/man/man1 INSTALLMAN3DIR=~/lib/perl/man/man3"
#     o conf commit
#     install Archive::Zip
#   ȤȼʬΥǥ쥯ȥ˥󥹥ȡǤ
#   ȤϴĶѿPERL5LIB~/lib/perl/libˤOK
#
#   utf8ե饰̵ͭ¾use Devel::Peek;Devel::Peek::Dump($s)Ǥ狼
