PyukiWiki CVS Commit
pyuki****@lists*****
2012年 8月 16日 (木) 10:24:28 JST
Index: PyukiWiki-Devel/lib/Nana/Cache.pm diff -u PyukiWiki-Devel/lib/Nana/Cache.pm:1.549 PyukiWiki-Devel/lib/Nana/Cache.pm:1.550 --- PyukiWiki-Devel/lib/Nana/Cache.pm:1.549 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Cache.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Cache.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Cache.pm,v 1.549 2012/08/09 08:42:09 papu Exp $ +# $Id: Cache.pm,v 1.550 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "Nana::Cache" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::Cache; Index: PyukiWiki-Devel/lib/Nana/Cookie.pm diff -u PyukiWiki-Devel/lib/Nana/Cookie.pm:1.43 PyukiWiki-Devel/lib/Nana/Cookie.pm:1.44 --- PyukiWiki-Devel/lib/Nana/Cookie.pm:1.43 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Cookie.pm Thu Aug 16 10:24:28 2012 @@ -1,8 +1,9 @@ ###################################################################### # Cookie.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Cookie.pm,v 1.43 2012/08/09 08:42:09 papu Exp $ +# $Id: Cookie.pm,v 1.44 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 03:05:13 # -# "Nana::Cookie" ver 0.1 $$ +# "Nana::Cookie" ver 0.2 $$ # Author: Nanami # http://nanakochi.daiba.cx/ # Copyright (C) 2004-2007 Nekyo @@ -14,14 +15,14 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::Cookie; use 5.005; use strict; use vars qw($VERSION); -$VERSION = '0.1'; +$VERSION = '0.2'; ###################################################################### Index: PyukiWiki-Devel/lib/Nana/Enc.pm diff -u PyukiWiki-Devel/lib/Nana/Enc.pm:1.43 PyukiWiki-Devel/lib/Nana/Enc.pm:1.44 --- PyukiWiki-Devel/lib/Nana/Enc.pm:1.43 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Enc.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Enc.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Enc.pm,v 1.43 2012/08/09 08:42:09 papu Exp $ +# $Id: Enc.pm,v 1.44 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "Nana::Enc" ver 0.1 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::Enc; @@ -48,7 +49,7 @@ sub iscryptpass { if($::Use_CryptPass) { if($::Token eq '') { - $::IN_JSHEAD.=&maketoken; + $::IN_JSHEADVALUE.=&maketoken; my $funcp = $::functions{"jscss_include"}; $::IN_HEAD.=&$funcp("passwd"); } Index: PyukiWiki-Devel/lib/Nana/File.pm diff -u PyukiWiki-Devel/lib/Nana/File.pm:1.527 PyukiWiki-Devel/lib/Nana/File.pm:1.528 --- PyukiWiki-Devel/lib/Nana/File.pm:1.527 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/File.pm Thu Aug 16 10:24:28 2012 @@ -1,8 +1,9 @@ ###################################################################### # File.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: File.pm,v 1.527 2012/08/09 08:42:09 papu Exp $ +# $Id: File.pm,v 1.528 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # -# "Nana::File" ver 0.1 $$ +# "Nana::File" ver 0.2 $$ # Author: Nanami # http://nanakochi.daiba.cx/ # Copyright (C) 2004-2007 Nekyo @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=Shift-JIS 1TAB=4Spaces +# Return:CRLF Code=Shift-JIS 1TAB=4Spaces ###################################################################### # # ‘å莂Ìrenameƒtƒ@ƒCƒ‹ƒƒbƒN‚ɑ΂µ‚ÄAˆÈ‰º‚̉ü—Ç“_‚ª‚ ‚è‚Ü‚·B @@ -32,9 +33,9 @@ use 5.005; use strict; use vars qw($VERSION); -$VERSION = '0.1'; +$VERSION = '0.2'; -# ƒeƒXƒg‚·‚é‚Æ‚«‚ÍAƒRƒƒ“ƒgƒAƒEƒg‚µ‚ĉº‚³‚¢# debug +# ƒeƒXƒg‚·‚é‚Æ‚«‚ÍAƒRƒƒ“ƒgƒAƒEƒg‚µ‚ĉº‚³‚¢ use Fcntl ':flock'; $Nana::File::LOCK_SH=1; @@ -62,7 +63,7 @@ $lfh=&lock($filename,$Nana::File::LOCK_EX); if(!$lfh) { alarm(0); - return &die("lock_store: $filename locked"); # debug + return &die("lock_store: $filename locked"); return undef; } } @@ -79,13 +80,13 @@ close(FILE); } else { alarm(0); - return &die("lock_store: $filename can't created"); # debug + return &die("lock_store: $filename can't created"); return undef; } alarm(0); }; if ($@ =~ /time out/) { - return &die("lock_store: $filename timeout"); # debug + return &die("lock_store: $filename timeout"); return undef; } return $value; @@ -104,7 +105,10 @@ $lfh=&lock($filename,$Nana::File::LOCK_SH); } local $/; - my $value = <FILE>; + binmode(FILE); + my $value; + my $len=sysread(FILE, $value, -s $filename); +# my $value = <FILE>; eval("flock(FILE, LOCK_UN)"); if ($@) { &unlock($lfh); Index: PyukiWiki-Devel/lib/Nana/GZIP.pm diff -u PyukiWiki-Devel/lib/Nana/GZIP.pm:1.292 PyukiWiki-Devel/lib/Nana/GZIP.pm:1.293 --- PyukiWiki-Devel/lib/Nana/GZIP.pm:1.292 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/GZIP.pm Thu Aug 16 10:24:28 2012 @@ -1,8 +1,9 @@ ###################################################################### # GZIP.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: GZIP.pm,v 1.292 2012/08/09 08:42:09 papu Exp $ +# $Id: GZIP.pm,v 1.293 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:50 # -# "Nana::GZIP" ver 0.2 $$ +# "Nana::GZIP" ver 0.3 $$ # Author: Nanami # http://nanakochi.daiba.cx/ # Copyright (C) 2004-2007 Nekyo @@ -14,62 +15,281 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=Shift-JIS 1TAB=4Spaces ###################################################################### # # use Nana::GZIP; -# $compressdata=Nana::GZIP::compress($originaldata); -# $extractdata=Nana::GZIP::uncompress($originaldata); +# my $gz=new Nana::GZIP( +# prog=>"gzip or pigz or zlib or other", +# level=>"fast or best or other", +# path=>(gzip path optional) +# ); +# $compressdata=$gz->compress($data); +# $extractdata=$gz->uncompress($data); +# # see # http://suika.fam.cx/~wakaba/wiki/sw/n/Perl%E3%81%A7%E3%81%AEgzip%E3%81%AE%E5%9C%A7%E7%B8%AE%E3%83%BB%E5%B1%95%E9%96%8B # http://www.submit.ne.jp/1500 +# http://d.hatena.ne.jp/yukiex/20080227/ +###################################################################### +use Compress::Zlib; package Nana::GZIP; -$VERSION="0.2"; +$VERSION="0.3"; use strict; +use Nana::ServerInfo; $GZIP::INIT=0; +$GZIP::FORCEPIGZ=0; +$GZIP::FORCEGZIP=0; + +###################################################################### + +$GZIP::INITED=0; +$GZIP::PATH; +$GZIP::FORCE; +$GZIP::FAST; +$GZIP::BEST; + +$GZIP::BEFOREPROG="GZIP.pm test"; +$GZIP::BEFORELEVE; +$GZIP::BEFORCOMPRESSFLAG; +$GZIP::BEFOREUNCOMPRESSFLAG; +$GZIP::BEFOREPATH; + + +# multicore gzip tips: http://www.submit.ne.jp/1500 # comment + + +# init + +# $gz=new Nana::GZIP(prog=>"gzip or pigz", level="fast or best or default or 1..9"); + +sub new { + my($class,%hash)=@_; + my $ret; +$::debug.="GZIP.pm: init\n"; + if($hash{prog} ne $GZIP::BEFOREPROG || $hash{level} ne $GZIP::BEFORELEVEL) { my $pigz_command='pigz1'; + my $gzip_command='gzip1'; + my $zlib_command='zlib'; + + my $prog=lc $hash{prog}; + my $path=lc $hash{prog}; + + if($prog!~/^($gzip_command|$pigz_command|$zlib_command|nouse|)$/) { + return bless { + prog=>"", + level=>"", + path=>"", + init=>0, + }, $class; + } + + # M—p‚µ‚ÄŽÀs + $path=(split(/ /, $path))[0]; + if($-x $path) { + $::debug.="GZIP.pm: Force $path\n"; + return bless { + prog=>"custom", + path=>$hash{path}, + compressflag=>$hash{compressflag}, + uncompressflag=>$hash{uncompressflag}, + init=>1, + }, $class; + } + + # ŒŸõ‚·‚é + my $_execpath="/usr/local/bin:/usr/bin:/bin:$ENV{PATH}"; + my $_force="--force"; + my $_fast="--fast"; + my $_best="--best"; + my $_decompress="--decompress"; + my ($path, $pathbak); + my ($forceflag, $fastflag, $bestflag, $decompressflag); + my $info=new Nana::ServerInfo; + + if($prog eq "" || $prog eq $gzip_command) { + my $found=0; + foreach(split(/:/,$_execpath)) { + if(-x "$_/$gzip_command") { + $path="$_/$gzip_command" ; +# $prog=$gzip_command; + if(open(PIPE,"$path --help 2>&1|")) { + foreach(<PIPE>) { + $forceflag="$_force" if(/$_force/); + $fastflag="$_fast" if(/$_fast/); + $bestflag="$_best" if(/$_best/); + $decompressflag=$_decompress if(/$_decompress/); + } + $found=1; + close(PIPE); + } + } + } + $path="" if($found eq 0); + } + $pathbak=$path; + if($prog eq "" && $info->core > 3 || $prog eq $pigz_command) { + my $found=0; + foreach(split(/:/,$_execpath)) { + if(-x "$_/$pigz_command") { + $path="$_/$pigz_command" ; +# $prog=$gzip_command; + if(open(PIPE,"$path --help 2>&1|")) { + foreach(<PIPE>) { + $forceflag="$_force" if(/$_force/); + $fastflag="$_fast" if(/$_fast/); + $bestflag="$_best" if(/$_best/); + $decompressflag=$_decompress if(/$_decompress/); + } + $found=1; + close(PIPE); + } + } + } + $path=$pathbak if($found eq 0); + } + $pathbak=$path; + if($path eq "" || $prog eq $zlib_command) { + if(&load_module("Compress::Zlib")) { + $path="zlib"; + } + } + + my $level= + lc $hash{level} eq "best" ? " $forceflag $bestflag " : + lc $hash{level} eq "fast" ? " $forceflag $fastflag " : + " $forceflag $fastflag "; + + $decompressflag="$forceflag $decompressflag"; + $GZIP::BEFOREPROG=$hash{prog}; + $GZIP::BEFORELEVEL=$hash{level}; + $GZIP::BEFORCOMPRESSFLAG=$level; + $GZIP::BEFOREUNCOMPRESSFLAG=$decompressflag; + $GZIP::BEFOREPATH=$path; + $::debug.="GZIP.pm: auto detect gzip (compress) : $GZIP::BEFOREPATH $GZIP::BEFORCOMPRESSFLAG\nGZIP.pm: auto detect gzip (uncompress) : $GZIP::BEFOREPATH $GZIP::BEFOREUNCOMPRESSFLAG\n"; + return bless { + prog=>$hash{prog}, + level=>$hash{level}, + path=>$hash{path}, + compressflag=>$level, + uncompressflag=>$decompressflag, + _path=>$path, + init=>1, + }, $class; + } + return bless { + prog=>$GZIP::BEFOREPROG, + level=>$GZIP::BEFORELEVEL, + path=>$hash{path}, + compressflag=>$GZIP::BEFORCOMPRESSFLAG, + uncompressflag=>$GZIP::BEFOREUNCOMPRESSFLAG, + _path=>$GZIP::BEFOREPATH, + init=>1 + }, $class; +} + +sub fifo { + my ($cmd, $post)=@_; + + my $path=&mktemp($ENV{REMOTE_HOST} . $ENV{HTTP_USER_AGENT}); + my $mode = 0600; + + unlink($path); + + use POSIX; + if(! mkfifo($path, $mode) ) { + die "can not mkfifo($path, $mode): $!"; + } + + my $pid = fork(); + if ($pid ==0) { + open(FIFO, "| $cmd > $path") + or die "can not open $path: $!"; + print FIFO $post; + close(FIFO); + exit; + } + + open(FIFO, "< ${path}") + or die "can not open ${path}: $!"; + my $get; + while(<FIFO>) { + $get.=$_; + } + + wait; + close(FIFO); + + return $get; +} + +sub mktemp { + my($seed)=shift; + + return "$::cache_dir/fifotemp.test"; +} -# init # debug sub init { - if(&load_module("Compress::Zlib")) { - $GZIP::INIT=0; - return 1; - } - return 0; -} - -# compress # debug -sub gzipcompress { - my($data)=shift; - return Compress::Zlib::memGzip($data); -} - -# uncompress # debug -sub gzipuncompress { - ## Taken from Namazu <http://www.namazu.org/>, filter/gzip.pl # debug - my ($data)=shift; - my ($s)=$data; - my $flags = unpack('C', substr($s, 3, 1)); - $s = substr($s, 10); - $s = substr($s, 2) if ($flags & 0x04); - $s =~ s/^[^\0]*\0// if ($flags & 0x08); - $s =~ s/^[^\0]*\0// if ($flags & 0x10); - $s = substr($s, 2) if ($flags & 0x02); - - my $zl = Compress::Zlib::inflateInit - (-WindowBits => - Compress::Zlib::MAX_WBITS()); - my ($inf, $stat) = $zl->inflate ($s); - if ($stat == Compress::Zlib::Z_OK() - || $stat == Compress::Zlib::Z_STREAM_END()) { - return $inf; - } else { - return 'Bad compressed data'; + my ($self, $data)=@_; + return $self->{init}; +} + +sub compress { + my ($self, $data)=@_; + $::debug.="GZIP.pm compress cmd:$self->{_path}\n"; + if($self->{init}) { + if($self->{_path} ne "zlib") { + my $cmd=$self->{_path} . " " . $self->{compressflag}; + my $gziped=&fifo("$cmd", $data); + return $gziped; + } + $::debug.="zlib writed\n"; + return Compress::Zlib::memGzip($data); } + return $data; +} + +sub uncompress { + my ($self, $input)=@_; + $::debug.="GZIP.pm extract cmd:$self->{_path}\n"; + if($self->{init}) { + if($self->{_path} ne "zlib" ) { + my $cmd=$self->{_path} . " " . $self->{uncompressflag}; + my $output=&fifo("$cmd", $input); + return $output; + } + ## Taken from Namazu <http://www.namazu.org/>, filter/gzip.pl + my ($data)=shift; + my ($s)=$input; + my $flags = unpack('C', substr($s, 3, 1)); + $s = substr($s, 10); + $s = substr($s, 2) if ($flags & 0x04); + $s =~ s/^[^\0]*\0// if ($flags & 0x08); + $s =~ s/^[^\0]*\0// if ($flags & 0x10); + $s = substr($s, 2) if ($flags & 0x02); + + my $zl = Compress::Zlib::inflateInit + (-WindowBits => - Compress::Zlib::MAX_WBITS()); + my ($inf, $stat) = $zl->inflate ($s); + if ($stat == Compress::Zlib::Z_OK() + || $stat == Compress::Zlib::Z_STREAM_END()) { + return $inf; + } else { + return 'Bad compressed data'; + } + } + return $input; } sub load_module { my $funcp = $::functions{"load_module"}; return &$funcp(@_); } + +sub print_error { + my $funcp = $::functions{"print_error"}; + return &$funcp(@_); +} + 1; Index: PyukiWiki-Devel/lib/Nana/GoogleSitemaps.pm diff -u PyukiWiki-Devel/lib/Nana/GoogleSitemaps.pm:1.156 PyukiWiki-Devel/lib/Nana/GoogleSitemaps.pm:1.157 --- PyukiWiki-Devel/lib/Nana/GoogleSitemaps.pm:1.156 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/GoogleSitemaps.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # GoogleSitemaps.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: GoogleSitemaps.pm,v 1.156 2012/08/09 08:42:09 papu Exp $ +# $Id: GoogleSitemaps.pm,v 1.157 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:50 # # "Nana::GoogleSitemaps" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::GoogleSitemaps; Index: PyukiWiki-Devel/lib/Nana/HTMLOpt.pm diff -u PyukiWiki-Devel/lib/Nana/HTMLOpt.pm:1.43 PyukiWiki-Devel/lib/Nana/HTMLOpt.pm:1.44 --- PyukiWiki-Devel/lib/Nana/HTMLOpt.pm:1.43 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/HTMLOpt.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # HTMLOpt.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: HTMLOpt.pm,v 1.43 2012/08/09 08:42:09 papu Exp $ +# $Id: HTMLOpt.pm,v 1.44 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "Nana::HTMLOpt" ver 0.1 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::HTMLOpt; Index: PyukiWiki-Devel/lib/Nana/HTTP.pm diff -u PyukiWiki-Devel/lib/Nana/HTTP.pm:1.525 PyukiWiki-Devel/lib/Nana/HTTP.pm:1.526 --- PyukiWiki-Devel/lib/Nana/HTTP.pm:1.525 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/HTTP.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # HTTP.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: HTTP.pm,v 1.525 2012/08/09 08:42:09 papu Exp $ +# $Id: HTTP.pm,v 1.526 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "HTTP::Lite" ver 0.8 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::HTTP; Index: PyukiWiki-Devel/lib/Nana/HTTPCompress.pm diff -u PyukiWiki-Devel/lib/Nana/HTTPCompress.pm:1.45 PyukiWiki-Devel/lib/Nana/HTTPCompress.pm:1.46 --- PyukiWiki-Devel/lib/Nana/HTTPCompress.pm:1.45 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/HTTPCompress.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # HTTPCompress.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: HTTPCompress.pm,v 1.45 2012/08/09 08:42:09 papu Exp $ +# $Id: HTTPCompress.pm,v 1.46 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "Nana::HTTPCompress" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::HTTPCompress; @@ -70,10 +71,10 @@ } if($path ne '') { $gzip::path="$path $fastflag $forceflag"; - $::debug.="auto detect gzip path : \"$gzip::path\"\n"; # debug + $::debug.="auto detect gzip path : \"$gzip::path\"\n"; } elsif(&load_module("Compress::Zlib")) { $gzip::path="zlib"; - $::debug.="auto detect Compress::Zlib"; # debug + $::debug.="auto detect Compress::Zlib"; } } Index: PyukiWiki-Devel/lib/Nana/Lock.pm diff -u PyukiWiki-Devel/lib/Nana/Lock.pm:1.548 PyukiWiki-Devel/lib/Nana/Lock.pm:1.549 --- PyukiWiki-Devel/lib/Nana/Lock.pm:1.548 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Lock.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Lock.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Lock.pm,v 1.548 2012/08/09 08:42:09 papu Exp $ +# $Id: Lock.pm,v 1.549 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:51 # # "Nana::Lock" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=Shift-JIS 1TAB=4Spaces +# Return:CRLF Code=Shift-JIS 1TAB=4Spaces ###################################################################### # # ‘å莂Ìrenameƒtƒ@ƒCƒ‹ƒƒbƒN‚ɑ΂µ‚ÄAˆÈ‰º‚̉ü—Ç“_‚ª‚ ‚è‚Ü‚·B @@ -34,18 +35,18 @@ use vars qw($VERSION); $VERSION = '0.2'; -$Nana::Lock::DEBUG=0; # debug -# ª‚P‚É‚·‚é‚ƃƒbƒNŠÖŒW‚̃ƒbƒZ[ƒW‚ª‚Å‚Ü‚·# debug -# error # debug -sub die { # debug - $::debug.="Nana::Lock:Error:$_[0]\n"; # debug - return undef; # debug -} # debug -# message # debug -sub msg { # debug - $::debug.="Nana:Lock:$_[0]\n" # debug - if($Nana::Lock::DEBUG eq 1); # debug -} # debug +$Nana::Lock::DEBUG=0; +# ª‚P‚É‚·‚é‚ƃƒbƒNŠÖŒW‚̃ƒbƒZ[ƒW‚ª‚Å‚Ü‚· +# error +sub die { + $::debug.="Nana::Lock:Error:$_[0]\n"; + return undef; +} +# message +sub msg { + $::debug.="Nana:Lock:$_[0]\n" + if($Nana::Lock::DEBUG eq 1); +} $Nana::Lock::LOCK_SH=1; $Nana::Lock::LOCK_EX=2; @@ -54,26 +55,26 @@ # rename lock idea # http://www.din.or.jp/~ohzaki/perl.htm#File_Lock -# ƒƒbƒNƒtƒ@ƒCƒ‹‚ÌŒ`Ž® # debug -# (Œ³ƒtƒ@ƒCƒ‹–¼‚Å•s—v•”•ª‚𜂢‚½‚à‚Ì).(method).(pid).(time).lk # debug -# 0 : ƒƒbƒN‚µ‚È‚¢BÈ—ªŽž‚̃fƒtƒHƒ‹ƒg # debug -# 1 : (LOCK_SH) ‹¤—LƒƒbƒNCƒŠƒgƒ‰ƒC‚ ‚è # debug -# 2 : (LOCK_EX) ”r‘¼ƒƒbƒNCƒŠƒgƒ‰ƒC‚ ‚è # debug -# 5 : (LOCK_SH|LOCK_NB) ‹¤—LƒƒbƒNCƒŠƒgƒ‰ƒC‚È‚µ # debug -# 6 : (LOCK_EX|LOCK_NB) ”r‘¼ƒƒbƒNCƒŠƒgƒ‰ƒC‚È‚µ # debug -# 8 : (LOCK_UN) Žg‚í‚È‚¢‚±‚ÆB # debug -# 128 : (LOCK_DELETE) ƒƒbƒNƒtƒ@ƒCƒ‹‚Ìíœ # debug +# ƒƒbƒNƒtƒ@ƒCƒ‹‚ÌŒ`Ž® +# (Œ³ƒtƒ@ƒCƒ‹–¼‚Å•s—v•”•ª‚𜂢‚½‚à‚Ì).(method).(pid).(time).lk +# 0 : ƒƒbƒN‚µ‚È‚¢BÈ—ªŽž‚̃fƒtƒHƒ‹ƒg +# 1 : (LOCK_SH) ‹¤—LƒƒbƒNCƒŠƒgƒ‰ƒC‚ ‚è +# 2 : (LOCK_EX) ”r‘¼ƒƒbƒNCƒŠƒgƒ‰ƒC‚ ‚è +# 5 : (LOCK_SH|LOCK_NB) ‹¤—LƒƒbƒNCƒŠƒgƒ‰ƒC‚È‚µ +# 6 : (LOCK_EX|LOCK_NB) ”r‘¼ƒƒbƒNCƒŠƒgƒ‰ƒC‚È‚µ +# 8 : (LOCK_UN) Žg‚í‚È‚¢‚±‚ÆB +# 128 : (LOCK_DELETE) ƒƒbƒNƒtƒ@ƒCƒ‹‚Ìíœ sub lock { my $timeout=5; my $trytime=2; my($fname,$method)=@_; - # ƒfƒBƒŒƒNƒgƒŠAƒtƒ@ƒCƒ‹–¼AŠg’£Žq‚𕪗£ # debug + # ƒfƒBƒŒƒNƒgƒŠAƒtƒ@ƒCƒ‹–¼AŠg’£Žq‚𕪗£ my($d,$f,$e)=$fname=~/(.*)\/(.+)\.(.+)$/; - # ƒtƒ@ƒCƒ‹–¼‚©‚ç‹L†‚炵‚«‚à‚̂𜋎(’Z‚‚·‚邽‚ß) # debug + # ƒtƒ@ƒCƒ‹–¼‚©‚ç‹L†‚炵‚«‚à‚̂𜋎(’Z‚‚·‚邽‚ß) $f=~s/[.%()[]:*,_]//g; - # ‰Šúƒnƒ“ƒhƒ‹‚Ìì¬ # debug + # ‰Šúƒnƒ“ƒhƒ‹‚Ìì¬ my %lfh=( dir=>$d, basename=>$f, @@ -83,30 +84,30 @@ method=>$method & 3, path=>"$d/$f.lk" ); - # ƒƒbƒNƒtƒ@ƒCƒ‹‚Ìíœ # debug + # ƒƒbƒNƒtƒ@ƒCƒ‹‚Ìíœ if($method eq $Nana::Lock::LOCK_DELETE) { return &lock_del(%lfh); } - # method‚ª‚¨‚©‚µ‚¢ê‡return # debug - if($lfh{method} eq 0) { # debug - &msg("lock error:$fname $lfh{method} - $method"); # debug - return; # debug - } # debug + # method‚ª‚¨‚©‚µ‚¢ê‡return + if($lfh{method} eq 0) { + &msg("lock error:$fname $lfh{method} - $method"); + return; + } return if($lfh{method} eq 0); for(my $i=0; $i < $lfh{trytime}*10; $i++) { - # ƒƒbƒNƒƒ\ƒbƒhAƒvƒƒZƒXIDAŒ»ÝŽž‚ð“ü‚ê‚é # debug + # ƒƒbƒNƒƒ\ƒbƒhAƒvƒƒZƒXIDAŒ»ÝŽž‚ð“ü‚ê‚é $lfh{current}=sprintf("%s/%s.%x.%x.%x.%d.lk" ,$lfh{dir},$lfh{basename},$lfh{method},$$,time); - # ƒƒbƒNA¬Œ÷Žž‚ͳíI—¹ # debug - if(rename($lfh{path},$lfh{current})) { # debug - &msg(sprintf("%s:%s->%s" # debug - ,($lfh{method} eq 1 ? 'LOCK_SH' : 'LOCK_EX'), $lfh{path},$lfh{current})); # debug - return \%lfh; # debug - } # debug + # ƒƒbƒNA¬Œ÷Žž‚ͳíI—¹ + if(rename($lfh{path},$lfh{current})) { + &msg(sprintf("%s:%s->%s" + ,($lfh{method} eq 1 ? 'LOCK_SH' : 'LOCK_EX'), $lfh{path},$lfh{current})); + return \%lfh; + } return \%lfh if(rename($lfh{path},$lfh{current})); - # ‰ß‹Ž‚̃ƒbƒNƒtƒ@ƒCƒ‹‚ðŒŸõ # debug + # ‰ß‹Ž‚̃ƒbƒNƒtƒ@ƒCƒ‹‚ðŒŸõ my @filelist=&lock_getdir(%lfh); my @locklist=(); my $fcount=0; @@ -118,86 +119,86 @@ $fcount++; $shcount++ if($1 eq 1); $excount++ if($1 eq 2); - &msg(sprintf("Found:%s.%s.%s.%s.lk(method=%d,all=%d,ex=%d,sh=%d)" # debug - ,$lfh{basename},$1,$2,$3,$lfh{method},$fcount,$excount,$shcount)); # debug + &msg(sprintf("Found:%s.%s.%s.%s.lk(method=%d,all=%d,ex=%d,sh=%d)" + ,$lfh{basename},$1,$2,$3,$lfh{method},$fcount,$excount,$shcount)); } } - # ƒƒbƒNƒtƒ@ƒCƒ‹‚ª‘¶Ý‚µ‚È‚¯‚ê‚ÎV‹Kì¬ # debug + # ƒƒbƒNƒtƒ@ƒCƒ‹‚ª‘¶Ý‚µ‚È‚¯‚ê‚ÎV‹Kì¬ if($fcount eq 0) { - &msg("Create $lfh{path}"); # debug + &msg("Create $lfh{path}"); open(LFHF,">$lfh{path}");# or return undef; close(LFHF); next; - # ‹¤—LƒƒbƒN‚Ìê‡ # debug + # ‹¤—LƒƒbƒN‚Ìê‡ } elsif($lfh{method} eq 1) { - # ”r‘¼‚ª‘¶Ý‚µ‚È‚¢ê‡ # debug - &msg("SH Lock Check $lfh{basename}"); # debug + # ”r‘¼‚ª‘¶Ý‚µ‚È‚¢ê‡ + &msg("SH Lock Check $lfh{basename}"); if($shcount > 0 && $excount eq 0) { - # ‚P‚ƒ`ƒ‡ƒCƒX‚µ‚ÄAƒŠƒl[ƒ€‚·‚é # debug + # ‚P‚ƒ`ƒ‡ƒCƒX‚µ‚ÄAƒŠƒl[ƒ€‚·‚é foreach(@locklist) { my($method,$pid,$time)=split(/\t/,$_); my $orgf=sprintf("%s/%s.%x.%s.%s.lk" ,$lfh{dir},$lfh{basename},$method,$pid,$time); - &msg("new fn=$orgf"); # debug - # ăƒbƒN # debug - if(rename($orgf,$lfh{current})) { # debug - &msg(sprintf("%s:%s->%s" # debug - ,"LOCK_SH",$orgf,$lfh{current})); # debug - return \%lfh; # debug - } # debug + &msg("new fn=$orgf"); + # ăƒbƒN + if(rename($orgf,$lfh{current})) { + &msg(sprintf("%s:%s->%s" + ,"LOCK_SH",$orgf,$lfh{current})); + return \%lfh; + } return \%lfh if(rename($orgf,$lfh{current})); } } } - # ”r‘¼‚Å‚ ‚éorˆÙ펞 # debug - # 0.1•b‚ÌsleepAŽg‚¦‚È‚¯‚ê‚Î1•b # debug + # ”r‘¼‚Å‚ ‚éorˆÙ펞 + # 0.1•b‚ÌsleepAŽg‚¦‚È‚¯‚ê‚Î1•b eval("select undef, undef, undef, 0.1;"); if($@) { sleep 1; $i+=9; - &msg("waiting 1sec count $i"); # debug - } else { # debug - &msg("waiting 0.1sec count $i"); # debug + &msg("waiting 1sec count $i"); + } else { + &msg("waiting 0.1sec count $i"); } } - # ÄŽŽsI—¹ # debug - # ‰ß‹Ž‚̃ƒbƒNƒtƒ@ƒCƒ‹‚ðŒŸõ # debug + # ÄŽŽsI—¹ + # ‰ß‹Ž‚̃ƒbƒNƒtƒ@ƒCƒ‹‚ðŒŸõ my @filelist=&lock_getdir(%lfh); foreach (@filelist) { if (/^$lfh{basename}\.(\d)\.(.+)\.(.+)\.lk$/) { - # ƒ^ƒCƒ€ƒAƒEƒg‚µ‚Ä‚¢‚é‚Ì‚ª‘¶Ý‚µ‚½‚ç # debug + # ƒ^ƒCƒ€ƒAƒEƒg‚µ‚Ä‚¢‚é‚Ì‚ª‘¶Ý‚µ‚½‚ç if (time - hex($3) > $lfh{timeout}) { my $orgf=sprintf("%s/%s.%s.%s.%s.lk" ,$lfh{dir},$lfh{basename},$1,$2,$3); - if(rename($orgf,$lfh{current})) { # debug - &msg(sprintf("%s:%s->%s" # debug - ,"FORCE_LOCK",$orgf,$lfh{current})); # debug - return \%lfh; # debug - } # debug + if(rename($orgf,$lfh{current})) { + &msg(sprintf("%s:%s->%s" + ,"FORCE_LOCK",$orgf,$lfh{current})); + return \%lfh; + } return \%lfh if(rename($orgf,$lfh{current})); } } } - &msg("lock:can't lock"); # debug + &msg("lock:can't lock"); return undef; } sub unlock { - if(rename($_[0]->{current}, $_[0]->{path})) { # debug - &msg("LOCK_UN" . $_[0]->{current} . "->" . $_[0]->{path}); # debug - } # debug + if(rename($_[0]->{current}, $_[0]->{path})) { + &msg("LOCK_UN" . $_[0]->{current} . "->" . $_[0]->{path}); + } rename($_[0]->{current}, $_[0]->{path}); } sub lock_del { my(%lfh)=@_; unlink($lfh{path}); - &msg("LOCK_DELETE: $lfh{path}"); # debug + &msg("LOCK_DELETE: $lfh{path}"); my @filelist=&lock_getdir(%lfh); foreach (@filelist) { if (/^$lfh{basename}\.(\d)\.(.+)\.(.+)\.lk$/) { unlink($_); - &msg("LOCK_DELETE: $_"); # debug + &msg("LOCK_DELETE: $_"); } } } Index: PyukiWiki-Devel/lib/Nana/Logs.pm diff -u PyukiWiki-Devel/lib/Nana/Logs.pm:1.248 PyukiWiki-Devel/lib/Nana/Logs.pm:1.249 --- PyukiWiki-Devel/lib/Nana/Logs.pm:1.248 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Logs.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Logs.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Logs.pm,v 1.248 2012/08/09 08:42:09 papu Exp $ +# $Id: Logs.pm,v 1.249 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::Logs" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::Logs; Index: PyukiWiki-Devel/lib/Nana/MD5.pm diff -u PyukiWiki-Devel/lib/Nana/MD5.pm:1.102 PyukiWiki-Devel/lib/Nana/MD5.pm:1.103 --- PyukiWiki-Devel/lib/Nana/MD5.pm:1.102 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/MD5.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # MD5.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: MD5.pm,v 1.102 2012/08/09 08:42:09 papu Exp $ +# $Id: MD5.pm,v 1.103 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::MD5" ver 0.2 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::MD5; Index: PyukiWiki-Devel/lib/Nana/Mail.pm diff -u PyukiWiki-Devel/lib/Nana/Mail.pm:1.509 PyukiWiki-Devel/lib/Nana/Mail.pm:1.510 --- PyukiWiki-Devel/lib/Nana/Mail.pm:1.509 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Mail.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Mail.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Mail.pm,v 1.509 2012/08/09 08:42:09 papu Exp $ +# $Id: Mail.pm,v 1.510 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::Mail" ver 0.6 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### # require perl version >= 5.8.1 ###################################################################### Index: PyukiWiki-Devel/lib/Nana/Pod2Wiki.pm diff -u PyukiWiki-Devel/lib/Nana/Pod2Wiki.pm:1.522 PyukiWiki-Devel/lib/Nana/Pod2Wiki.pm:1.523 --- PyukiWiki-Devel/lib/Nana/Pod2Wiki.pm:1.522 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Pod2Wiki.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Pod2Wiki.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Pod2Wiki.pm,v 1.522 2012/08/09 08:42:09 papu Exp $ +# $Id: Pod2Wiki.pm,v 1.523 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::Pod2Wiki" ver 0.1 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::Pod2Wiki; Index: PyukiWiki-Devel/lib/Nana/RemoteHost.pm diff -u PyukiWiki-Devel/lib/Nana/RemoteHost.pm:1.43 PyukiWiki-Devel/lib/Nana/RemoteHost.pm:1.44 --- PyukiWiki-Devel/lib/Nana/RemoteHost.pm:1.43 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/RemoteHost.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # RemoteHost.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: RemoteHost.pm,v 1.43 2012/08/09 08:42:09 papu Exp $ +# $Id: RemoteHost.pm,v 1.44 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::RemoteHost" ver 0.1 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=Shift-JIS 1TAB=4Spaces +# Return:CRLF Code=Shift-JIS 1TAB=4Spaces ###################################################################### package Nana::RemoteHost; Index: PyukiWiki-Devel/lib/Nana/Search.pm diff -u PyukiWiki-Devel/lib/Nana/Search.pm:1.562 PyukiWiki-Devel/lib/Nana/Search.pm:1.563 --- PyukiWiki-Devel/lib/Nana/Search.pm:1.562 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Search.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # Search.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: Search.pm,v 1.562 2012/08/09 08:42:09 papu Exp $ +# $Id: Search.pm,v 1.563 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::Search" ver 0.6 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### # 日本語あいまい検索をするためのモジュールです。内部コードEUC、UTF8用 ###################################################################### Index: PyukiWiki-Devel/lib/Nana/Search.pm.ja.pod diff -u PyukiWiki-Devel/lib/Nana/Search.pm.ja.pod:1.548 PyukiWiki-Devel/lib/Nana/Search.pm.ja.pod:1.549 --- PyukiWiki-Devel/lib/Nana/Search.pm.ja.pod:1.548 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/Search.pm.ja.pod Thu Aug 16 10:24:28 2012 @@ -1,4 +1,4 @@ -#$Id: Search.pm.ja.pod,v 1.548 2012/08/09 08:42:09 papu Exp $ +#$Id: Search.pm.ja.pod,v 1.549 2012/08/16 01:24:28 papu Exp $ __END__ =encoding euc-jp Index: PyukiWiki-Devel/lib/Nana/ServerInfo.pm diff -u PyukiWiki-Devel/lib/Nana/ServerInfo.pm:1.11 PyukiWiki-Devel/lib/Nana/ServerInfo.pm:1.12 --- PyukiWiki-Devel/lib/Nana/ServerInfo.pm:1.11 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/ServerInfo.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # ServerInfo.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: ServerInfo.pm,v 1.11 2012/08/09 08:42:09 papu Exp $ +# $Id: ServerInfo.pm,v 1.12 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::ServerInfo" ver 0.1 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::ServerInfo; Index: PyukiWiki-Devel/lib/Nana/YukiWikiDB.pm diff -u PyukiWiki-Devel/lib/Nana/YukiWikiDB.pm:1.550 PyukiWiki-Devel/lib/Nana/YukiWikiDB.pm:1.551 --- PyukiWiki-Devel/lib/Nana/YukiWikiDB.pm:1.550 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/YukiWikiDB.pm Thu Aug 16 10:24:28 2012 @@ -1,6 +1,7 @@ ###################################################################### # YukiWikiDB.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: YukiWikiDB.pm,v 1.550 2012/08/09 08:42:09 papu Exp $ +# $Id: YukiWikiDB.pm,v 1.551 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:52 # # "Nana::YukiWikiDB" ver 0.7 $$ # Author: Nanami @@ -14,7 +15,7 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::YukiWikiDB; @@ -27,11 +28,11 @@ return shift->TIEHASH(@_); } -# error # debug -sub die { # debug - $::debug.="YukiWikiDB:$_[0]\n"; # debug - return undef; # debug -} # debug +# error +sub die { + $::debug.="YukiWikiDB:$_[0]\n"; + return undef; +} # tying # comment sub TIEHASH { @@ -42,7 +43,7 @@ }; if (not -d $self->{dir}) { if (!mkdir($self->{dir}, 0777)) { - return &die("mkdir $self->{dir} fail"); # debug + return &die("mkdir $self->{dir} fail"); return undef; } } @@ -88,8 +89,8 @@ } closedir(DIR); return shift @{$self->{keys}}; - } else { # debug - return &die("FIRSTKEY: $self->{dir} fail"); # debug + } else { + return &die("FIRSTKEY: $self->{dir} fail"); } return; } Index: PyukiWiki-Devel/lib/Nana/YukiWikiDB_GZIP.pm diff -u PyukiWiki-Devel/lib/Nana/YukiWikiDB_GZIP.pm:1.297 PyukiWiki-Devel/lib/Nana/YukiWikiDB_GZIP.pm:1.298 --- PyukiWiki-Devel/lib/Nana/YukiWikiDB_GZIP.pm:1.297 Thu Aug 9 17:42:09 2012 +++ PyukiWiki-Devel/lib/Nana/YukiWikiDB_GZIP.pm Thu Aug 16 10:24:28 2012 @@ -1,8 +1,9 @@ ###################################################################### # YukiWikiDB_GZIP.pm - This is PyukiWiki, yet another Wiki clone. -# $Id: YukiWikiDB_GZIP.pm,v 1.297 2012/08/09 08:42:09 papu Exp $ +# $Id: YukiWikiDB_GZIP.pm,v 1.298 2012/08/16 01:24:28 papu Exp $ +# Build on 2012-08-16 02:01:53 # -# "Nana::YukiWikiDB_GZIP" ver 0.8 $$ +# "Nana::YukiWikiDB_GZIP" ver 0.9 $$ # Author: Nanami # http://nanakochi.daiba.cx/ # Copyright (C) 2004-2007 Nekyo @@ -14,11 +15,11 @@ # # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. -# Return:LF Code=EUC-JP 1TAB=4Spaces +# Return:CRLF Code=EUC-JP 1TAB=4Spaces ###################################################################### package Nana::YukiWikiDB_GZIP; -$VERSION="0.8"; +$VERSION="0.9"; use strict; use Nana::File; use Nana::GZIP; @@ -28,11 +29,11 @@ return shift->TIEHASH(@_); } -# error # debug -sub die { # debug - $::debug.="YukiWikiDB_GZIP:$_[0]\n";# debug - return undef; # debug -} # debug +# error +sub die { + $::debug.="YukiWikiDB_GZIP:$_[0]\n"; + return undef; +} # tying # comment sub TIEHASH { @@ -40,11 +41,13 @@ my $self = { dir => $dbname, keys => [], - gzip => Nana::GZIP::init(), +# gzip => Nana::GZIP::init(), + gzip => new Nana::GZIP() }; +$::debug.="yuki:inited ". $self->{gzip}->init() . "\n"; if (not -d $self->{dir}) { if (!mkdir($self->{dir}, 0777)) { - return &die("mkdir $self->{dir} fail"); # debug + return &die("mkdir $self->{dir} fail"); return undef; } } @@ -56,10 +59,11 @@ my ($self, $key, $value) = @_; my ($mode, $filename) = &make_filename($self, $key); my ($mode, $filename_gz) = &make_filename_gz($self, $key); - if($self->{gzip} eq 1) { + my $gz=$self->{gzip}; + if($gz->{init} eq 1) { Nana::File::lock_delete($filename); - return Nana::File::lock_store($filename_gz, - Nana::GZIP::gzipcompress($value)); + return + Nana::File::lock_store($filename_gz, $gz->compress($value)); } return Nana::File::lock_store($filename,$value); } @@ -69,11 +73,17 @@ my ($self, $key) = @_; my ($mode, $filename) = &make_filename($self, $key); my ($mode, $filename_gz) = &make_filename_gz($self, $key); - if($self->{gzip} eq 1) { + my $gz=$self->{gzip}; + if($gz->{init} eq 1) { if(-e $filename_gz) { return (stat($filename_gz))[9] if($mode eq "update"); - my $data=Nana::File::lock_fetch($filename_gz); - return Nana::GZIP::gzipuncompress($data); + return + ($gz->uncompress(Nana::File::lock_fetch($filename_gz))); +# Nana::File::lock_store($filename_gz, $gz->compress($value)); + +# my $data=Nana::File::lock_fetch($filename_gz); +# return Nana::GZIP::gzipuncompress($data); + } } return (stat($filename))[9] if($mode eq "update"); @@ -110,8 +120,8 @@ } closedir(DIR); return shift @{$self->{keys}}; - } else { # debug - return &die("FIRSTKEY: $self->{dir} fail"); # debug + } else { + return &die("FIRSTKEY: $self->{dir} fail"); } return; }
