/[suikacvs]/test/comma/cgi-bin/piclist.ja.cgi
Suika

Diff of /test/comma/cgi-bin/piclist.ja.cgi

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.6 by wakaba, Fri Mar 11 11:51:48 2005 UTC revision 1.7 by wakaba, Sat Mar 26 04:51:41 2005 UTC
# Line 54  sub filesize ($) { Line 54  sub filesize ($) {
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: $!";
# Line 76  sub has_file ($) { Line 85  sub has_file ($) {
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    
# Line 91  print <<EOH; Line 114  print <<EOH;
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>
# Line 126  if ($Opt{detail}) { Line 150  if ($Opt{detail}) {
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">&lt;<a href="$uri"$viewtarget>$uri</a>&gt;</code></dd>};        print qq{<code class="uri">&lt;<a href="$uri"$viewtarget>$uri</a>&gt;</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>};
# Line 212  if ($Opt{detail}) { Line 239  if ($Opt{detail}) {
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    
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.7
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24