--- /dev/null
+package plugin::presentation::Install;\r
+################################################################################\r
+#\r
+# FSWiki¾å¤Ç¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó¤ò¹Ô¤¦¤¿¤á¤Î¥×¥é¥°¥¤¥ó¤Ç¤¹¡£\r
+#\r
+################################################################################\r
+sub install {\r
+ my $wiki = shift;\r
+ \r
+ $wiki->add_menu("¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó","",200);\r
+ $wiki->add_hook("show","plugin::presentation::PresentationHandler");\r
+ $wiki->add_handler("PRESEN","plugin::presentation::PresentationHandler");\r
+}\r
+\r
+1;\r
--- /dev/null
+package plugin::presentation::PresentationHandler;\r
+################################################################################\r
+#\r
+# JavaScript¤ò»È¤Ã¤Æ¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó¤ò¹Ô¤¤¤Þ¤¹¡£\r
+#\r
+################################################################################\r
+use strict;\r
+\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+sub do_action {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $cgi = $wiki->get_CGI;\r
+ my $pagename = $cgi->param("page");\r
+ \r
+ $wiki->set_title("¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó: $pagename");\r
+ \r
+ my @lines = split(/\n/, $wiki->get_page($pagename));\r
+ my @pages = ();\r
+ my $title = '';\r
+ my $content = '';\r
+ \r
+ foreach my $line (@lines){\r
+ if(index($line, '!!!')==0){\r
+ if($title ne ''){\r
+ push(@pages, {title=>$title, content=>$wiki->process_wiki($content)});\r
+ }\r
+ $title = $wiki->process_wiki($line);\r
+ $content = '';\r
+ } else {\r
+ $content .= $line . "\n";\r
+ }\r
+ }\r
+ if($title ne ''){\r
+ push(@pages, {title=>$title, content=>$wiki->process_wiki($content)});\r
+ }\r
+ \r
+ print "Content-Type: text/html;charset=EUC-JP\n";\r
+ print "Pragma: no-cache\n";\r
+ print "Cache-Control: no-cache\n\n";\r
+ print <<EOD;\r
+<html>\r
+<head>\r
+ <title>¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó¡§ @{[Util::escapeHTML($pagename)]}</title>\r
+</head>\r
+<body>\r
+<style type="text/css">\r
+@{[stylesheet()]}\r
+</style>\r
+<script language="JavaScript">\r
+var presen_page = 0;\r
+var presen_data = new Array($#pages);\r
+EOD\r
+ my $count = 0;\r
+ foreach my $page (@pages){\r
+ print <<EOD;\r
+var data = new Object();\r
+data.title = '@{[&escapeJavaScript($page->{title})]}';\r
+data.content = '@{[escapeJavaScript($page->{content})]}';\r
+presen_data[$count] = data;\r
+EOD\r
+ $count++;\r
+ }\r
+ \r
+ print <<EOD;\r
+function showNextPage(){\r
+ var div = document.getElementById('presentation');\r
+ if(presen_page == presen_data.length){\r
+ div.innerHTML = "¥¹¥é¥¤¥É¥·¥ç¡¼¤Ï½ªÎ»¤·¤Þ¤·¤¿¡£";\r
+ presen_page++;\r
+ } else {\r
+ div.innerHTML = presen_data[presen_page].title + \r
+ presen_data[presen_page].content;\r
+ presen_page++;\r
+ }\r
+ div.focus(false);\r
+}\r
+\r
+function backToFirst(){\r
+ presen_page = 0;\r
+ showNextPage();\r
+}\r
+\r
+function showPrevPage(){\r
+ if(presen_page > 1){\r
+ presen_page--;\r
+ presen_page--;\r
+ showNextPage();\r
+ }\r
+}\r
+\r
+function exitPresentation(){\r
+ location.href='@{[$wiki->config('script_name').'?page='.Util::escapeHTML($pagename)]}'\r
+}\r
+</script>\r
+<div class="presen_menu">\r
+ <a href="javascript:backToFirst();">ºÇ½é</a>\r
+ <a href="javascript:showPrevPage();">Á°¤Ø</a>\r
+ <a href="javascript:showNextPage();">¼¡¤Ø</a>\r
+ <a href="javascript:exitPresentation();">½ªÎ»</a>\r
+</div>\r
+<div id="presentation" onMouseUp ="javascript:showNextPage();">\r
+¥¯¥ê¥Ã¥¯¤¹¤ë¤È¥¹¥é¥¤¥É¥·¥ç¡¼¤ò³«»Ï¤·¤Þ¤¹¡£\r
+</div>\r
+</body>\r
+</html>\r
+EOD\r
+ \r
+ exit;\r
+}\r
+\r
+#===============================================================================\r
+# ¥×¥ì¥¼¥ó¥â¡¼¥É¤ÎCSS¤òÊֵѤ·¤Þ¤¹¡£\r
+#===============================================================================\r
+sub stylesheet {\r
+ return <<END_OF_CSS;\r
+div#presentation {\r
+ font-size: 300%;\r
+ height: 80%;\r
+}\r
+\r
+div.presen_menu {\r
+ text-align: right;\r
+ margin: 0px;\r
+ font-size: 10px;\r
+}\r
+END_OF_CSS\r
+}\r
+\r
+#===============================================================================\r
+# JavaScript¤Îʸ»úÎó¤Ë¥¨¥¹¥±¡¼¥×¤·¤Þ¤¹¡£\r
+#===============================================================================\r
+sub escapeJavaScript {\r
+ my $value = shift;\r
+ $value =~ s/\n/\\n/g;\r
+ $value =~ s/'/\\'/g;\r
+ return $value;\r
+}\r
+\r
+#===============================================================================\r
+# ¥á¥Ë¥å¡¼¤ò͸ú¤Ë¤·¤Þ¤¹¡£\r
+#===============================================================================\r
+sub hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $pagename = $wiki->get_CGI()->param("page");\r
+ \r
+ $wiki->add_menu("¥×¥ì¥¼¥ó¥Æ¡¼¥·¥ç¥ó",$wiki->config('script_name').\r
+ "?action=PRESEN&page=".&Util::url_encode($pagename));\r
+}\r
+\r
+1;\r
--- /dev/null
+################################################################################\r
+#\r
+# ¥¿¥¹¥¯¤Î¿ÊĽÅÙ¤òËÀ¥°¥é¥Õ¤Çɽ¼¨¤·¤Þ¤¹¡£\r
+#\r
+################################################################################\r
+package plugin::progress::Install;\r
+\r
+sub install {\r
+ my $wiki = shift;\r
+ $wiki->add_inline_plugin("progress","plugin::progress::Progress","HTML");\r
+}\r
+\r
+1;\r
--- /dev/null
+################################################################################\r
+#\r
+# ¥¿¥¹¥¯¤Î¿ÊĽÅÙ¤òËÀ¥°¥é¥Õ¤Çɽ¼¨¤·¤Þ¤¹¡£\r
+# <p>\r
+# ¿ÊĽÅÙ¤Ï0¡Á100¤Þ¤Ç¤Î¿ôÃͤǻØÄꤷ¤Þ¤¹¡£\r
+# 0°Ê²¼¤Î¿ôÃͤò»ØÄꤷ¤¿¾ì¹ç¤Ï0¡¢100°Ê¾å¤Î¿ôÃͤò»ØÄꤷ¤¿¾ì¹ç¤Ï100¤È¤ß¤Ê¤µ¤ì¤Þ¤¹¡£\r
+# </p>\r
+# <pre>\r
+# {{progress 50}}\r
+# </pre>\r
+#\r
+################################################################################\r
+package plugin::progress::Progress;\r
+use strict;\r
+\r
+sub new {\r
+ my $class = shift;\r
+ bless {}, $class;\r
+}\r
+\r
+sub inline {\r
+ my ($self, $wiki, $progress) = @_;\r
+ \r
+ $progress = 0 if $progress < 0;\r
+ $progress = 100 if $progress > 100;\r
+ my $file = int($progress / 10) * 10;\r
+ my $baseurl = $wiki->get_CGI()->url();\r
+ \r
+ return qq|\r
+ <img src="$baseurl/../@{[$wiki->config('plugin_dir')]}/plugin/progress/$file.png" \r
+ alt="$progress%" title="$progress%">\r
+ |;\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# description¤ËÁ°²ó¹¹¿·¤Îº¹Ê¬¤ò´Þ¤á¤¿RSS¤òÇÛ¿®¤·¤Þ¤¹¡£\r
+#\r
+############################################################\r
+package plugin::rssdiff::Install;\r
+use strict;\r
+\r
+sub install {\r
+ my $wiki = shift;\r
+ $wiki->add_menu("RSS",$wiki->config('script_name')."?action=RSS_DIFF",51,1);\r
+ \r
+ $wiki->add_handler("RSS_DIFF","plugin::rssdiff::RSSMaker10");\r
+ $wiki->add_hook("save_after" ,"plugin::rssdiff::RSSMaker10");\r
+ $wiki->add_hook("delete" ,"plugin::rssdiff::RSSMaker10");\r
+ $wiki->add_hook("initialize" ,"plugin::rssdiff::RSSMaker10");\r
+}\r
+\r
+1;\r
--- /dev/null
+###############################################################################\r
+#\r
+# RSS 1.0+Dublin Core¥×¥é¥°¥¤¥ó\r
+#\r
+###############################################################################\r
+package plugin::rssdiff::RSSMaker10;\r
+use strict;\r
+use plugin::core::Diff;\r
+use Jcode;\r
+#==============================================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#==============================================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#==============================================================================\r
+# ÅϤµ¤ì¤¿¥Ú¡¼¥¸¤ÎºÇ½ª¹¹¿·º¹Ê¬¤òplain text¤ÇÊÖ¤¹\r
+#==============================================================================\r
+sub get_diff {\r
+ my ($wiki, $page) = @_;\r
+ \r
+ my $diff = plugin::core::Diff->new();\r
+ my @list = $wiki->{storage}->get_backup_list($page);\r
+ my $generation = @list - 1;\r
+ my $text = $diff->get_diff_text($wiki, $page, $generation);\r
+ \r
+ return "<pre>$text</pre>";\r
+# if ($page_body =~ m/\!{1,3}\s*(.+)/mo) {\r
+# return $1;\r
+# }\r
+# return undef;\r
+}\r
+\r
+#==============================================================================\r
+# ÅϤµ¤ì¤¿¥Ú¡¼¥¸¤ÎÁ´¥¤¥á¡¼¥¸¤«¤éºÇ½é¤Î¸«½Ð¤·¤òplain text¤ÇÊÖ¤¹\r
+#==============================================================================\r
+sub get_headline {\r
+ my ($page_body) = @_;\r
+ \r
+ if ($page_body =~ m/\!{1,3}\s*(.+)/mo) {\r
+ return $1;\r
+ }\r
+ return undef;\r
+}\r
+\r
+#==============================================================================\r
+# ÅϤµ¤ì¤¿¥Ú¡¼¥¸¤ÎÁ´¥¤¥á¡¼¥¸¤«¤é¥«¥Æ¥´¥ê(Ê£¿ô)¤òplain text¤Î¥ê¥¹¥È¤ÇÊÖ¤¹\r
+#==============================================================================\r
+sub get_category {\r
+ my ($wiki,$page_body) = @_;\r
+ my @category;\r
+\r
+ while ($page_body =~ m/\{\{(category\s+.+?)\}\}/gmo) {\r
+ my $category = $wiki->parse_inline_plugin($1);\r
+ push(@category, @{$category->{args}}[0]);\r
+ }\r
+ return @category;\r
+}\r
+\r
+#==============================================================================\r
+# time()¤ÎÃͤòW3CDTF·Á¼°¤ÎÆüÉդˤ·¤ÆÊÖ¤¹\r
+#==============================================================================\r
+sub W3CDTF {\r
+ my ($time, $tz_str) = @_;\r
+\r
+# if ($time !~ m/\d+/o) {return error}\r
+# if ($tz_str !~ m/[+-]\d\d\:\d\d/o) {return error}\r
+ my ($sec, $min, $hour, $mday, $mon, $year) = (localtime($time))[0..5];\r
+ return sprintf('%04d-%02d-%02dT%02d:%02d:%02d%.6s',\r
+ $year+1900,$mon+1,$mday,$hour,$min,$sec,$tz_str);\r
+}\r
+\r
+#==============================================================================\r
+# ÅϤµ¤ì¤¿Ê¸»úÎó¤òXML¤Î¥¨¥ó¥Æ¥£¥Æ¥£¤ËÊÑ´¹¤·¤ÆÊÖ¤¹\r
+#==============================================================================\r
+sub escapeXML {\r
+ my ($str) = @_;\r
+ my %table = (\r
+ '&' => '&',\r
+ '<' => '<',\r
+ '>' => '>',\r
+ "'" => ''',\r
+ '"' => '"',\r
+ );\r
+ $str =~ s/([&<>\'\"])/$table{$1}/go;\r
+ return $str;\r
+}\r
+\r
+#==============================================================================\r
+# ¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é¥á¥½¥Ã¥É\r
+#==============================================================================\r
+sub do_action {\r
+ my ($self, $wiki) = @_;\r
+ my $file = $wiki->config('log_dir')."/rss10_diff.cache";\r
+ \r
+ # ¥¥ã¥Ã¥·¥å¥Õ¥¡¥¤¥ë¤¬Â¸ºß¤·¤Ê¤¤¾ì¹ç¤ÏºîÀ®\r
+ unless(-e $file){\r
+ &make_rss($wiki,$file);\r
+ }\r
+ \r
+ # RSS¤ò¥ì¥¹¥Ý¥ó¥¹\r
+ print "Content-Type: application/xml\n\n";\r
+ open(RSS,$file);\r
+ binmode(RSS);\r
+ while(<RSS>){\r
+ print $_;\r
+ }\r
+ close(RSS);\r
+ \r
+ exit();\r
+}\r
+\r
+#==============================================================================\r
+# ¥Õ¥Ã¥¯¥á¥½¥Ã¥É\r
+#==============================================================================\r
+sub hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $hook = shift;\r
+ \r
+ if($hook eq "initialize"){\r
+ $wiki->add_head_info("<link rel=\"alternate\" type=\"application/rss+xml\" title=\"RSS\" href=\"".$wiki->config('script_name')."?action=RSS\">");\r
+ } else {\r
+ &make_rss($wiki,$wiki->config('log_dir')."/rss10_diff.cache");\r
+ }\r
+}\r
+\r
+#==============================================================================\r
+# RSS¥Õ¥¡¥¤¥ë¤òºîÀ®¤¹¤ë\r
+#==============================================================================\r
+sub make_rss {\r
+ my $wiki = shift;\r
+ my $file = shift;\r
+ \r
+ # URI¤òºîÀ®\r
+ my $uri = $wiki->config('server_host');\r
+ if($uri eq ""){\r
+ $uri = $wiki->get_CGI()->url(-path_info => 1);\r
+ } else {\r
+ $uri = $uri . $wiki->get_CGI->url(-absolute => 1) . $wiki->get_CGI()->path_info();\r
+ }\r
+\r
+ my $items;\r
+ my $links;\r
+ my %ch;\r
+ \r
+ $ch{item_max} = 15;\r
+ $ch{encoding} = 'UTF-8';\r
+ $ch{lang} = 'ja';\r
+ $ch{TZ} = '+09:00';\r
+ $ch{title} = escapeXML($wiki->config('site_title'));\r
+ $ch{link} = escapeXML($uri . '?action=LIST');\r
+ $ch{desc} = escapeXML(get_headline($wiki, $wiki->config("frontpage")));\r
+ $ch{date} = W3CDTF(time(), $ch{TZ});\r
+ $ch{uri} = escapeXML($uri);\r
+\r
+ # ¹¹¿·¾ðÊó¤ò¼ý½¸\r
+ my @list = $wiki->get_page_list;\r
+ @list = sort {\r
+ my $mod1 = $wiki->get_last_modified2($a);\r
+ my $mod2 = $wiki->get_last_modified2($b);\r
+ return $mod2 <=> $mod1;\r
+ } @list;\r
+\r
+ foreach my $page (@list) {\r
+ # ¸ø³«¤µ¤ì¤Æ¤¤¤ë¥Ú¡¼¥¸¤Î¤ß\r
+ next if($wiki->get_page_level($page)!=0);\r
+ \r
+ my $page_body = $wiki->get_page($page);\r
+ my @subject = get_category($wiki,$wiki->get_page($page));\r
+ my $subjects;\r
+ my %item;\r
+ $item{title} = escapeXML($page);\r
+ $item{date} = W3CDTF($wiki->get_last_modified2($page), $ch{TZ});\r
+ $item{desc} = escapeXML(get_diff($wiki, $page));\r
+ $item{link} = escapeXML($uri . '?page=' . Util::url_encode($page));\r
+\r
+ if (defined($item{desc})) {\r
+ $item{desc} = <<"EOD";\r
+ <description>$item{desc}</description>\r
+EOD\r
+ $links = $links . <<"EOD";\r
+ <rdf:li rdf:resource="$item{link}" />\r
+EOD\r
+ }\r
+ foreach (@subject) {\r
+ $_ = escapeXML($_);\r
+ $subjects = $subjects . <<"EOD";\r
+ <dc:subject>$_</dc:subject>\r
+EOD\r
+ }\r
+ $items = $items . <<"EOD";\r
+ <item rdf:about="$item{link}">\r
+ <title>$item{title}</title>\r
+ <link>$item{link}</link>\r
+$item{desc}\r
+ <dc:date>$item{date}</dc:date>\r
+$subjects\r
+ </item>\r
+EOD\r
+ $ch{item_max}--;\r
+ if($ch{item_max} <= 0){ last; }\r
+ }\r
+ my $xml = <<"EOD";\r
+<?xml version="1.0" encoding="$ch{encoding}" standalone="yes"?>\r
+<rdf:RDF\r
+ xmlns="http://purl.org/rss/1.0/"\r
+ xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"\r
+ xmlns:dc="http://purl.org/dc/elements/1.1/"\r
+ xml:lang="$ch{lang}"\r
+>\r
+<channel rdf:about="$ch{link}">\r
+ <title>$ch{title}</title>\r
+ <link>$uri</link>\r
+ <description>$ch{desc}</description>\r
+ <dc:language>$ch{lang}</dc:language>\r
+ <dc:date>$ch{date}</dc:date>\r
+ <items>\r
+ <rdf:Seq>\r
+$links\r
+ </rdf:Seq>\r
+ </items>\r
+</channel>\r
+$items\r
+</rdf:RDF>\r
+EOD\r
+\r
+ # RSS¤ò¥Õ¥¡¥¤¥ë¤Ë½ñ¤½Ð¤¹\r
+ open(RSS,">$file") or die "RSS¥Õ¥¡¥¤¥ë¤ÎºîÀ®¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£";\r
+ binmode(RSS);\r
+ print RSS jcode($xml, 'euc')->utf8;\r
+ close(RSS);\r
+}\r
+\r
+1;\r
+\r
--- /dev/null
+############################################################\r
+#\r
+# Wiki¥Ú¡¼¥¸¤Î¸¡º÷µ¡Ç½¤òÄ󶡤·¤Þ¤¹¡£\r
+#\r
+############################################################\r
+package plugin::search2::Install;\r
+use strict;\r
+\r
+sub install {\r
+ my $wiki = shift;\r
+ $wiki->add_paragraph_plugin("search2","plugin::search2::SearchForm","HTML");\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+# \r
+# <p>¥Ú¡¼¥¸Ì¾¤ò¥¤¥ó¥¯¥ê¥á¥ó¥¿¥ë¸¡º÷¤¹¤ë¸¡º÷¥Õ¥©¡¼¥à¤òɽ¼¨¤·¤Þ¤¹¡£</p>\r
+# <pre>\r
+# {{search2}}\r
+# </pre>\r
+# <p>¥µ¥¤¥É¥Ð¡¼¤Ëɽ¼¨¤¹¤ë¾ì¹ç¤Ïv¥ª¥×¥·¥ç¥ó¤ò¤Ä¤±¤Æ¤¯¤À¤µ¤¤¡£</p>\r
+# <pre>\r
+# {{search2 v}}\r
+# </pre>\r
+# \r
+############################################################\r
+package plugin::search2::SearchForm;\r
+use strict;\r
+#===========================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#===========================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#===========================================================\r
+# ¸¡º÷¥Õ¥©¡¼¥à\r
+#===========================================================\r
+sub paragraph {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my @list = $wiki->get_page_list({-sort => 'last_modified',\r
+ -permit => 'show'});\r
+\r
+ my $buf = qq|\r
+<script language="JavaScript">\r
+function incremental_search(obj){\r
+ var text = obj.value;\r
+ var div = document.getElementById('pages');\r
+ var children = div.getElementsByTagName('li');\r
+ if(text==''){\r
+ for(i=0;i<children.length;i++){\r
+ children[i].style.display = 'none';\r
+ }\r
+ return;\r
+ }\r
+ for(i=0;i<children.length;i++){\r
+ var page = children[i].getElementsByTagName('a')[0].innerHTML;\r
+ if(page.indexOf(text) >= 0){\r
+ children[i].style.display = '';\r
+ } else {\r
+ children[i].style.display = 'none';\r
+ }\r
+ }\r
+}\r
+</script>\r
+<input type="TEXT" name="word" size="20" onkeyup="incremental_search(this)" autocomplete="off">\r
+|;\r
+ \r
+ $buf .= "<ul id=\"pages\">";\r
+ foreach my $page (@list){\r
+ $buf .= "<li style=\"display:none;\">".\r
+ "<a href=\"".$wiki->config('script_name').\r
+ "?page=".Util::url_encode($page)."\">".\r
+ Util::escapeHTML($page)."</a></li>";\r
+ }\r
+ $buf .= "</ul>";\r
+\r
+ return $buf;\r
+}\r
+\r
+1;\r
--- /dev/null
+package Image::Thumbnail;\r
+\r
+use Carp;\r
+use strict;\r
+use warnings;\r
+our $VERSION = '0.62'; # Updated Makefile.PL thanks to Sebastian\r
+\r
+=head1 NAME\r
+\r
+Image::Thumbnail - Simple thumbnails with GD/ImageMagick/Imager\r
+\r
+=head1 SYNOPSIS\r
+\r
+ use Image::Thumbnail 0.6;\r
+\r
+ # Create a thumbnail from 'test.jpg' as 'test_t.jpg'\r
+ # using ImageMagick, Imager, or GD.\r
+ my $t = new Image::Thumbnail(\r
+ size => 55,\r
+ create => 1,\r
+ input => 'test.jpg',\r
+ outputpath => 'test_t.jpg',\r
+ );\r
+\r
+ my $t = new Image::Thumbnail(\r
+ size => "55x75",\r
+ create => 1,\r
+ module => "Image::Magick",\r
+ input => $imageObject,\r
+ outputpath => 'test_t.jpg',\r
+ );\r
+\r
+ # Create a thumbnail from 'test.jpg' as 'test_t.jpg'\r
+ # using GD.\r
+ my $t = new Image::Thumbnail(\r
+ module => 'GD',\r
+ size => 55,\r
+ create => 1,\r
+ input => 'test.jpg',\r
+ outputpath => 'test_t.jpg',\r
+ );\r
+\r
+ # Create a thumbnail from 'test.jpg' as 'test_t.jpg'\r
+ # using Imager.\r
+ my $t = new Image::Thumbnail(\r
+ module => 'Imager',\r
+ size => 55,\r
+ create => 1,\r
+ input => 'test.jpg',\r
+ outputpath => 'test_t.jpg',\r
+ );\r
+\r
+ # Create a thumbnail as 'test_t.jpg' from an ImageMagick object\r
+ # using ImageMagick, or GD.\r
+ my $t = new Image::Thumbnail(\r
+ size => "55x25",\r
+ create => 1,\r
+ input => $my_image_magick_object,\r
+ outputpath => 'test_t.jpg',\r
+ );\r
+\r
+ # Create four more of ever-larger sizes\r
+ for (1..4){\r
+ $t->{size} = 55+(10*$_);\r
+ $t->create;\r
+ }\r
+\r
+ exit;\r
+\r
+=head1 DESCRIPTION\r
+\r
+This module was created to answer the FAQ, 'How do I simply create a\r
+thumbnail with pearl?' (I<sic>). It allows you to easily make thumbnail images\r
+from files, objects or 'blobs', using either the ImageMagick, Imager or\r
+GD libraries.\r
+\r
+Thumbnails created can either be saved as image files or accessed as objects\r
+via the C<object> field: see L<create>.\r
+\r
+=head1 PREREQUISITES\r
+\r
+One of C<Image::Magick>, C<Imager>, or C<GD>.\r
+\r
+=head1 CONSTRUCTOR new\r
+\r
+Parameters are supplied as a hash or hash-like list of name/value pairs:\r
+See the L</SYNOPSIS>.\r
+\r
+=head2 REQUIRED PARAMETERS\r
+\r
+=over 4\r
+\r
+=item size\r
+\r
+The size you with the longest side of the thumbnail to be. This may\r
+be provided as a single integer, or as an ImageMagick-style 'geometry'\r
+such as C<100x120>.\r
+\r
+=item input\r
+\r
+You must the C<input> parameter as one of:\r
+\r
+=over 4\r
+\r
+=item Input file path\r
+\r
+A scalar that is an absolute path to an image to use as the source file.\r
+\r
+=item Object\r
+\r
+An object-reference created by your chosen package.\r
+Naturally you can't supply this field if you haven't\r
+specified a C<module> field (see above).\r
+\r
+=item Blob\r
+\r
+A reference to a scalar that is the raw binary image data, perhaps drawn from\r
+a database BLOB column, perhaps from a file.\r
+\r
+=back\r
+\r
+The formerly required input fields should be considered depricated,\r
+and although they will be kept in the API for this release, they will eventually\r
+be removed.\r
+\r
+=back\r
+\r
+=head2 OPTIONAL PARAMETERS\r
+\r
+=over 4\r
+\r
+=item module ( GD | ImageMagick | Imager )\r
+\r
+If you wish to use a specific module, place its name here.\r
+You must have the module you require already installed!\r
+\r
+Supplying no name will allow ImageMagick, then Imager to be tried before GD.\r
+\r
+=item create\r
+\r
+Put any value in this field if you wish the constructor to\r
+call the C<create> method automatically before returning.\r
+\r
+=item inputtype, outputtype\r
+\r
+If you are using C<GD>, you can explicitly set the input\r
+and output formats for the image file, provided you use\r
+a string that can be evaluated to a C<GD>-supported image\r
+format (see L<GD>).\r
+\r
+Default behaviour is to attempt to ascertin the file type\r
+and to create the thumbnail in the same format. If the\r
+type cannot be defined (you are using C<GD>, have supplied\r
+the C<object> field and not the C<outputtype> field) then\r
+the output file format defaults to C<jpeg>.\r
+\r
+=item depth\r
+\r
+Sets colour depth in ImageMagick - GD only supports 8-bit.\r
+\r
+The ImageMagick manpage (see L<http://www.imagemagick.org/www/ImageMagick.html#opti>).\r
+says:\r
+\r
+=item density\r
+\r
+ImageMagick only: sets the pixel density.\r
+Must be a valid ImageMagick 'geometry' value (that is,\r
+two numbers giving the I<x> and I<y> dimensions, delimited\r
+by a lower-case I<x>.\r
+Default value is C<96x96>.\r
+\r
+=item quality\r
+\r
+ImageMagick/Imager only: an integer from 1 to 100 to specify\r
+the thumbnail quality. Defaults to 50.\r
+\r
+=item attr\r
+\r
+If you are using ImageMagick, this field should contain\r
+a hash of ImageMagick attributes to pass to the ImageMagick\r
+C<Set> command when the thumbnail is created. Any errors these\r
+may generate are not yet caught.\r
+\r
+=item CHAT\r
+\r
+Put any value in this field for real-time process info.\r
+\r
+=cut\r
+\r
+# If you are using GD, this field should contain a hash where\r
+# keys are GD method names, and values are the arrays of\r
+# paramters for those methods (naturally excluding the object\r
+# reference).\r
+\r
+# =over 4\r
+\r
+# This is the number of bits in a color sample within\r
+#a pixel. The only acceptable values are 8 or 16. Use this\r
+#option to specify the depth of raw images whose depth is\r
+#unknown such as GRAY, RGB, or CMYK, or to change the\r
+#depth of any image after it has been read.\r
+\r
+=head2 PARAMETERS SET\r
+\r
+=over 4\r
+\r
+=item x,y\r
+\r
+The dimension of the thumbnail produced.\r
+\r
+=back\r
+\r
+=head2 ERRORS\r
+\r
+As of version 0.4, any errors are stored in the fields\r
+C<error>, warnings in C<warning>.\r
+\r
+Any errors will be printed to C<STDOUT>. If they completely\r
+prevent processing, they will be fatal (C<croak>ed). If\r
+partial processing has taken place by the explicit or implicit\r
+calling of the C<create> method, then the field of the same\r
+name will have value.\r
+\r
+Depending on how far processing has proceded, other fields may have useful values:\r
+the C<module> field will contain the name of the module used;\r
+the C<object> field may contain an object of the module used;\r
+the C<thumb> field may contain a thumbnail image.\r
+\r
+=cut\r
+\r
+sub new { my $class = shift;\r
+ unless (defined $class) {\r
+ carp "Usage: ".__PACKAGE__."->new( {key=>value} )\n";\r
+ return undef;\r
+ }\r
+ my %args;\r
+\r
+ # Take parameters and place in object slots/set as instance variables\r
+ if (ref $_[0] eq 'HASH'){ %args = %{$_[0]} }\r
+ elsif (not ref $_[0]){ %args = @_ }\r
+ else {\r
+ carp "Usage: $class->new( { key=>values, } )";\r
+ return undef;\r
+ }\r
+ my $self = bless {}, $class;\r
+\r
+ # Fields that have default values which can be over-written:\r
+ $self->{density} = '96x96';\r
+ $self->{quality} = 50;\r
+\r
+ # Set/overwrite default fields with user's values:\r
+ foreach (keys %args) {\r
+ $self->{$_} = $args{$_};\r
+ }\r
+\r
+ # Fill slots the user may have filled but should not:\r
+ $self->{img} = '';\r
+ $self->{thumb} = '';\r
+\r
+ # Croak on user errors\r
+ if ($self->{density} !~ /^\d+x\d+$/){\r
+ croak "The 'density' param expects a geometry argument, such as 128x128"\r
+ }\r
+ croak "No 'size' paramter" if not $self->{size};\r
+\r
+ my $t = grep( $self->{$_}, qw[object inputpath input]);\r
+\r
+ if ($self->{input}){\r
+ if (ref $self->{input}){\r
+ if (ref $self->{input} eq 'SCALAR'){\r
+ $self->{inputblob} = $self->{input};\r
+ } else {\r
+ $self->{object} = $self->{input};\r
+ }\r
+ }\r
+ else {\r
+ $self->{inputpath} = $self->{input}\r
+ }\r
+ }\r
+\r
+ croak "You cannot supply both an 'object' field and a 'inputpath' field" if $t>1;\r
+ croak "You must supply either an 'object' field or a 'inputpath' field" if $t==0;\r
+\r
+ # Try not to limit Image::Magick...\r
+ if ($self->{inputpath}\r
+ and $self->{module} and $self->{module} =~ /^(GD|GD::Image)$/\r
+ and not -e $self->{inputpath}){\r
+ croak "The supplied inputpath '$self->{inputpath}' does not exist:\n$!"\r
+ }\r
+\r
+ # Correct common user errors\r
+ if ($self->{module} and $self->{module} =~ /^ImageMagick$/i){\r
+ $self->{module} = 'Image::Magick';\r
+ warn "Corrected parameter 'module' from 'ImaegMagick' to 'Image::Magick'" if $self->{CHAT};\r
+ }\r
+\r
+ # Sort out the Thumbnail module\r
+ if (not $self->set_mod){\r
+ $self->{error} = "No module found with which to make a thumbnail";\r
+ warn $self->{error};\r
+ return undef;\r
+ }\r
+\r
+ # Call 'create' if requested\r
+ $self->create if $self->{create};\r
+ return $self;\r
+}\r
+\r
+\r
+#\r
+# Sometimes self-recursive\r
+#\r
+sub set_mod { my ($self,$try) = (shift,shift);\r
+ warn "# Set module...".(defined $try? $try : "(not trying)") if $self->{CHAT};\r
+ if (not $self->{module} and $self->{object}){\r
+ $self->{module} = ref $self->{object};\r
+ warn "Set module to match the supplied object: $self->{module}" if $self->{CHAT};\r
+ }\r
+ elsif ($try){\r
+ $self->{module} = $try;\r
+ }\r
+ elsif (not $self->{module} and not $try){\r
+ for ('Image::Magick','Imager', 'GD'){\r
+ if (not $self->set_mod($_)){\r
+ return undef;\r
+ } else {\r
+ last;\r
+ }\r
+ }\r
+ return $self->{module};\r
+ }\r
+\r
+ if ($self->{module} =~ /^GD/){\r
+ warn "# Requiring GD" if $self->{CHAT};\r
+ # eval ('use GD;');\r
+ require GD;\r
+ import GD;\r
+ if ($@){\r
+ $self->{error} = "Error requring GD:\n".$@;\r
+ return undef;\r
+ }\r
+ warn "# GD OK" if $self->{CHAT};\r
+ }\r
+ elsif ($self->{module} eq 'Image::Magick'){\r
+ warn "# Requiring Image::Magick" if $self->{CHAT};\r
+ # eval ('use Image::Magick');\r
+ require Image::Magick;\r
+ import Image::Magick;\r
+ if ($@){\r
+ $self->{error} = "Error requring Image::Magick:\n".$@;\r
+ return undef;\r
+ }\r
+ warn "# Image::Magick OK" if $self->{CHAT};\r
+ }\r
+ elsif ($self->{module} eq 'Imager'){\r
+ warn "# Requiring Imager" if $self->{CHAT};\r
+ # eval ('use Imager');\r
+ require Imager;\r
+ import Imager;\r
+ if ($@){\r
+ $self->{error} = "Error requring Imager:\n".$@;\r
+ return undef;\r
+ }\r
+ warn "# Imager OK" if $self->{CHAT};\r
+ }\r
+ else {\r
+ $self->{error} = "Unsupported module $self->{module}" if $self->{CHAT};\r
+ return undef;\r
+ }\r
+\r
+ return $self->{module};\r
+}\r
+\r
+\r
+=head1 METHOD create\r
+\r
+Creates a thumbnail using the supplied object.\r
+This method is called automatically if you construct with the\r
+C<create> field flagged.\r
+\r
+Sets the following fields:\r
+\r
+=over 4\r
+\r
+=item module\r
+\r
+Will contain the name of the module used (set by this module\r
+if not by the user);\r
+\r
+=item object\r
+\r
+Will contain an instance of the module used;\r
+\r
+=item thumb\r
+\r
+Will contain the thumbnail image.\r
+\r
+=back\r
+\r
+Returns c<undef> on failure.\r
+\r
+=cut\r
+\r
+sub create { my $self = shift;\r
+ my $r;\r
+ warn "# Creating thumbnail" if $self->{CHAT};\r
+ if ($self->{module} eq 'Image::Magick'){\r
+ $r = $self->create_imagemagick;\r
+ } elsif ($self->{module} eq 'Imager'){\r
+ $r = $self->create_imager;\r
+ } elsif ($self->{module} =~ /^(GD|GD::Image)$/){\r
+ $r = $self->create_gd;\r
+ } else {\r
+ $self->{error} = "User supplied unknown module ".$self->{module};\r
+ warn $self->{error};\r
+ $r = undef;\r
+ }\r
+ return $r;\r
+}\r
+\r
+\r
+#\r
+# METHOD create_imagemagick\r
+#\r
+sub create_imagemagick { my $self=shift;\r
+ warn "#...with Image::Magick" if $self->{CHAT};\r
+ if (not $self->{object} or ref $self->{object} ne 'Image::Magick'){\r
+ warn "#...from file $self->{inputpath}" if $self->{CHAT};\r
+ $self->{object} = Image::Magick->new;\r
+ if ($self->{inputblob}) {\r
+ $self->{object}->BlobToImage( ${$self->{input}} );\r
+ }\r
+ elsif ($self->{inputpath}){\r
+ $self->{error} = $self->{object}->Read($self->{inputpath});\r
+ if ($self->{error}){\r
+ $self->{error} = $self->{error} if $self->{CHAT};\r
+ return undef;\r
+ }\r
+ }\r
+ else {\r
+ $self->{error} = "No input of any kind!\n";\r
+ return undef;\r
+ }\r
+ }\r
+ return undef unless $self->imagemagick_thumb;\r
+\r
+ if ($self->{outputpath}){\r
+ warn "# Writing to $self->{outputpath}" if $self->{CHAT};\r
+ $_ = $self->{object}->Write($self->{outputpath});\r
+ $self->set_errors($_);\r
+ }\r
+ warn "# Done Image::Magick: ",$self->{x}," ",$self->{y} if $self->{CHAT};\r
+ return 1;\r
+}\r
+\r
+#\r
+# METHOD create_gd\r
+#\r
+sub create_gd { my $self=shift;\r
+ local (*IN, *OUT);\r
+ warn "# ... with GD" if $self->{CHAT};\r
+\r
+ if ($self->{inputblob}){\r
+ # Ascertain image type:\r
+ $self->get_img_type;\r
+ if (not $self->{inputtype}){\r
+ $self->{error} = "Could not ascertain image type for BLOB";\r
+ return undef;\r
+ }\r
+ # Make the object\r
+ $self->{object} = eval ( 'GD::Image->newFrom'.ucfirst($self->{inputtype}).'Data(${$self->{inputblob}})');\r
+ if ($@){\r
+ $self->{error} = "Error in creating GD object from BLOB: $@";\r
+ return undef;\r
+ }\r
+ }\r
+\r
+ # Load the source image\r
+ elsif ($self->{inputpath}){\r
+ if (not open IN, $self->{inputpath}){\r
+ $self->{error} = "Could not open source ".$self->{inputpath};\r
+ return undef;\r
+ }\r
+ binmode IN;\r
+ # Ascertain image type:\r
+ $self->get_img_type(*IN);\r
+ if (not $self->{inputtype}){\r
+ close IN;\r
+ $self->{error} = "Could not ascertain image type for $self->{inputpath}";\r
+ return undef;\r
+ }\r
+ # Make the object\r
+ $self->{object} = eval ( 'GD::Image->newFrom'.ucfirst($self->{inputtype}).'(*IN)');\r
+ close IN;\r
+ if ($@){\r
+ $self->{error} = "Error in creating GD object from file: $@";\r
+ return undef;\r
+ }\r
+ }\r
+\r
+ # Set output type to input type if not defined already\r
+ $self->{outputtype} = $self->{inputtype} ;\r
+ if (not $self->{outputtype}){\r
+ $self->{outputtype} = $self->{inputtype} || 'png'\r
+ }\r
+\r
+ # Call attr: eg. $im->fill(50,50,$red);\r
+# if ($self->{attr}){\r
+# foreach my $key (keys %{$self->{attr}}){\r
+# eval ($self->{object}."->".$key."(@{$self->{attr}->{$key}})");\r
+# # Catch errors?\r
+# }\r
+# }\r
+\r
+ # Make thumbnail\r
+ ($self->{thumb},$self->{x},$self->{y}) = $self->gd_thumb;\r
+\r
+ if ($self->{outputpath}){\r
+ # Save your thumbnail\r
+ if (not open OUT, ">".$self->{outputpath}){\r
+ $self->{error} = " Could not save thumbnail image to $self->{outputpath}:\n$!";\r
+ return undef;\r
+ }\r
+ binmode OUT;\r
+ warn "# Saving as $self->{outputpath}, type $self->{outputtype}" if $self->{CHAT};\r
+ print OUT eval ( '$self->{thumb}->'.lc $self->{outputtype} );\r
+ if ($@){\r
+ $self->{error} = "Error in outputting: $@";\r
+ return undef;\r
+ }\r
+ close OUT;\r
+ }\r
+ warn "# Done GD; ",$self->{x}," ",$self->{y} if $self->{CHAT};\r
+ return 1;\r
+}\r
+\r
+#\r
+# METHOD create_imager\r
+#\r
+sub create_imager { my $self=shift;\r
+ warn "# ...with Imager" if $self->{CHAT};\r
+ if (not $self->{object} or ref $self->{object} ne 'Imager'){\r
+ warn "...from file $self->{inputpath}" if $self->{CHAT};\r
+ $self->{object} = Imager->new;\r
+ eval {$self->{object}->read(file => $self->{inputpath})};\r
+\r
+ if ($@){\r
+ $self->{error} = $@ if $self->{CHAT};\r
+ return undef;\r
+ }\r
+ }\r
+ return undef unless $self->imager_thumb;\r
+\r
+ if ($self->{outputpath}){\r
+ warn "Writing to $self->{outputpath}" if $self->{CHAT};\r
+ eval {$self->{object}->write(\r
+ file => $self->{outputpath}, jpegquality=>($self->{quality}||'50')\r
+ )};\r
+ if ($@) {\r
+ $self->{error} = $@ if $self->{CHAT};\r
+ return undef;\r
+ };\r
+ }\r
+ warn "# Done Imager: ",$self->{x}," ",$self->{y} if $self->{CHAT};\r
+ return 1;\r
+}\r
+\r
+\r
+#\r
+# Sets our inputtype field to the file type (jpeg, etc)\r
+# Includes unsupported image types.\r
+#\r
+sub get_img_type { my ($self,$handle)=(shift,shift);\r
+ my $id;\r
+ my $header; # The first 256 of image\r
+ warn "# Ascertaining file type" if $self->{CHAT};\r
+\r
+ if ($self->{inputblob}){\r
+ $header = substr(\r
+ ${$self->{inputblob}},\r
+ 0,\r
+ length($self->{inputblob})>=255? 255 : length($self->{inputblob})\r
+ );\r
+ } else {\r
+ binmode $handle;\r
+ read IN, $header, 256;\r
+ seek IN,0,0;\r
+ }\r
+\r
+ if (not defined $header){\r
+ $self->{error} = "No image header\n";\r
+ return undef;\r
+ }\r
+\r
+ my %type_map = ( # Map lifted straight from Image::Size (C) Randy J. Ray, 2002\r
+ '^GIF8[7,9]a' => "gif",\r
+ "^\xFF\xD8" => "jpeg",\r
+ "^\x89PNG\x0d\x0a\x1a\x0a" => "png",\r
+ "^P[1-7]" => "ppm", # also XVpics\r
+ '\#define\s+\S+\s+\d+' => "xbm",\r
+ '\/\* XPM \*\/' => "xpm",\r
+ '^MM\x00\x2a' => "tiff",\r
+ '^II\x2a\x00' => "tiff",\r
+ '^BM' => "bmp",\r
+ '^8BPS' => "psd",\r
+ '^PCD_OPA' => "pcd",\r
+ '^FWS' => "swf",\r
+ "^\x8aMNG\x0d\x0a\x1a\x0a" => "mng",\r
+ );\r
+ grep {$id=$type_map{$_} if $header=~/$_/ } keys %type_map;\r
+\r
+ $self->{inputtype} = $id;\r
+ warn "# File is $id\n" if $self->{CHAT};\r
+ return $id;\r
+}\r
+\r
+#\r
+# Thumbnail generation\r
+#\r
+sub gd_thumb { my $self=shift;\r
+ if (not $self->{object}){\r
+ $self->{error} = "No 'object' supplied to make thumbnail from";\r
+ return undef;\r
+ }\r
+ ($self->{ox}, $self->{oy}) = $self->{object}->getBounds();\r
+ $self->_size;\r
+ $self->{x} = int( $self->{ox}/$self->{ratio} );\r
+ $self->{y} = int( $self->{oy}/$self->{ratio} );\r
+ my $thumb = GD::Image->new($self->{x}, $self->{y});\r
+ $thumb->copyResized($self->{object},0,0,0,0,\r
+ $self->{x}, $self->{y}, $self->{ox}, $self->{oy});\r
+ return $thumb, sprintf("%.0f",$self->{x}), sprintf("%.0f",$self->{y});\r
+}\r
+\r
+\r
+sub imagemagick_thumb { my $self=shift;\r
+ if (not $self->{object}){\r
+ $self->{error} = "No 'object' supplied to make thumbnail from";\r
+ return undef;\r
+ }\r
+ ($self->{ox}, $self->{oy}) = $self->{object}->Get('width','height');\r
+ if (not $self->{ox} or not $self->{oy}){\r
+ $self->{error} = __PACKAGE__." Could not get width/height from image";\r
+ return undef\r
+ }\r
+ $self->_size;\r
+ $self->{x} = int( $self->{ox}/$self->{ratio} );\r
+ $self->{y} = int( $self->{oy}/$self->{ratio} );\r
+\r
+ $self->{object}->Set(type=>'Optimize');\r
+ #$self->{object}->Resize(width=>$self->{x}, height=>$self->{y});\r
+ $self->{object}->Thumbnail(width=>$self->{x}, height=>$self->{y});\r
+\r
+ if ($self->{depth}){\r
+ $self->{object}->Set('depth'=>$self->{depth});\r
+ }\r
+ $self->{object}->Comment("http://LeeGoddard.net ".__PACKAGE__." $VERSION");\r
+ $self->{object}->Set('density',$self->{density}||'96x96');\r
+ $self->{object}->Set(quality=>$self->{quality}||'50');\r
+ $self->{object}->Set(type=>'Optimize');\r
+ if ($self->{attr}){\r
+ die "attr must be a hash reference" if ref $self->{attr} ne 'HASH';\r
+ foreach my $key (keys %{$self->{attr}}){\r
+ $self->{object}->Set($key=>$self->{attr}->{$key});\r
+ # Catch errors?\r
+ }\r
+ }\r
+ return 1; # Thanks, Himmy :)\r
+}\r
+\r
+\r
+sub imager_thumb { my $self=shift;\r
+ if (not $self->{object}){\r
+ $self->{error} = "No 'object' supplied to make thumbnail from";\r
+ return undef;\r
+ }\r
+ $self->{ox} = $self->{object}->getwidth;\r
+ $self->{oy} = $self->{object}->getheight;\r
+\r
+ if (not $self->{ox} or not $self->{oy}){\r
+ $self->{error} = __PACKAGE__." Could not get width/height from image";\r
+ return undef\r
+ }\r
+\r
+ $self->_size;\r
+ $self->{x} = int( $self->{ox}/$self->{ratio} );\r
+ $self->{y} = int( $self->{oy}/$self->{ratio} );\r
+\r
+ $self->{object} = $self->{object}->scale(xpixels=>$self->{x},ypixels=>$self->{y},type=>'min');\r
+\r
+ return 1;\r
+}\r
+\r
+\r
+#\r
+# For PerlMagick: Interpret $s for errors and put in warnings/errors field\r
+#\r
+sub set_errors { my ($self,$s) = (shift,shift);\r
+ if ($self->{module} eq 'Image::Magick'){\r
+ if ($s =~ /(\d+)/){\r
+ if ($1 <400){\r
+ $self->{warning} = $s;\r
+ } else {\r
+ $self->{error} = $s;\r
+ }\r
+ }\r
+ }\r
+}\r
+\r
+sub _size { my $self = shift;\r
+ my ($maxx, $maxy);\r
+ if (($maxx, $maxy) = $self->{size} =~ /^(\d+)x(\d+)$/i){\r
+ $self->{size} = ($self->{ox}>$self->{oy})? $maxx : $maxy;\r
+ } else {\r
+ $maxx = $maxy = $self->{size};\r
+ }\r
+ $self->{ratio} = ($self->{ox} > $self->{oy}) ? ($self->{ox}/$maxx) : ($self->{oy}/$maxy);\r
+}\r
+\r
+1; # Satisfy 'require'\r
+\r
+__END__\r
+\r
+\r
+=head1 EXPORT\r
+\r
+None.\r
+\r
+=head1 CHANGES\r
+\r
+Please see the file F<CHANGES> in the distribution tar.\r
+\r
+=head1 SEE ALSO\r
+\r
+L<perl>,\r
+L<Image::Epeg>,\r
+L<GD>,\r
+L<Imager>,\r
+L<Image::Magick>,\r
+L<Image::Magick::Thumbnail>,\r
+L<Image::GD::Thumbnail>.\r
+\r
+=head1 AUTHOR\r
+\r
+Lee Goddard <cpan-at-leegoddard-dot-net>\r
+\r
+Thanks to Sam Tregar, Himmy and Chris Laco.\r
+\r
+=head1 COPYRIGT\r
+\r
+Copyright (C) Lee Godadrd 2001-2005. All rights reserved.\r
+Supplied under the same terms as Perl itself.\r
+\r
+=cut\r
+\r
+End of File\r
--- /dev/null
+###############################################################################\r
+#\r
+# ´Ä¶ÀßÄê¤ò¹Ô¤¦¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é¤Î¥Ù¡¼¥¹¥¯¥é¥¹\r
+#\r
+# !!³µÍ×\r
+# ¤³¤Î¥â¥¸¥å¡¼¥ë¤Ï´ö¤Ä¤«¤Î¥á¥ó¥ÐÊÑ¿ô¤Ë¤è¤ê¥Ç¡¼¥¿¹½Â¤¤òÄêµÁ¤·HTML::Template¤Ë¤è\r
+# ¤ë¥Õ¥©¡¼¥à¤òºîÀ®¤¹¤ë¤À¤±¤Ç¡¢´Ä¶ÀßÄê¤Î¤è¤¦¤ÊÀßÄêÃͤÎÊݸ¤¬¤Ç¤¤ëadmin_menu¤Î\r
+# ¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é¤¬ºî¤ì¤ë¥Ù¡¼¥¹¥¯¥é¥¹¤Ç¤¹¡£\r
+# !!Îã\r
+# !plugin/hoge/Admin.pm\r
+# package plugin::hoge::Admin;\r
+# use Wiki::AdminTemplate;\r
+# use vars qw(@ISA);\r
+# @ISA = qw(Wiki::AdminTemplate);\r
+# sub new {\r
+# my $class = shift;\r
+# my $self = new Wiki::AdminTemplate('hoge');\r
+# $self->{default_value} = {\r
+# name => "hoge",\r
+# value => "10",\r
+# kind => "alpha",\r
+# };\r
+# $self->{config_template} = {\r
+# name => '^\w+$',\r
+# value => '^\d*$',\r
+# kind => ["alpha", "beta"],\r
+# };\r
+# return bless $self,$class;\r
+# }\r
+# 1;\r
+# !plugin::hoge::Install.pm\r
+# package plugin::hoge::Install;\r
+# sub install {\r
+# my $wiki = shift;\r
+# $wiki->add_admin_menu(\r
+# "hoge",\r
+# $wiki->config('script_name')."?action=ADMINHOGE",\r
+# 200,\r
+# "AdminTemplateTest",\r
+# );\r
+# $wiki->add_admin_handler('ADMINHOGE',"plugin::hoge::Admin");\r
+# }\r
+# 1;\r
+# !tmpl/hoge.tmpl\r
+# <h2>hoge¥×¥é¥°¥¤¥ó¥µ¥ó¥×¥ëÀßÄê</h2>\r
+# <h3>̾Á°</h3>\r
+# <p><input type="text" name="name" size="40"\r
+# value="<!--TMPL_VAR NAME="NAME" ESCAPE="HTML"-->"></p>\r
+# <h3>ïçÃÍ</h3>\r
+# <p><input type="text" name="value" size="4"\r
+# value="<!--TMPL_VAR NAME="VALUE" ESCAPE="HTML"-->"></p>\r
+# <h3>ʬÎà</h3>\r
+# <p>\r
+# <input type="radio" name="kind" value="alpha" id="kind_alpha"\r
+# <!--TMPL_IF NAME="TYPE_ADMIN"-->checked<!--/TMPL_IF-->>\r
+# <label for="kind_alpha">alpha</label>\r
+# <input type="radio" name="kind" value="beta" id="kind_beta"\r
+# <!--TMPL_IF NAME="TYPE_USER"-->checked<!--/TMPL_IF-->>\r
+# <label for="kind_beta">beta</label>\r
+# </p>\r
+# <p>\r
+# <input type="submit" name="SAVE" value="Êݸ">\r
+# <input type="reset" value="¥ê¥»¥Ã¥È">\r
+# </p>\r
+# \r
+# !!¾ÜºÙ\r
+# ¤³¤Î¥¯¥é¥¹¤ò·Ñ¾µ¤·¡¢¥³¥ó¥¹¥È¥é¥¯¥¿¤Ç´ö¤Ä¤«¤Î¥á¥ó¥ÐÊÑ¿ô¤ò½é´ü²½¤·¤Þ¤¹¡£\r
+# ½é´ü²½¤¬É¬Íפʥá¥ó¥ÐÊÑ¿ô¤ÏHTML::Template¥Õ¥¡¥¤¥ë¤äÃͤòÊݸ¤¹¤ëÀßÄê¥Õ¥¡¥¤¥ë̾\r
+# ¤Î¤Û¤«¡¢¥Ç¡¼¥¿¹½Â¤¤òɽ¤¹¥Ï¥Ã¥·¥åÊÑ¿ô¡¢½é´üÃͤòÊÝ»ý¤¹¤ë¥Ï¥Ã¥·¥åÊÑ¿ôÅù¤¬¤¢¤ê¤Þ\r
+# ¤¹¡£\r
+# \r
+# ¥Ù¡¼¥¹¥¯¥é¥¹¤Î¥á¥½¥Ã¥É¤Ï¤½¤ì¤é¤Î¥á¥ó¥ÐÊÑ¿ô¤Ë¤·¤¿¤¬¤Ã¤ÆÆ°ºî¤·¡¢admin_menuÍѤÎ\r
+# ¥ª¥Ö¥¸¥§¥¯¥È¤È¤·¤Æ»ÈÍѤǤ¤Þ¤¹¡£\r
+# \r
+# ¶ñÂÎŪ¤Ë¤Ï¡¢\r
+# * ÀßÄê¥Õ¥¡¥¤¥ëÆɤ߹þ¤ß¤ÈHTML::TemplateÊÑ¿ô¤Ø¤ÎÈ¿±Ç\r
+# * ÀßÄê¥Õ¥¡¥¤¥ë¤Þ¤¿¤ÏPOST¤µ¤ì¤¿¥Ç¡¼¥¿¤ÎÀµÅöÀ¥Á¥§¥Ã¥¯¤ÈÀßÄê¥Õ¥¡¥¤¥ë¤Ø¤ÎÈ¿±Ç\r
+# ¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£\r
+# ¤³¤Î¤¿¤á¡¢¤³¤Î¥¯¥é¥¹¤ò·Ñ¾µ¤·¡¢¥á¥ó¥ÐÊÑ¿ô¤Î½é´ü²½¤ò¹Ô¤Ê¤¦¥³¥ó¥¹¥È¥é¥¯¥¿¤È\r
+# HTML::TemplateÍѤΥե¡¥¤¥ë¤òºî¤ì¤Ð´Ä¶ÀßÄ굡ǽ¤ò²Ã¤ï¤¨¤ë»ö¤¬¤Ç¤¤Þ¤¹¡£\r
+# \r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿¤Ç¤Ï¡¢¥Ù¡¼¥¹¥¯¥é¥¹¤Î¥³¥ó¥¹¥È¥é¥¯¥¿¤Ë¥×¥é¥°¥¤¥ó̾¤òÅϤ·¤Æ¸Æ¤Ó½Ð\r
+# ¤¹»ö¤Ç¡¢¤½¤Î¥×¥é¥°¥¤¥ó̾¤Î̾Á°¤ò¸µ¤Ë¥Ú¡¼¥¸¥¿¥¤¥È¥ë¤ä¼çÍ×¥Õ¥¡¥¤¥ë¤Î̾Á°¤¬ÀßÄê\r
+# ¤Ç¤¤Þ¤¹¡£¤â¤Á¤í¤ó¡¢¤½¤Î¸å¤Ë¸ÄÊ̤ËÊѹ¹¤¹¤ë»ö¤â²Äǽ¤Ç¤¹¤·¡¢¥Ù¡¼¥¹¥¯¥é¥¹¤Î¥³¥ó\r
+# ¥¹¥È¥é¥¯¥¿¤Ï¸Æ¤Ó½Ð¤µ¤º¡¢Æȼ«¤Ë½é´ü²½¤·¤Æ¤âÌäÂꤢ¤ê¤Þ¤»¤ó¡£\r
+# \r
+# ´Ä¶ÀßÄê¤ÇÀßÄê¤Ç¤¤ëÍͤˤ¹¤ë¥Ç¡¼¥¿Ì¾¤Ï¥á¥ó¥ÐÊÑ¿ôconfig_template¤Ç¹Ô¤Ê¤¤¤Þ¤¹¡£\r
+# ¤³¤Î¥á¥ó¥ÐÊÑ¿ô¤Ï¥Ï¥Ã¥·¥åÊÑ¿ô(¤Î¥ê¥Õ¥¡¥ì¥ó¥¹)¤È¤Ê¤Ã¤Æ¤ª¤ê¡¢¥¡¼¤¬ÊÑ¿ô̾¡¢Ãͤ¬\r
+# ¤½¤ÎÊÑ¿ô¤¬µöÍƤ¹¤ëʸ»úÎó¤ÎÀµµ¬É½¸½¤Þ¤¿¤Ï(¥é¥¸¥ª¥Ü¥¿¥ó¤Ê¤É¤Ç)ÁªÂò¤¹¤Ù¤ÃͤȤʤÃ\r
+# ¤Æ¤¤¤Þ¤¹¡£¤Þ¤¿¡¢¥á¥ó¥ÐÊÑ¿ôdefault_value¤Ë¥Ï¥Ã¥·¥åÊÑ¿ô¤òÀßÄꤹ¤ë»ö¤Ç½é´üÃͤòÀß\r
+# Äê¤Ç¤¤Þ¤¹¡£\r
+# \r
+# HTML::TemplateÍѤΥե¡¥¤¥ë¤ÏÊÌÅÓºî¤ëɬÍפ¬¤¢¤ê¤Þ¤¹¤¬¡¢¥á¥ó¥ÐÊÑ¿ô\r
+# config_template ¤ÎÃͤò¸µ¤ËHTML::TemplateÍÑÊÑ¿ô¤¬ºîÀ®¤µ¤ì¡¢config¥Õ¥¡¥¤¥ë¤ÎÃÍ\r
+# ¤¬ÀßÄꤵ¤ì¤Þ¤¹¡£\r
+# \r
+# ¤³¤ì¤éÊݸ¤µ¤ì¤¿ÀßÄêÃͤò»ÈÍѤ¹¤ë¾¤Î¥ª¥Ö¥¸¥§¥¯¥È¤Ï¡¢·Ñ¾µ¤·¤ÆºîÀ®¤·¤¿¤³¤Î¥¯¥é\r
+# ¥¹¤Î¥ª¥Ö¥¸¥§¥¯¥È¤òºîÀ®¤·¡¢load_config¥á¥½¥Ã¥É¤ò¸Æ¤Ó½Ð¤¹»ö¤Ë¤è¤ê¡¢¥Õ¥¡¥¤¥ë¤«¤é\r
+# Æɤ߽Фµ¤ì¤Æ¥Ï¥Ã¥·¥åÊÑ¿ô¤Ø³ÊǼ¤µ¤ì¤¿¡¢¥Ð¥ê¥Ç¡¼¥·¥ç¥ó¥Á¥§¥Ã¥¯¤ò¹Ô¤Ê¤Ã¤¿ÃͤòÆÉ\r
+# ¤ß½Ð¤»¤Þ¤¹¡£\r
+# \r
+# ¤³¤ì¤é¤Ë¤è¤ê¡¢´Ä¶ÀßÄ굡ǽ¤òÈæ³ÓŪ´Êñ¡¦°ÂÁ´¤Ë¼ÂÁõ¤Ç¤¤Þ¤¹¡£\r
+# !!½é´ü²½¤¹¤Ù¤¥á¥ó¥ÐÊÑ¿ô\r
+# !config_template\r
+# $self->{config_template} = {\r
+# name => '^\w+$',\r
+# value => '^\d*$',\r
+# kind => ["alpha", "beta"],\r
+# };\r
+# !default_value\r
+# $self->{default_value} = {\r
+# name => "hoge",\r
+# value => "10",\r
+# kind => "alpha",\r
+# };\r
+# !!¥³¥ó¥¹¥È¥é¥¯¥¿¤Ë¤è¤ê½é´ü²½¤µ¤ì¤ë¥á¥ó¥ÐÊÑ¿ô\r
+# !title\r
+# ´Ä¶ÀßÄê¥Ú¡¼¥¸¤Ëɽ¼¨¤µ¤ì¤ë¥¿¥¤¥È¥ë\r
+# !file_config\r
+# ÀßÄêÃͤòÊݸ¤¹¤ë¥Õ¥¡¥¤¥ë̾¤ò»ØÄꤹ¤ëºÝ¤Îsetup.dat¤Ç¤Îkey̾\r
+# !file_default\r
+# setup.dat¤Ë»ØÄ꤬¤Ê¤¤¾ì¹ç¤Î¥Ç¥Õ¥©¥ë¥ÈÀßÄê¥Õ¥¡¥¤¥ë̾\r
+# !tmpl_name\r
+# ¥Æ¥ó¥×¥ì¡¼¥È¥Õ¥¡¥¤¥ë̾\r
+# !action_name\r
+# ´Ä¶ÀßÄê¤ò¹Ô¤Ê¤¦ºÝ¤Îaction¥Ñ¥é¥á¡¼¥¿¤ÎÃÍ\r
+# !!load_config¥á¥½¥Ã¥É¤Ë¤è¤êÀßÄꤵ¤ì¤ë¥á¥ó¥ÐÊÑ¿ô\r
+# !flat\r
+# ÀßÄê¥Õ¥¡¥¤¥ë¤Þ¤¿¤Ï¥Õ¥©¡¼¥à¤Ë¤è¤êÁ÷¤é¤ì¤¿ÃͤòÁàºî¤¹¤ë¤¿¤á¤Ë¡¢¼ç¤ËÆâÉô¤Ç»È¤ï¤ì\r
+# ¤ë¥Ï¥Ã¥·¥åÊÑ¿ô¤Ç¤¹¡£\r
+# ¼ç¤ËÁàºî¤ò¹Ô¤Ê¤¦¤Î¤Ï¡¢¥×¥é¥¤¥Ù¡¼¥È¥á¥½¥Ã¥É¤Ç¤¢¤ë_check_conf¤È_make_flat¤Ç¤¹¡£\r
+# \r
+# load_config½ªÎ»»þ¡¢Ä̾ï¤Ï¶õ¤Ë¤Ê¤ê¤Þ¤¹¤¬¡¢Àµ¤·¤¯¥Ñ¡¼¥¹½ÐÍè¤Ê¤«¤Ã¤¿¹àÌܤ¬¤¢¤ì\r
+# ¤Ð¡¢¤½¤ì¤¬»Ä¤µ¤ì¤Þ¤¹¡£\r
+# !conf\r
+# ÀßÄêÃͤòÊÝ»ý¤¹¤ë¥Ï¥Ã¥·¥åÊÑ¿ô¤Ç¤¹¡£·Á¼°¤Ïdefault_value¤ÈƱ¤¸¤è¤¦¤Ë¤Ê¤ê¤Þ¤¹¡£\r
+# load_config¥á¥½¥Ã¥É¡¢set_config_form_param¥á¥½¥Ã¥É¤Ë¤è¤êÀßÄꤵ¤ì¡¢Ä̾ï¤Ï\r
+# load_config¥á¥½¥Ã¥É¤ò¸Æ¤Ó½Ð¤·¤¿¸å¤Ë»ÈÍѤ·¤Þ¤¹¡£\r
+# !tmpl\r
+# ´Ä¶ÀßÄê¥Õ¥©¡¼¥àÍѤÎTemplate¥Õ¥¡¥¤¥ë¤ËÅϤ¹ÃͤòÊÝ»ý¤¹¤ë¥Ï¥Ã¥·¥åÊÑ¿ô¤Ç¤¹¡£\r
+# load_config¥á¥½¥Ã¥É¤Ë¤è¤êÀßÄꤵ¤ì¤Þ¤¹¡£\r
+###############################################################################\r
+package Wiki::AdminTemplate;\r
+use strict;\r
+#==============================================================================\r
+# !!¥³¥ó¥¹¥È¥é¥¯¥¿\r
+# my $self = new Wiki::AdminTemplate($plugin_name);\r
+# ¥×¥é¥°¥¤¥ó̾¤ò°ú¿ô¤Ë¤È¤ê¤Þ¤¹¡£\r
+# ¥Õ¥¡¥¤¥ë̾¤Î°ìÉô¤Ë»ÈÍѤµ¤ì¤ë¤¿¤á±Ñ¿ô»ú¤¬Á°Äó¤Ç¤¹¡£\r
+# \r
+# ÅϤµ¤ì¤¿¥×¥é¥°¥¤¥ó̾¤ò¸µ¤Ë°Ê²¼¤Î´ö¤Ä¤«¤Î¥á¥ó¥ÐÊÑ¿ô¤ò½é´ü²½¤·¤Þ¤¹¡£\r
+# :title:¥×¥é¥°¥¤¥ó̾+"¥×¥é¥°¥¤¥ó¤ÎÀßÄê"\r
+# :file_config:¥×¥é¥°¥¤¥ó̾+"_file"\r
+# :file_default:¥×¥é¥°¥¤¥ó̾+".dat"\r
+# :tmpl_name:¥×¥é¥°¥¤¥ó̾+".tmpl"\r
+# :action_name:"ADMIN"+Âçʸ»ú¤Î¥×¥é¥°¥¤¥ó̾\r
+#==============================================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $name = shift;\r
+ my $self = {};\r
+ if($name){\r
+ $self->{title} = "${name}¥×¥é¥°¥¤¥ó¤ÎÀßÄê";\r
+ $self->{file_config} = "${name}_file";\r
+ $self->{file_default} = "${name}.dat";\r
+ $self->{tmpl_name} = "${name}.tmpl";\r
+ $self->{action_name} = 'ADMIN'.uc($name);\r
+ }\r
+ return bless $self,$class;\r
+}\r
+\r
+#==============================================================================\r
+# !!¥á¥½¥Ã¥É\r
+# !change_value\r
+# ÀßÄ꤬Êѹ¹¤µ¤ì¤¿ÃÍËè¤Ë¸Æ¤Ð¤ì¤ë¥Õ¥Ã¥¯¥á¥½¥Ã¥É¤Ç¤¹¡£\r
+#==============================================================================\r
+sub change_value {\r
+}\r
+\r
+#==============================================================================\r
+# !after_save_hook\r
+# ÀßÄ꤬¥»¡¼¥Ö¤µ¤ì¤¿¤¢¤È¤Ë¸Æ¤Ð¤ì¤ë¥Õ¥Ã¥¯¥á¥½¥Ã¥É¤Ç¤¹¡£\r
+#==============================================================================\r
+sub after_save_hook {\r
+}\r
+\r
+#==============================================================================\r
+# !do_acton\r
+# ¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é¥á¥½¥Ã¥É¤Ç¤¹¡£\r
+# \r
+# SAVE¥Ñ¥é¥á¡¼¥¿¤ÎÍ̵¤Ë¤è¤êÀßÄêÃͤÎÊݸ+¥ê¥À¥¤¥ì¥¯¥È¤È¥Õ¥©¡¼¥àɽ¼¨¤òÀÚÂؤ¨¤Þ\r
+# ¤¹¡£¼ÂºÝ¤ÎÆ°ºî¤Ï¡¢Êݸ+¥ê¥À¥¤¥ì¥¯¥È¤Ïsave_config¥á¥½¥Ã¥É¡¢¥Õ¥©¡¼¥àɽ¼¨¤Ï\r
+# config_form¤Ë°ú¤·Ñ¤¬¤ì¤Þ¤¹¡£\r
+#==============================================================================\r
+sub do_action {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $cgi = $wiki->get_CGI();\r
+ \r
+ $wiki->set_title($self->{title});\r
+ \r
+ if($cgi->param("SAVE") ne ""){\r
+ # ÀßÄê¤òÊݸ\r
+ return $self->save_config($wiki);\r
+ } else {\r
+ # ÀßÄê¥Õ¥©¡¼¥à¤Îɽ¼¨\r
+ return $self->config_form($wiki);\r
+ }\r
+}\r
+\r
+#==============================================================================\r
+# !config_form\r
+# ÀßÄê¥Õ¥©¡¼¥à¤Îɽ¼¨¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£\r
+# \r
+# load_config¥á¥½¥Ã¥É¤Ë¤è¤êÀßÄêÃͤÎÆɤ߹þ¤ß¤È¥Ñ¥é¥á¡¼¥¿ÀßÄê¤ò¹Ô¤Ê¤Ã¤¿¤¢¤È¡¢\r
+# load_template¥á¥½¥Ã¥É¤Ë¤è¤ê¥Æ¥ó¥×¥ì¡¼¥È¤ÎÆɤ߹þ¤ß¤È¥Ñ¥é¥á¡¼¥¿¥»¥Ã¥È¤ò¹Ô¤Ê¤¤¡¢\r
+# ºÇ¸å¤Ëget_html¥á¥½¥Ã¥É¤Ë¤è¤êHTML¤òÀ¸À®¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
+#==============================================================================\r
+sub config_form {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ $self->load_config($wiki);\r
+ $self->load_template($wiki);\r
+ \r
+ return $self->get_html($wiki);\r
+}\r
+\r
+#==============================================================================\r
+# !load_config\r
+# Êݸ¤µ¤ì¤Æ¤¤¤ëÀßÄêÃͤμèÆÀ¤È¥Ð¥ê¥Ç¡¼¥·¥ç¥ó¥Á¥§¥Ã¥¯¤ò¹Ô¤Ê¤¤¤Þ¤¹¡£\r
+# \r
+# ¤Þ¤º¡¢ÀßÄêÃͤòflat¥á¥ó¥ÐÊÑ¿ô¤ËÆɤ߹þ¤ß¡¢_check_config¥×¥é¥¤¥Ù¡¼¥È¥á¥½¥Ã¥É¤Ë¤è\r
+# ¤ê¡¢config_template¤Ë¤·¤¿¤¬¤Ã¤Æ¥Ñ¡¼¥¹¤·¤Ä¤Ätmpl¤Èconf¤Ë·ë²Ì¤òÊÖ¤·¤Þ¤¹¡£\r
+# \r
+# ´ÉÍý¥á¥Ë¥å¡¼»þ°Ê³°¤Ç¤â¡¢¥ª¥Ö¥¸¥§¥¯¥È¤òÀ¸À®¤·¤Æ¤³¤Î¥á¥½¥Ã¥É¤ò¸Æ¤Ó½Ð¤¹»ö¤Ë¤è¤ê\r
+# ¥Ç¥Õ¥©¥ë¥ÈÃͤâ´Þ¤á¤¿¥Ð¥ê¥Ç¡¼¥·¥ç¥ó¤µ¤ì¤¿ÀßÄêÃͤò¥Ï¥Ã¥·¥å¤Ë¤è¤Ã¤Æ¥¢¥¯¥»¥¹¤¹¤ë\r
+# ¤¿¤á¤Ë»ÈÍѤ·¤Þ¤¹¡£\r
+#==============================================================================\r
+sub load_config {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ \r
+ # ÀßÄêÃͤÎÆɤ߹þ¤ß\r
+ $self->{flat} = &Util::load_config_hash($wiki, $self->config_file($wiki));\r
+ \r
+ # ÃͤΥÁ¥§¥Ã¥¯¤ÈÀßÄꤵ¤ì¤Æ¤¤¤Ê¤¤¾ì¹ç¤Î½é´ü²½\r
+ $self->{tmpl} = {};\r
+ $self->{conf} = $self->_check_config(\r
+ $self->{config_template},\r
+ $self->{tmpl}) || {};\r
+}\r
+\r
+sub _check_config {\r
+ my $self = shift;\r
+ my $config_template = shift;\r
+ my $tmpl = shift;\r
+ my $base = shift || "";\r
+ my $conf = {};\r
+ my $result = $conf;\r
+ \r
+ # ÃͤΥÁ¥§¥Ã¥¯\r
+ foreach my $key (keys %$config_template){\r
+ my $regexp = $config_template->{$key};\r
+ my $flat_key = $base.$key;\r
+ my $flat_value = $self->{flat}->{$flat_key};\r
+ my $tmpl_key = uc $key;\r
+ if(ref $regexp eq 'HASH'){\r
+ my %base;\r
+ foreach(keys %{$self->{flat}}){\r
+ /^(\Q$flat_key\E\d\d_)/ and $base{$1} = 1;\r
+ }\r
+ unless(keys %base){\r
+ my $item = $self->default_value($flat_key);\r
+ %base = map {\r
+ sprintf("%s%02d_", $flat_key, $_), 1\r
+ } (0..($item-1))\r
+ if($item);\r
+ }\r
+ my @multi;\r
+ my @loop;\r
+ foreach(sort keys %base){\r
+ /(\d\d)_/;\r
+ my $hash = {\r
+ LOOP_NAMEBASE => $_,\r
+ LOOP_NAMEBASE_NUMBER => $1,\r
+ };\r
+ my $temp = $self->_check_config($regexp, $hash, $_);\r
+ defined $temp or next;\r
+ push @multi, $temp;\r
+ push @loop, $hash;\r
+ }\r
+ $conf->{$key} = \@multi;\r
+ $tmpl->{$tmpl_key} = \@loop;\r
+ my $new_basename = (sort keys %base)[-1];\r
+ my $new_basename_number;\r
+ $new_basename =~ s/(\d\d)_$/($new_basename_number = sprintf("%02d", $1+1))."_"/e;\r
+ $tmpl->{$tmpl_key."_NEW_NAMEBASE"}\r
+ = $new_basename;\r
+ $tmpl->{$tmpl_key."_NEW_NAMEBASE_NUMBER"}\r
+ = $new_basename_number;\r
+ } else {\r
+ my $tmpl_value;\r
+ if(ref $regexp eq 'ARRAY'){\r
+ my %radio = map {$_, 1} @$regexp;\r
+ unless(exists $radio{$flat_value}){\r
+ $flat_value = $self->default_value($flat_key);\r
+ exists $radio{$flat_value}\r
+ or undef $result;\r
+ }\r
+ $tmpl_key .= uc "_$flat_value";\r
+ $tmpl_value = 1;\r
+ } elsif($flat_value =~ /$regexp/){\r
+ $tmpl_value = $flat_value;\r
+ } else {\r
+ $tmpl_value = $flat_value\r
+ = $self->default_value($flat_key);\r
+ $flat_value =~ /$regexp/ or undef $result;\r
+ }\r
+ $conf->{$key} = $flat_value;\r
+ $tmpl->{$tmpl_key} = $tmpl_value;\r
+ delete $self->{flat}->{$flat_key};\r
+ my $old_value = $self->{old}->{$flat_key};\r
+ $self->change_value($flat_key, $flat_value, $old_value)\r
+ if(defined $old_value and $old_value ne $flat_value);\r
+ delete $self->{old}->{$flat_key};\r
+ }\r
+ }\r
+ return $result;\r
+}\r
+\r
+#==============================================================================\r
+# !config_file\r
+# ÀßÄê¥Õ¥¡¥¤¥ë̾¤ò¥Ç¥Õ¥©¥ë¥È̾¤Þ¤¿¤Ïsetup.dat¤«¤é¼èÆÀ¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
+#==============================================================================\r
+sub config_file {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ return $wiki->config($self->{file_config}) || $self->{file_default};\r
+}\r
+\r
+#==============================================================================\r
+# !default_value\r
+# default_value¥á¥ó¥ÐÊÑ¿ô¤«¤é¥Ç¥Õ¥©¥ë¥ÈÃͤò¼èÆÀ¤·¤ÆÊÖ¤·¤Þ¤¹¡£\r
+#==============================================================================\r
+sub default_value {\r
+ my $self = shift;\r
+ my $name = shift;\r
+ my $default = $self->{default_value}->{$name};\r
+ $self->_make_flat({$name => $default});\r
+ return ref $default eq 'ARRAY' ? scalar @$default : $default;\r
+}\r
+\r
+#==============================================================================\r
+# !load_template\r
+# ¥Æ¥ó¥×¥ì¡¼¥È¥Õ¥¡¥¤¥ë¤«¤é¥Æ¥ó¥×¥ì¡¼¥È¥ª¥Ö¥¸¥§¥¯¥È¤òÀ¸À®¤·¡¢load_config¥á¥½¥Ã¥É\r
+# ¤ÇÀ¸À®¤µ¤ì¤¿¥Æ¥ó¥×¥ì¡¼¥ÈÍѥѥé¥á¡¼¥¿¤òÀßÄꤷ¤Þ¤¹¡£\r
+# ¤³¤Î¥Æ¥ó¥×¥ì¡¼¥È¥ª¥Ö¥¸¥§¥¯¥È¤Ï¸å¤Çget_html¤Ë¤è¤ê»ÈÍѤµ¤ì¤Þ¤¹¡£\r
+#==============================================================================\r
+sub load_template {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ \r
+ # ¥Æ¥ó¥×¥ì¡¼¥È¤Î¼èÆÀ\r
+ my $tmpl_obj = HTML::Template->new(\r
+ filename=>$wiki->config('tmpl_dir').'/'.$self->{tmpl_name},\r
+ die_on_bad_params => 0);\r
+ \r
+ # ¥Æ¥ó¥×¥ì¡¼¥È¤Ë¥Ñ¥é¥á¡¼¥¿¤ò¥»¥Ã¥È\r
+ $tmpl_obj->param(%{$self->{tmpl}});\r
+ \r
+ $self->{tmpl_obj} = $tmpl_obj;\r
+}\r
+\r
+#==============================================================================\r
+# !get_html\r
+# ¤¹¤Ç¤ËºîÀ®¤µ¤ì¤Æ¤¤¤ë¥Æ¥ó¥×¥ì¡¼¥È¥ª¥Ö¥¸¥§¥¯¥È¤«¤é¤«¤é¼ÂºÝ¤ËHTML¤òÀ¸À®¤·¤Þ¤¹¡£\r
+# ¤³¤Î¥á¥½¥Ã¥É¤ÎÌá¤êÃͤ¬¤³¤Î¥×¥é¥°¥¤¥ó¤ÎÌá¤êÃÍ(¼ÂºÝ¤Ë½ÐÎϤµ¤ì¤ëHTML)¤Ë¤Ê¤ê¤Þ¤¹¡£\r
+#==============================================================================\r
+sub get_html {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ return\r
+ "<form action=\"".$wiki->config('script_name')."\" method=\"POST\">\n".\r
+ $self->{tmpl_obj}->output().\r
+ "<input type=\"hidden\" name=\"action\" value=\"".$self->{action_name}."\">\n".\r
+ "</form>\n";\r
+}\r
+\r
+#==============================================================================\r
+# !save_config\r
+# ¥Õ¥©¡¼¥à¤Ë¤è¤ë¹¹¿·¤ò½èÍý¤·¤Þ¤¹¡£¤½¤ÎºÝ¤Ë¡¢Êѹ¹¤µ¤ì¤¿ÃÍËè¤È¡¢Ãͤ¬¥Õ¥¡¥¤¥ë¤ËÊÝ\r
+# ¸¤µ¤ì¤¿¤¢¤È¤Ë¥Õ¥Ã¥¯¥á¥½¥Ã¥É¤ò¸Æ¤Ó¤Þ¤¹¡£\r
+#==============================================================================\r
+sub save_config {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $cgi = $wiki->get_CGI;\r
+ \r
+ # º£¤ÎÀßÄê¤òÆɤ߹þ¤à(º¹Ê¬¸¡½ÐÍÑ)\r
+ $self->{old} = &Util::load_config_hash($wiki, $self->config_file($wiki));\r
+ \r
+ # ¼õ¤±¼è¤Ã¤¿¥Ñ¥é¥á¡¼¥¿¤«¤éÀßÄê¤ò¹¹¿·¤¹¤ë\r
+ $self->set_config_from_param($cgi);\r
+ \r
+ # ÀßÄê¤òÊݸ¤¹¤ë\r
+ &Util::save_config_hash($wiki, $self->config_file($wiki), $self->{flat});\r
+ $self->after_save_hook($wiki);\r
+ \r
+ # º¹Ê¬¸¡½ÐÍѥǡ¼¥¿¤ò¾Ã¤¹\r
+ delete $self->{old};\r
+ \r
+ # ÀßÄê¥Õ¥©¡¼¥à¤Ë¥ê¥À¥¤¥ì¥¯¥È¤¹¤ë\r
+ $wiki->redirectURL($wiki->config('script_name')."?action=".$self->{action_name});\r
+}\r
+\r
+#==============================================================================\r
+# !set_config_from_param\r
+# ¼õ¤±¼è¤Ã¤¿CGI¥Ñ¥é¥á¡¼¥¿¤«¤éÀßÄê¤ò¹¹¿·¤·¡¢ÊݸÍѥǡ¼¥¿¤òºîÀ®¤·¤Þ¤¹¡£\r
+#==============================================================================\r
+sub set_config_from_param {\r
+ my $self = shift;\r
+ my $cgi = shift;\r
+ \r
+ # ÀßÄêÃͤÎÆɤ߹þ¤ß\r
+ $self->{flat} = $cgi->Vars;\r
+ \r
+ # ÃͤΥÁ¥§¥Ã¥¯¤ÈÀßÄꤵ¤ì¤Æ¤¤¤Ê¤¤¾ì¹ç¤Î½é´ü²½\r
+ $self->{conf} = $self->_check_config($self->{config_template}) || {};\r
+ \r
+ # Àµµ¬²½¤µ¤ì¤¿ÃͤÎÀßÄê\r
+ $self->{flat} = {};\r
+ $self->_make_flat($self->{conf});\r
+}\r
+\r
+sub _make_flat {\r
+ my $self = shift;\r
+ my $conf = shift;\r
+ my $base = shift || "";\r
+ \r
+ foreach my $key (keys %$conf){\r
+ my $value = $conf->{$key};\r
+ if(ref $value eq 'ARRAY'){\r
+ my $i = 0;\r
+ foreach(@$value){\r
+ $self->_make_flat(\r
+ $_,\r
+ sprintf("%s%s%02d_", $base, $key, $i++));\r
+ }\r
+ } else {\r
+ $self->{flat}->{$base.$key} = $value;\r
+ }\r
+ }\r
+}\r
+\r
+1;\r
--- /dev/null
+###############################################################################\r
+#\r
+# ¤Ï¤Æ¤Ê¥À¥¤¥¢¥ê¡¼¥³¥á¥ó¥ÈURL¿ô¼èÆÀAPI¤Ë¤è¤ë¥¹¥Ñ¥à¥Õ¥£¥ë¥¿¥ê¥ó¥°\r
+#\r
+###############################################################################\r
+package plugin::spam_hatena::Hook;\r
+use strict;\r
+use URI;\r
+use LWP::Simple;\r
+use JSON::Syck;\r
+\r
+#==============================================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#==============================================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#==============================================================================\r
+# ¥Õ¥Ã¥¯¥á¥½¥Ã¥É\r
+#==============================================================================\r
+sub hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $cgi = $wiki->get_CGI();\r
+ \r
+ my $content = $cgi->param("content");\r
+ return if($content eq '');\r
+ my $page = $cgi->param("page");\r
+ my $old = $wiki->get_page($page);\r
+ \r
+ $wiki->redirect($page) unless RULE_HATENA($content,$old);\r
+}\r
+\r
+#==============================================================================\r
+# ¤Ï¤Æ¤Ê¤Ø¤ÎÌ䤤¹ç¤ï¤»¤Î·ë²Ì»ØÄê¿ô¤ò¤³¤¨¤¿¾ì¹ç¤ËÊݸ¤òµñÈݤ¹¤ë¥ë¡¼¥ë\r
+#==============================================================================\r
+#use Util;\r
+sub RULE_HATENA {\r
+ my $content = shift;\r
+ my $old = shift;\r
+ # Àµµ¬É½¸½¤Ï Wiki::Parser URL¥ê¥ó¥¯ ¤«¤éήÍÑ\r
+ my $re = qr/(https?:[a-zA-Z0-9\.,%~^_+\-%\/\?\(\)!\$&=:;\*#\@']*)/;\r
+ my %link = map {$_=>1} ($content =~ /$re/g);\r
+ # ¹¹¿·Á°¤Î¥Ú¡¼¥¸¤Ë¤¹¤Ç¤Ë¸ºß¤·¤Æ¤¤¤ëURL¤Ë¤Ä¤¤¤Æ¤Ï¥Á¥§¥Ã¥¯¤·¤Ê¤¤\r
+ delete $link{$_} foreach ($old =~ /$re/g);\r
+ my @link = keys %link;\r
+ # ¿·µ¬URL¤¬Â¸ºß¤·¤Ê¤±¤ì¤Ð¥Á¥§¥Ã¥¯¤·¤Ê¤¤\r
+ return 1 unless (@link);\r
+ # ¿·µ¬URL¤¬10°Ê¾å¤¢¤ì¤Ð¤½¤Î»þÅÀ¤ÇNG\r
+ return 0 if (@link > 10);\r
+ \r
+ # ¤Ï¤Æ¤Ê¤ØÌ䤤¹ç¤ï¤»\r
+# Util::debug("spam_hatena: CALL: ".@link);\r
+ my $uri = URI->new('http://d.hatena.ne.jp/api/comment/urlcount');\r
+ $uri->query_form( url => \@link );\r
+ my $json = JSON::Syck::Load(get($uri));\r
+ \r
+ # Ì䤤¹ç¤ï¤»¤Î·ë²Ì¤ò¥Á¥§¥Ã¥¯\r
+ for (keys %$json) {\r
+ if ($json->{$_} >= 5) {\r
+# Util::debug("spam_hatena: $json->{$_}: NG: $_");\r
+ return 0 \r
+ } else {\r
+# Util::debug("spam_hatena: $json->{$_}: OK: $_");\r
+ }\r
+ }\r
+ return 1;\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# ¤Ï¤Æ¤Ê¥À¥¤¥¢¥ê¡¼¥³¥á¥ó¥ÈURL¿ô¼èÆÀAPI¤Ë¤è¤ë¥¹¥Ñ¥à¥Õ¥£¥ë¥¿¥ê¥ó¥°¤òÄ󶡤·¤Þ¤¹¡£\r
+#\r
+############################################################\r
+package plugin::spam_hatena::Install;\r
+use strict;\r
+\r
+sub install {\r
+ my $wiki = shift;\r
+ $wiki->add_hook("save_before","plugin::spam_hatena::Hook");\r
+}\r
+\r
+1;\r
--- /dev/null
+###############################################################################\r
+#\r
+# thumbnail¥×¥é¥°¥¤¥ó¤ÎÀßÄê¤ò¹Ô¤¦¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é\r
+#\r
+# ::default_size\r
+# :::¥Ç¥Õ¥©¥ë¥È¥µ¥¤¥ºÌ¾\r
+# ::name\r
+# :::¥µ¥¤¥ºÌ¾\r
+# ::priority\r
+# :::¥×¥é¥¤¥ª¥ê¥Æ¥£(max or min)\r
+# ::ratio:\r
+# :::½Ì¾®Î¨(%)\r
+# ::max\r
+# :::ºÇÂçĹ(px)\r
+# ::x\r
+# :::²£ÊÕĹ(px)\r
+# ::y\r
+# :::½ÄÊÕĹ(px)\r
+#\r
+###############################################################################\r
+package plugin::thumbnail::Admin;\r
+use strict;\r
+use plugin::thumbnail::AdminTemplate;\r
+use plugin::thumbnail::Delete;\r
+use vars qw(@ISA);\r
+@ISA = qw(Wiki::AdminTemplate);\r
+#==============================================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#==============================================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = new Wiki::AdminTemplate('thumbnail');\r
+ $self->{action_name} = $plugin::thumbnail::Install::AdminHandler;\r
+ $self->{default_value} = {\r
+ default_size => "default",\r
+ size => [{\r
+ name => "default",\r
+ priority => "max",\r
+ ratio => "25",\r
+ max => "120",\r
+ x => "",\r
+ y => "",\r
+ }, {\r
+ name => "large",\r
+ priority => "max",\r
+ ratio => "25",\r
+ max => "300",\r
+ x => "",\r
+ y => "",\r
+ }, {\r
+ name => "small",\r
+ priority => "min",\r
+ ratio => "25",\r
+ max => "80",\r
+ x => "",\r
+ y => "",\r
+ }],\r
+ };\r
+ $self->{config_template} = {\r
+ default_size => '^\w+$',\r
+ size => {\r
+ name => '^\w+$',\r
+ priority => ["max", "min"],\r
+ ratio => '^\d*$',\r
+ max => '^\d*$',\r
+ x => '^\d*$',\r
+ y => '^\d*$',\r
+ },\r
+ };\r
+ $self->{size_change_conf} = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+sub load_config {\r
+ my $self = shift;\r
+ $self->SUPER::load_config(@_);\r
+ my %param = map {$_->{name} => $_} @{$self->{conf}->{size}};\r
+ $self->{param} = \%param;\r
+}\r
+\r
+sub change_value {\r
+ my $self = shift;\r
+ my $key = shift;\r
+ my $new = shift;\r
+ my $old = shift;\r
+ if($key =~ /^(size\d\d)(.*)/) {\r
+ $self->{size_change_conf}->{$1} = $2 eq "_name" ? $old : "";\r
+ }\r
+}\r
+\r
+sub after_save_hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ foreach my $key (keys %{$self->{old}}) {\r
+ if($key =~ /^(size\d\d)_name$/) {\r
+ $self->{size_change_conf}->{$1} = $self->{old}->{$key};\r
+ }\r
+ }\r
+ foreach my $key (keys %{$self->{size_change_conf}}) {\r
+ my $name = $self->{size_change_conf}->{$key} || $self->{flat}->{$key."_name"};\r
+ plugin::thumbnail::Delete::delete_of_size($wiki, $name);\r
+ }\r
+ $self->{size_change_conf} = {};\r
+}\r
+\r
+1;\r
--- /dev/null
+###############################################################################\r
+#\r
+# ¥Ú¡¼¥¸ºï½ü»þÅù¤ËºîÀ®ºÑThumbnail¥¥ã¥Ã¥·¥å¤òºï½ü¤¹¤ë¥Õ¥Ã¥¯¥×¥é¥°¥¤¥ó\r
+#\r
+###############################################################################\r
+package plugin::thumbnail::Delete;\r
+use strict;\r
+use Util;\r
+#==============================================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#==============================================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#==============================================================================\r
+# ¥Õ¥Ã¥¯¥á¥½¥Ã¥É\r
+#==============================================================================\r
+sub hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $page = $wiki->get_CGI->param('page');\r
+ \r
+ delete_of_page($wiki, $page);\r
+}\r
+\r
+sub delete_of_page {\r
+ my $wiki = shift;\r
+ my $encode_page = Util::url_encode(shift);\r
+ my $dir = $wiki->config('thumbnail_dir');\r
+ Util::debug("do plugin::thumbnail::Delete::delete_of_page: $encode_page");\r
+ opendir(DIR, $dir) or die $!;\r
+ while(my $entry = readdir(DIR)){\r
+ if(index($entry, "$encode_page.") == 0){\r
+ unlink("$dir/$entry");\r
+ }\r
+ }\r
+ closedir(DIR);\r
+}\r
+\r
+sub delete_of_file {\r
+ my $wiki = shift;\r
+ my $encode_page = Util::url_encode(shift);\r
+ my $encode_file = Util::url_encode(shift);\r
+ my $dir = $wiki->config('thumbnail_dir');\r
+ Util::debug("do plugin::thumbnail::Delete::delete_of_file: $encode_file");\r
+ opendir(DIR, $dir) or die $!;\r
+ while(my $entry = readdir(DIR)){\r
+ if(index($entry, "$encode_page.$encode_file") == 0){\r
+ unlink("$dir/$entry");\r
+ }\r
+ }\r
+ closedir(DIR);\r
+}\r
+\r
+sub delete_of_size {\r
+ my $wiki = shift;\r
+ my $size = shift;\r
+ my $dir = $wiki->config('thumbnail_dir');\r
+ Util::debug("do plugin::thumbnail::Delete::delete_of_size: $size");\r
+ opendir(DIR, $dir) or die $!;\r
+ while(my $entry = readdir(DIR)){\r
+ if($entry =~ /\.$size$/){\r
+ unlink("$dir/$entry");\r
+ }\r
+ }\r
+ closedir(DIR);\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# źÉÕ²èÁü¥Õ¥¡¥¤¥ë¤Î¥µ¥à¥Í¥¤¥ë¥¢¥¯¥·¥ç¥ó¥Ï¥ó¥É¥é\r
+#\r
+############################################################\r
+package plugin::thumbnail::Handler;\r
+use strict;\r
+use plugin::thumbnail::Inline;\r
+use plugin::thumbnail::Admin;\r
+use plugin::thumbnail::Delete;\r
+use Image::Info qw(image_info);\r
+use Image::Thumbnail;\r
+\r
+#===========================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#===========================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#===========================================================\r
+# ¥¢¥¯¥·¥ç¥ó¤Î¼Â¹Ô\r
+#===========================================================\r
+sub do_action {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $cgi = $wiki->get_CGI;\r
+ \r
+ my $page = $cgi->param("page");\r
+ if($page eq ""){\r
+ $page = $wiki->config("frontpage");\r
+ }\r
+ $wiki->set_title($page,1);\r
+ \r
+ my $file = $cgi->param("file");\r
+ if($file eq ""){\r
+ return $wiki->error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£");\r
+ }\r
+ unless($wiki->can_show($page)){\r
+ return $wiki->error("¥Ú¡¼¥¸¤Î»²¾È¸¢¸Â¤¬¤¢¤ê¤Þ¤»¤ó¡£");\r
+ }\r
+ \r
+ my $filename = plugin::thumbnail::Inline::create_image_filename($wiki, $page, $file);\r
+ unless(-f $filename){\r
+ #unlinks;\r
+ plugin::thumbnail::Delete::delete_of_file($wiki, $page, $file);\r
+ return $wiki->error("¥Õ¥¡¥¤¥ë¤¬¤ß¤Ä¤«¤ê¤Þ¤»¤ó¡£");\r
+ }\r
+ \r
+ my $image_info = image_info($filename);\r
+ if(exists $image_info->{error}){\r
+ return $wiki->error("²èÁü¥Õ¥¡¥¤¥ë¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó¡£");\r
+ }\r
+ my $contenttype = $image_info->{file_media_type};\r
+ \r
+ my $admin = new plugin::thumbnail::Admin;\r
+ $admin->load_config($wiki);\r
+ \r
+ my $size = $cgi->param("size");\r
+ if($size eq ""){\r
+ $size = $admin->{conf}->{default_size};\r
+ }\r
+ unless(exists $admin->{param}->{$size}){\r
+ return $wiki->error("¥µ¥¤¥º»ØÄ꤬ŬÀڤǤϤ¢¤ê¤Þ¤»¤ó¡£");\r
+ }\r
+ \r
+ my $cachename = plugin::thumbnail::Inline::create_cache_filename($wiki, $page, $file, $size);\r
+ if(not -e $cachename or -M $filename < -M $cachename){\r
+ make_thumbnail($filename, $cachename, $admin->{param}->{$size}, $image_info);\r
+ }\r
+ \r
+ open(DATA, $cachename) or die $!;\r
+ print "Content-Type: $contenttype\n";\r
+# if ($pagename =~ m![^ -~]!) {\r
+# # ÆüËܸì¤ò´Þ¤à¥Õ¥¡¥¤¥ë̾¤ò¥¨¥¹¥±¡¼¥×\r
+# print "Content-Disposition: inline;filename*=iso-2022-jp''".\r
+# uri_escape(&Jcode::convert("$file",'jis'))."\n\n";\r
+# } else {\r
+# print "Content-Disposition: inline;filename=\"$file\"\n\n";\r
+# }\r
+ print "Content-Disposition: inline;filename=\"".&Jcode::convert($file,'sjis')."\"\n\n";\r
+ \r
+ binmode(DATA);\r
+ while(read(DATA, $_, 16384)){ print $_; }\r
+ close(DATA);\r
+ \r
+ exit();\r
+}\r
+\r
+sub make_thumbnail {\r
+ my $src = shift;\r
+ my $dist = shift;\r
+ my $param = shift;\r
+ my $info = shift;\r
+ \r
+ # ³ÈÂç½Ì¾®¥µ¥¤¥º»»½Ð\r
+ my $width = $info->{width};\r
+ my $height = $info->{height};\r
+ my ($ratio , $max, $x, $y);\r
+ $ratio = $param->{ratio} / 100 *($width > $height ? $width : $height)\r
+ if ($param->{ratio});\r
+ $max = $param->{max}\r
+ if ($param->{max});\r
+ $x = $param->{x} * ($width > $height ? 1 : $height/$width)\r
+ if ($param->{x});\r
+ $y = $param->{y} * ($width > $height ? $width/$height : 1)\r
+ if ($param->{y});\r
+ my $size = int( (sort {$a<=>$b} grep {$_} ($ratio, $max, $x, $y))[$param->{priorty} eq "max" ? -1 : 0] );\r
+ \r
+ my $t = new Image::Thumbnail(\r
+ size => $size,\r
+ create => 1,\r
+ inputpath => $src,\r
+ outputpath => $dist,\r
+ );\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# thumbnail¥×¥é¥°¥¤¥ó¤Î½é´ü²½¤ª¤è¤ÓWikiFarm¤Ë¤è¤ëWikiºï½ü»þ\r
+# ¤Î½èÍý¤ò¹Ô¤¦¥Õ¥Ã¥¯¥×¥é¥°¥¤¥ó\r
+#\r
+############################################################\r
+package plugin::thumbnail::Initializer;\r
+use strict;\r
+use File::Path;\r
+#===========================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#===========================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#===========================================================\r
+# thumbnail¥×¥é¥°¥¤¥ó¤Î½é´ü²½\r
+#===========================================================\r
+sub hook {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $name = shift;\r
+ \r
+ # remove_wiki¥Õ¥Ã¥¯\r
+ if($name eq "remove_wiki"){\r
+ my $path = $wiki->get_CGI()->param("path");\r
+ if(-d $wiki->config('thumbnail_dir').$path){\r
+ rmtree($wiki->config('thumbnail_dir').$path) or die $!;\r
+ }\r
+ \r
+ # initialize¥Õ¥Ã¥¯\r
+ } elsif($name eq "initialize") {\r
+ # Farm¤ÇÆ°ºî¤·¤Æ¤¤¤ë¾ì¹ç¤Ï¥°¥í¡¼¥Ð¥ëÊÑ¿ô¤ò¾å½ñ¤\r
+ my $path_info = $wiki->get_CGI()->path_info();\r
+ # path_info¤ÏËÜÂΤǥÁ¥§¥Ã¥¯ºÑ¤ß¤Ê¤Î¤Ç¿®Íꤹ¤ë\r
+ $wiki->config('thumbnail_dir',\r
+ ($wiki->config('thumbnail_dir')||'./thumbnail')\r
+ .$path_info);\r
+ \r
+ unless(-e $wiki->config('thumbnail_dir')){\r
+ mkpath($wiki->config('thumbnail_dir')) or die $!;\r
+ }\r
+ }\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# <p>źÉÕ¤·¤¿²èÁü¥Õ¥¡¥¤¥ë¤ò½Ì¾®É½¼¨¤·¤Þ¤¹¡£</p>\r
+# <pre>\r
+# {{thumbnail ¥Õ¥¡¥¤¥ë̾[,¥Ú¡¼¥¸Ì¾[,¥µ¥¤¥º[,¥ª¥×¥·¥ç¥ó]]]}}\r
+# </pre>\r
+# <p>¥Ú¡¼¥¸Ì¾¤ò»ØÄꤹ¤ë¤³¤È¤Ç¡¢Ê̤Υڡ¼¥¸¤ËźÉÕ¤µ¤ì¤¿\r
+# ¥Õ¥¡¥¤¥ë¤ò»²¾È¤¹¤ë¤³¤È¤â¤Ç¤¤Þ¤¹¡£</p>\r
+# <p>´Ä¶ÀßÄê¤ÇÊ£¿ô¤Î¥µ¥¤¥º¤¬ÄêµÁ¤µ¤ì¤Æ¤¤¤ë¾ì¹ç¡¢¤½¤Î¥µ¥¤¥º¤¬»ØÄê¤Ç¤¤Þ¤¹¡£</p>\r
+# <p>¥ª¥×¥·¥ç¥ó¤Ï°Ê²¼¤¬»È¤¨¤Þ¤¹</p>\r
+# <du>\r
+# <dt>alt:¿¶Âإƥ¥¹¥È</dt>\r
+# <dd>²èÁü¥Õ¥¡¥¤¥ë¤ËǤ°Õ¤Î alt °À¤òÉÕ²Ã(½é´üÃÍ:¥Õ¥¡¥¤¥ë̾)</dd>\r
+# <dt>float:left or right</dt>\r
+# <dd>¥Æ¥¥¹¥È¤Î²ó¤ê¤³¤ß»ØÄê</dd>\r
+# </du>\r
+# <p>Îã¡Ë</p>\r
+# <pre>\r
+# {{thumbnail sample.jpg,,large}}\r
+# </pre>\r
+#\r
+############################################################\r
+# ¤³¤Î¥×¥é¥°¥¤¥ó¤ÏKG¤µ¤óºî image ¥×¥é¥°¥¤¥ó¤òήÍѤµ¤»¤Æ\r
+# ¤¤¤¿¤À¤¤Þ¤·¤¿¡£´¶¼Õ¡£\r
+############################################################\r
+package plugin::thumbnail::Inline;\r
+use Util;\r
+use plugin::thumbnail::Delete;\r
+use Image::Info qw(image_info);\r
+use strict;\r
+#===========================================================\r
+# ¥³¥ó¥¹¥È¥é¥¯¥¿\r
+#===========================================================\r
+sub new {\r
+ my $class = shift;\r
+ my $self = {};\r
+ return bless $self,$class;\r
+}\r
+\r
+#===========================================================\r
+# ¥¤¥ó¥é¥¤¥ó¥á¥½¥Ã¥É\r
+#===========================================================\r
+sub inline {\r
+ my $self = shift;\r
+ my $wiki = shift;\r
+ my $file = shift;\r
+ my $page = shift;\r
+ my $size = shift;\r
+ my @option = @_;\r
+ \r
+ if($file eq ""){\r
+ return &Util::inline_error("¥Õ¥¡¥¤¥ë¤¬»ØÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó¡£","HTML");\r
+ }\r
+ if($page eq ""){\r
+ $page = $wiki->get_CGI()->param("page");\r
+ }\r
+ unless($wiki->can_show($page)){\r
+ return &Util::inline_error("¥Ú¡¼¥¸¤Î»²¾È¸¢¸Â¤¬¤¢¤ê¤Þ¤»¤ó¡£","HTML");\r
+ }\r
+ \r
+ my $link = &create_image_link($wiki,$page,$file);\r
+ my $url = &create_image_url($wiki,$page,$file,$size);\r
+ my $filename = &create_image_filename($wiki,$page,$file);\r
+ unless(-f $filename){\r
+ plugin::thumbnail::Delete::delete_of_file($wiki, $page, $file);\r
+ return &Util::inline_error("¥Õ¥¡¥¤¥ë¤¬¤ß¤Ä¤«¤ê¤Þ¤»¤ó¡£","HTML");\r
+ }\r
+ my $info = image_info($filename);\r
+ if(exists $info->{error}){\r
+ return &Util::inline_error("²èÁü¥Õ¥¡¥¤¥ë¤ÎÆɤ߹þ¤ß¤Ë¼ºÇÔ¤·¤Þ¤·¤¿¡£","HTML");\r
+ }\r
+ \r
+ # ³ÈÄ¥¥ª¥×¥·¥ç¥ó²òÀÏ\r
+ my ($alt, $float) = ($file);\r
+ foreach (@option) {\r
+ if ( /^(a|alt):(.*)$/i ) {\r
+ $alt = $2;\r
+ } elsif ( /^(f|float):(left|right)$/i ) {\r
+ $float = $2;\r
+ }\r
+ }\r
+ \r
+ my $option = {\r
+ ALT => $alt,\r
+ FLOAT => $float,\r
+ LINK => $link,\r
+ URL => $url,\r
+ FILENAME => $filename,\r
+ };\r
+ return $self->create_image_tag($page,$file,$option);\r
+}\r
+\r
+sub create_image_filename {\r
+ my $wiki = shift;\r
+ my $page = shift;\r
+ my $file = shift;\r
+ \r
+ return $wiki->config('attach_dir')."/".&Util::url_encode($page).".".&Util::url_encode($file);\r
+}\r
+\r
+sub create_cache_filename {\r
+ my $wiki = shift;\r
+ my $page = shift;\r
+ my $file = shift;\r
+ my $size = shift;\r
+ \r
+ return $wiki->config('thumbnail_dir')."/".&Util::url_encode($page).".".&Util::url_encode($file).'.'.&Util::url_encode($size);\r
+}\r
+\r
+sub create_image_link {\r
+ my $wiki = shift;\r
+ my $page = shift;\r
+ my $file = shift;\r
+ \r
+ return $wiki->config('script_name')."?action=ATTACH&".\r
+ "page=".&Util::url_encode($page)."&".\r
+ "file=".&Util::url_encode($file);\r
+}\r
+\r
+sub create_image_url {\r
+ my $wiki = shift;\r
+ my $page = shift;\r
+ my $file = shift;\r
+ my $size = shift;\r
+ \r
+ return $wiki->config('script_name')."?action=".\r
+ $plugin::thumbnail::Install::Handler."&".\r
+ "page=".&Util::url_encode($page)."&".\r
+ "file=".&Util::url_encode($file)."&".\r
+ "size=".&Util::url_encode($size);\r
+}\r
+\r
+sub create_image_tag {\r
+ my $self = shift;\r
+ my $page = shift;\r
+ my $file = shift;\r
+ my $option = shift;\r
+ \r
+ my $alt = $option->{ALT};\r
+ my $float = $option->{FLOAT};\r
+ my $link = $option->{LINK};\r
+ my $url = $option->{URL};\r
+ \r
+ return ((defined($link))?'<a href="'.$link.'">':'').\r
+ '<img class="wikiimage" src="'.$url.'"'.\r
+ ((defined($alt))?' alt="'.&Util::escapeHTML($alt).'"':'').\r
+ ((defined($float))?' style="float:'.$float.';"':'').\r
+ '>'.\r
+ ((defined($link))?'</a>':'');\r
+}\r
+\r
+1;\r
--- /dev/null
+############################################################\r
+#\r
+# Wiki¥Ú¡¼¥¸¤Ë¥Õ¥¡¥¤¥ë¤òźÉÕ¤¹¤ë¤¿¤á¤Î¥×¥é¥°¥¤¥ó¤òÄ󶡤·¤Þ¤¹¡£\r
+#\r
+############################################################\r
+package plugin::thumbnail::Install;\r
+use strict;\r
+use vars qw($AdminHandler $Handler);\r
+$AdminHandler = 'ADMINTHUMBNAIL';\r
+$Handler = 'THUMBNAIL';\r
+\r
+sub install {\r
+ my $wiki = shift;\r
+ $wiki->add_admin_menu(\r
+ "thumbnail¥×¥é¥°¥¤¥ó¤ÎÀßÄê",\r
+ $wiki->config('script_name')."?action=$AdminHandler",\r
+ 200,\r
+ "thumbnail¥×¥é¥°¥¤¥ó¤ÇÀ¸À®¤¹¤ë²èÁü¥µ¥¤¥ºÅù¤òÀßÄꤷ¤Þ¤¹¡£",\r
+ );\r
+ $wiki->add_admin_handler($AdminHandler,"plugin::thumbnail::Admin");\r
+ $wiki->add_hook("initialize","plugin::thumbnail::Initializer");\r
+ $wiki->add_hook("remove_wiki","plugin::thumbnail::Initializer");\r
+ $wiki->add_hook("delete","plugin::thumbnail::Delete");\r
+ $wiki->add_hook("rename","plugin::thumbnail::Delete");\r
+ $wiki->add_handler($Handler,"plugin::thumbnail::Handler");\r
+ $wiki->add_inline_plugin("thumbnail","plugin::thumbnail::Inline","HTML");\r
+}\r
+\r
+1;\r
--- /dev/null
+<!--=========================================================================-->\r
+<!-- ´ÉÍý²èÌÌ¡Êthumbnail¥×¥é¥°¥¤¥óÀßÄê¡Ë -->\r
+<!--=========================================================================-->\r
+\r
+<h2>thumbnail¥×¥é¥°¥¤¥óÀßÄê</h2>\r
+\r
+<h3>¥Ç¥Õ¥©¥ë¥È¥µ¥¤¥ºÌ¾</h3>\r
+<p><input type="text" name="default_size" size="20"\r
+ value="<!--TMPL_VAR NAME="DEFAULT_SIZE" ESCAPE="HTML"-->"></p>\r
+\r
+<!--TMPL_LOOP NAME="SIZE"-->\r
+<h3>¥µ¥¤¥ºÀßÄê (<!--TMPL_VAR NAME="LOOP_NAMEBASE_NUMBER" ESCAPE="HTML"-->ÈÖÌÜ)</h3>\r
+<du>\r
+<dt>¥µ¥¤¥ºÌ¾</dt>\r
+<dd><input type="text" size="20"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->name"\r
+ value="<!--TMPL_VAR NAME="NAME" ESCAPE="HTML"-->"></dd>\r
+\r
+<dt>¥×¥é¥¤¥ª¥ê¥Æ¥£</dt>\r
+<dd>\r
+ <input type="radio" value="max"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority"\r
+ id="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority_max"\r
+ <!--TMPL_IF NAME="PRIORITY_MAX"-->checked<!--/TMPL_IF-->>\r
+ <label for="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority_max">°ìÈÖÂ礤¤¥µ¥¤¥º¤òºÎÍÑ</label>\r
+ <input type="radio" value="min"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority"\r
+ id="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority_min"\r
+ <!--TMPL_IF NAME="PRIORITY_MIN"-->checked<!--/TMPL_IF-->>\r
+ <label for="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->priority_min">°ìÈÖ¾®¤µ¤¤¥µ¥¤¥º¤òºÎÍÑ</label>\r
+</dd>\r
+\r
+<dt>½Ì¾®Î¨</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->ratio"\r
+ value="<!--TMPL_VAR NAME="RATIO" ESCAPE="HTML"-->">(%)</dd>\r
+\r
+<dt>ºÇÂçĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->max"\r
+ value="<!--TMPL_VAR NAME="MAX" ESCAPE="HTML"-->">(px)</dd>\r
+\r
+<dt>²£ÊÕĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->x"\r
+ value="<!--TMPL_VAR NAME="X" ESCAPE="HTML"-->">(px)</dd>\r
+\r
+<dt>½ÄÊÕĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="LOOP_NAMEBASE" ESCAPE="HTML"-->y"\r
+ value="<!--TMPL_VAR NAME="Y" ESCAPE="HTML"-->">(px)</dd>\r
+\r
+<!--/TMPL_LOOP-->\r
+<h3>¿·µ¬¥µ¥¤¥ºÀßÄê (<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE_NUMBER" ESCAPE="HTML"-->ÈÖÌÜ)</h3>\r
+<du>\r
+<dt>¥µ¥¤¥ºÌ¾</dt>\r
+<dd><input type="text" size="20"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->name"\r
+ value=""></dd>\r
+\r
+<dt>¥×¥é¥¤¥ª¥ê¥Æ¥£</dt>\r
+<dd>\r
+ <input type="radio" value="max"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority"\r
+ id="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority_max"\r
+ checked>\r
+ <label for="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority_max">°ìÈÖÂ礤¤¥µ¥¤¥º¤òºÎÍÑ</label>\r
+ <input type="radio" value="min"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority"\r
+ id="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority_min"\r
+ >\r
+ <label for="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->priority_min">°ìÈÖ¾®¤µ¤¤¥µ¥¤¥º¤òºÎÍÑ</label>\r
+</dd>\r
+\r
+<dt>½Ì¾®Î¨</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->ratio"\r
+ value="">(%)</dd>\r
+\r
+<dt>ºÇÂçĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->max"\r
+ value="">(px)</dd>\r
+\r
+<dt>²£ÊÕĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->x"\r
+ value="">(px)</dd>\r
+\r
+<dt>½ÄÊÕĹ</dt>\r
+<dd><input type="text" size="4"\r
+ name="<!--TMPL_VAR NAME="SIZE_NEW_NAMEBASE" ESCAPE="HTML"-->y"\r
+ value="">(px)</dd>\r
+\r
+<p>\r
+ <input type="submit" name="SAVE" value="Êݸ">\r
+ <input type="reset" value="¥ê¥»¥Ã¥È">\r
+</p>\r
OSDN Git Service
