#!/usr/bin/perl -- use strict; use warnings; use lib '/home/dsktnk/local/lib/perl5'; use Path::Class; use CGI; use Image::Magick; my $obj = new CGI; my $path = $obj->param('d'); #sort my $sort = $obj->param('s'); $sort ||= "L"; my $view = $obj->param('i'); my $action = $obj->param('action'); #陦ィ遉コ縺輔○繧句ッセ雎。繝輔ぃ繧、繝ォ my $subject = '.html$|.txt$|.md$|.jpg$|.JPG$|.jpeg$|.gif$|.png$'; my $text = '.html$|.txt$|.md$'; if($path=~/\.\./o){$path='/home/dsktnk/www/memo/'}#螟峨↑繝�ぅ繝ャ繧ッ繝医Μ繧呈侍繧峨l縺ェ縺�◆繧� $path = "/home/dsktnk/www/memo/$path"; #$path ||= '/home/dsktnk/www/memo/'; $path //= '/home/dsktnk/www/memo/'; my $baseurl="http://dsktnk.sakura.ne.jp/memo/"; my $cgi ="http://dsktnk.sakura.ne.jp/memo/index.cgi"; ###繝�ぅ繝ャ繧ッ繝医Μ縺ョ繝ェ繧ケ繝医r菴懈� my @dir = dir($path)->children; my (@dirs,@files); for my $d (@dir){ if ($d->is_dir){ push(@dirs, $d); }else{ push(@files, $d) } } print qq|Content-type: text/html\n\n|; print &header_html; print qq|<h1><a href="$cgi">memo</a>|; # 繝代Φ縺上★繝ェ繧ケ繝� if ($path){ my $relative; my $path_a=$path; $path_a=~ s/\/home\/dsktnk\/www\/memo\///g; my @line = split ( /\// , $path_a ); for my $i (@line){ $relative .= "$i/"; print qq|<b class="">/<a href="$baseurl\index.cgi?d=$relative">$i</a></b>|; } print qq|</h1>|; } #----------------------------------------------------------------------- ###繝�ぅ繝ャ繧ッ繝医Μ繧定。ィ遉コ for my $d(@dirs){ my $basename = $d->basename; my $fileurl = $d->relative; print qq|<b class="dir"><a href="$baseurl\index.cgi?d=$fileurl/">$basename</a></b> |; } # 繧オ繝悶ョ繧」繝ャ繧ッ繝医Μ縺後≠繧句�エ蜷� if (defined $dirs[0] eq 1){ print qq|<hr>|; } if (defined $files[1] eq 1){ my $aaa = dir($path); my $bbb = $aaa->relative; #/memo/memo繧貞盾辣ァ縺励h縺�→縺吶k縺溘a縺ョ蟇セ遲� if($path =~ /\/home\/dsktnk\/www\/memo\/$/i){$bbb=''} print qq|<div><a href="$baseurl\index.cgi?d=$bbb&s=N">Name</a>��<a href="$baseurl\index.cgi?d=$bbb&s=L">Last modified</a>��<a href="$baseurl\index.cgi?d=$bbb&s=S">Size</a><div>|; print qq|<hr>|; } if (($path =~ /\/img/i)&&(defined $files[0] eq 1)){ my $aaa = dir($path); my $bbb = $aaa->relative; print qq|<a href="$baseurl\index.cgi?d=$bbb">list</a>�忿; print qq|<a href="$baseurl\index.cgi?d=$bbb&i=view">thumbnail</a>�忿; print qq|<a href="$baseurl\index.cgi?d=$bbb&i=gene">gene</a>|; print qq|<hr>|; } #----------------------------------------------------------------------- #繧ッ繧ィ繝ェ縺ォ蠢懊§縺ヲ繝輔ぃ繧、繝ォ繝ェ繧ケ繝医r繧ス繝シ繝医☆繧� #繝�ヵ繧ゥ繝ォ繝医�Last modified #name if($sort eq "N"){ @files = sort {$a->relative cmp $b->relative} @files; } #Last modified elsif($sort eq "L"){ @files = sort {$b->stat->mtime <=> $a->stat->mtime} @files; } #size elsif($sort eq "S"){ @files = sort {$b->stat->size <=> $a->stat->size} @files; } elsif($sort eq "all"){ my @files=&all; @files = sort {$b->stat->mtime <=> $a->stat->mtime} @files; if ((defined $files[0] eq 1)&&(! $view)){ for my $d(@files){ #繝輔ぃ繧、繝ォ繝阪�繝�蜿門セ� my $basename = $d->basename; my $fileurl = $d->relative; #譎る俣 my $mtime = localtime($d->stat->mtime); my ($sec, $min, $hour, $mday, $month, $year, $wday, $stime) = localtime($d->stat->mtime); $year += 1900; ++$month; my @wdays = ("譌・", "譛�", "轣ォ", "豌エ", "譛ィ", "驥�", "蝨�"); my $file_size = $d->stat->size; if ( $d =~ /$text/ ) { #Markdown蠖「蠑上□縺」縺溷�エ蜷医�蜃ヲ逅� if ( $d =~ (/.md$/) ){ printf "%04d/%02d/%02d %02d:%02d\n", $year, $month, $mday, $hour, $min, $sec; print qq|<a href="$baseurl\md.cgi?url=$baseurl$fileurl">$basename</a>縲$file_size(b)<br>|; } elsif($basename =~ /thumbnail_/){ next; }else{ printf "%04d/%02d/%02d %02d:%02d\n", $year, $month, $mday, $hour, $min, $sec; print qq|<a href="$baseurl$fileurl">$basename</a> $file_size(byte)<br>|; } } } } } #----------------------------------------------------------------------- #陦ィ遉コ驛ィ if ((defined $files[0] eq 1)&&(! $view)&&($sort ne "all")){ for my $d(@files){ #繝輔ぃ繧、繝ォ繝阪�繝�蜿門セ� my $basename = $d->basename; my $fileurl = $d->relative; #譎る俣 my $mtime = localtime($d->stat->mtime); my ($sec, $min, $hour, $mday, $month, $year, $wday, $stime) = localtime($d->stat->mtime); $year += 1900; ++$month; my @wdays = ("譌・", "譛�", "轣ォ", "豌エ", "譛ィ", "驥�", "蝨�"); my $file_size = $d->stat->size; if ( $d =~ /$subject/ ) { #Markdown蠖「蠑上□縺」縺溷�エ蜷医�蜃ヲ逅� if ( $d =~ (/.md$/) ){ printf "%04d/%02d/%02d %02d:%02d\n", $year, $month, $mday, $hour, $min, $sec; # print qq|<a href="$baseurl\md.cgi?url=$baseurl$fileurl">$basename</a>縲$file_size(b)<br>|; print qq|<a href="$baseurl$fileurl">$basename</a>縲$file_size(b)<br>|; } elsif($basename =~ /thumbnail_/){ next; }else{ printf "%04d/%02d/%02d %02d:%02d\n", $year, $month, $mday, $hour, $min, $sec; print qq|<a href="$baseurl$fileurl">$basename</a> $file_size(byte)<br>|; } } } } #----------------------------------------------------------------------- #img縺ォ髢「縺吶k if (($path)&&($view eq "view")){ for my $d(@files){ #繝輔ぃ繧、繝ォ繝阪�繝�蜿門セ� my $basename = $d->basename; my $fileurl = $d->relative; if ( $basename =~ /$subject/i ) { if ($basename =~/thumbnail/){ my $cuturl = $fileurl; $cuturl=~ s/thumbnail_//g; print qq|<a href="$baseurl$cuturl" target="_blank"><img src="$baseurl$fileurl"></a>\n|; } } } } if (($path)&&($view eq "gene")){ for my $d(@files){ #繝輔ぃ繧、繝ォ繝阪�繝�蜿門セ� my $basename = $d->basename; my $fileurl = $d->relative; if ( $basename =~ /$subject/i ) { #print qq|<img src="$baseurl$fileurl">|; #print $fileurl; if($basename !~ /thumbnail_/){ #繝ェ繧オ繧、繧コ蜃ヲ逅� my $newwidth = 150; my $newheight = 150; my $i = Image::Magick->new; $i->Read("./$fileurl"); #$i = $i->Transform(geometry=>$newwidth,height=>$newheight); $i->Resize(width => $newwidth,height => $newheight); binmode(STDOUT); my $jpgname = "thumbnail_$basename"; $i->Write("$path/$jpgname"); #print ("Content-type: image/jpeg\n\n"); #$i->Write('jpg:-'); #print qq|<img src="$baseurl$fileurl">|; } } } print "繧オ繝�繝阪う繝ォ繧堤函謌舌@縺セ縺励◆"; } print qq|</article>\n|; print qq|</body>\n|; print qq|</html>|; #----------------------------------------------------------------------- #form if ($action eq "edit"){ print &form_html; } #Debug逕ィ繝代せ陦ィ遉コ #print $path; sub header_html{ my $printlines = <<"__EOF__"; <?xml version="1.0" encoding="utf-8"?> <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.1//EN" "http://www.w3.org/TR/xhtml11/DTD/xhtml11.dtd"> <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="ja"> <head> <meta http-equiv="Content-Type" content="text/html; charset=utf-8" /> <meta http-equiv="Content-Style-Type" content="text/css" /> <meta name="author" content="dsk" /> <link rel="stylesheet" href="http://dsktnk.sakura.ne.jp/test/github-markdown-css/github-markdown.css" type="text/css"> <link rel="stylesheet" type="text/css" href="http://fonts.googleapis.com/css?family=Jura"> </head> <style> .markdown-body { min-width: 200px; max-width: 790px; margin: 0 auto; padding: 30px; } </style> <body> <article class="markdown-body"> __EOF__ return $printlines; } sub form_html{ my $printlines = <<"__EOF__"; <form action="/my-handling-form-page" method="post"> <div> <label for="filename">Name:</label> <input type="text" id="name" /> </div> <div> <label for="mail">E-mail:</label> <input type="email" id="mail" /> </div> <div> <label for="msg">Message:</label> <textarea id="msg"></textarea> </div> <div class="button"> <button type="submit">Send your message</button> </div> </form> __EOF__ return $printlines; } sub all{ my @files; Path::Class::Dir->new("/home/dsktnk/www/memo")->recurse( callback => sub { my $file = shift; return if $file->is_dir; #繝�ぅ繝ャ繧ッ繝医Μ縺ッ繧ケ繧ュ繝�� push(@files, $file); }, ); return @files; }