54 |
} |
} |
55 |
} |
} |
56 |
|
|
57 |
|
my $dirpath = escape $ENV{REQUEST_URI}; |
58 |
|
$dirpath =~ s/\#.*$//; |
59 |
|
$dirpath =~ s/\?.*$//; |
60 |
|
$dirpath =~ s/,[^,]*$//g; |
61 |
unless (-d $dir) { |
unless (-d $dir) { |
62 |
# $dir =~ s#/+[^/]+$##; |
$dir =~ s#/+[^/]+$##; |
63 |
|
$dirpath =~ s#/[^/]+$#/#; |
64 |
|
$dirpath ||= '/'; |
65 |
|
} else { |
66 |
|
$dirpath =~ s#/LIST$##; |
67 |
|
$dirpath =~ s#/?$#/#; |
68 |
} |
} |
69 |
|
|
70 |
opendir DIR, $dir or die "$dir: $!"; |
opendir DIR, $dir or die "$dir: $!"; |
85 |
return 0; |
return 0; |
86 |
} |
} |
87 |
|
|
88 |
|
sub preview_uri ($) { |
89 |
|
my $original_file_name = shift; |
90 |
|
$original_file_name =~ s/\..*$//; |
91 |
|
my $file_name = $original_file_name; |
92 |
|
if ($file_name =~ /-small$/) { |
93 |
|
return $file_name; |
94 |
|
} else { |
95 |
|
$file_name =~ s/-large$//; |
96 |
|
if (has_file $file_name . '-small') { |
97 |
|
return $file_name . '-small'; |
98 |
|
} elsif (has_file $file_name) { |
99 |
|
return $file_name; |
100 |
|
} else { |
101 |
|
return $original_file_name; |
102 |
|
} |
103 |
|
} |
104 |
|
} |
105 |
|
|
106 |
my $title = '画像一覧'; |
my $title = '画像一覧'; |
|
my $dirpath = escape $ENV{REQUEST_URI}; |
|
|
$dirpath =~ s/\?.*$//; |
|
|
$dirpath =~ s#/[^/]+$##; |
|
|
$dirpath ||= '/'; |
|
107 |
|
|
108 |
print STDOUT "Content-Type: text/html; charset=euc-jp\n\n"; |
print STDOUT "Content-Type: text/html; charset=euc-jp\n\n"; |
109 |
|
|
114 |
<!DOCTYPE html SYSTEM> |
<!DOCTYPE html SYSTEM> |
115 |
<html lang="ja"> |
<html lang="ja"> |
116 |
<head> |
<head> |
117 |
|
<base href="http://suika.fam.cx$dirpath" /> |
118 |
<title>@{[$Opt{cframe} ? '' : qq<$dirpath の>]}${title}</title> |
<title>@{[$Opt{cframe} ? '' : qq<$dirpath の>]}${title}</title> |
119 |
${linkelement} |
${linkelement} |
120 |
</head> |
</head> |
150 |
|
|
151 |
for my $file_name (@files) { |
for my $file_name (@files) { |
152 |
my $efile = escape $file_name; |
my $efile = escape $file_name; |
153 |
|
my $preview_uri = escape preview_uri $file_name; |
154 |
my $uri = $efile; |
my $uri = $efile; |
155 |
$uri =~ s/\..+//g; |
$uri =~ s/\..+//g; |
156 |
my @cls = split /\./, lc $file_name; |
my @cls = split /\./, lc $file_name; |
157 |
shift @cls; |
shift @cls; |
158 |
print q{<div class="image-with-desc">}; |
print q{<div class="image-with-desc">}; |
159 |
print qq{<a href="$uri"$viewtarget>}; |
print qq{<a href="$uri"$viewtarget>}; |
160 |
print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>}; |
print qq{<img src="$preview_uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>}; |
161 |
print qq{<dl><dt>URI</dt><dd>}; |
print qq{<dl><dt>URI</dt><dd>}; |
162 |
print qq{<code class="uri"><<a href="$uri"$viewtarget>$uri</a>></code></dd>}; |
print qq{<code class="uri"><<a href="$uri"$viewtarget>$uri</a>></code></dd>}; |
163 |
print qq{<dt>ファイル名</dt><dd>}; |
print qq{<dt>ファイル名</dt><dd>}; |
164 |
print qq{<code class="file"><a href="$efile"$viewtarget>$efile</a></code></dd>}; |
print qq{<code class="file"><a href="$efile"$viewtarget>$efile</a></code></dd>}; |
165 |
print qq{<dt>日付</dt><dd>}; |
print qq{<dt>日付</dt><dd>}; |
166 |
print rfc3339date ([stat $dir.'/'.$file_name]->[9]); |
print rfc3339date ([stat $dir.'/'.$file_name]->[9]); |
167 |
|
print qq{<dt>大きさ</dt><dd>}; |
168 |
|
print filesize ([stat $dir.'/'.$file_name]->[7]); |
169 |
print qq{</dd>}; |
print qq{</dd>}; |
170 |
print qq{</dl>}; |
print qq{</dl>}; |
171 |
print q{</div>}; |
print q{</div>}; |
239 |
for my $file_name (@files) { |
for my $file_name (@files) { |
240 |
my $uri = escape $file_name; |
my $uri = escape $file_name; |
241 |
$uri =~ s/\..+$//g; |
$uri =~ s/\..+$//g; |
242 |
|
my $preview_uri = escape preview_uri $file_name; |
243 |
print '<a href="'.$uri.'"'.$viewtarget.'>'; |
print '<a href="'.$uri.'"'.$viewtarget.'>'; |
244 |
print '<img src="'.$uri.'" alt="'.$uri.'"'.$imgsattr.' />'; |
print '<img src="'.$preview_uri.'" alt="'.$uri.'"'.$imgsattr.' />'; |
245 |
print "</a>\n"; |
print "</a>\n"; |
246 |
} |
} |
247 |
|
|