/[suikacvs]/okuchuu/piclist.ja.cgi
Suika

Diff of /okuchuu/piclist.ja.cgi

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

revision 1.5 by wakaba, Sat Feb 26 04:15:33 2005 UTC revision 1.8 by wakaba, Thu Nov 22 12:50:09 2007 UTC
# Line 8  piclist - Making List of Pictures in a D Line 8  piclist - Making List of Pictures in a D
8    
9  =cut  =cut
10    
11  unless ($main::ENV{PATH_TRANSLATED}) {  my $dir = $main::ENV{PATH_TRANSLATED}
12    die "BAD PATH_TRANSLATED";    or die "BAD PATH_TRANSLATED: $ENV{PATH_TRANSLATED}";
 }  
13    
14  my %Opt;  my %Opt;
15    
16  my $dir = $main::ENV{PATH_TRANSLATED};  if ($dir =~ s#/[^/]+$##) {
 if ($dir =~ s#/LIST$##) {  
17    for (split /[&;]/, $ENV{QUERY_STRING}) {    for (split /[&;]/, $ENV{QUERY_STRING}) {
18      my ($name, $val) = split /=/, $_, 2;      my ($name, $val) = split /=/, $_, 2;
19      $Opt{$name} = defined $val ? $val : 1;      $Opt{$name} = defined $val ? $val : 1;
# Line 56  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) {
62      $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: $!";
71    my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/}    my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/}
72                    (readdir DIR)[0..1000];                    (readdir DIR)[0..1000];
# Line 74  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#/LIST$##;  
 $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 89  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 102  $LISTq = 'LIST' . ($LISTq ? '?' . $LISTq Line 128  $LISTq = 'LIST' . ($LISTq ? '?' . $LISTq
128  if ($Opt{cframe}) {  if ($Opt{cframe}) {
129    my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view';    my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view';
130    print qq{<frameset cols="25%,*">    print qq{<frameset cols="25%,*">
131               <frame src="$LISTqt" name="list">               <frame src="$LISTqt" name="list" />
132               <frame src="./" name="view">               <frame src="./" name="view" />
133               <noframes>};               <noframes>};
134  }  }
135    
# Line 124  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 $id = uc $uri;
157      my @cls = split /\./, lc $file_name;      my @cls = split /\./, lc $file_name;
158      shift @cls;      shift @cls;
159      print q{<div class="image-with-desc">};      print qq{<div class="image-with-desc" id="FILE--$id">};
160        print qq{<a href="$uri"$viewtarget>};        print qq{<a href="$uri"$viewtarget>};
161        print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}"></a>};        print qq{<img src="$preview_uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>};
162        print qq{<dl><dt>URI</dt><dd>};        print qq{<dl><dt>URI</dt><dd>};
163        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>};
164        print qq{<dt>ファイル名</dt><dd>};        print qq{<dt>ファイル名</dt><dd>};
165        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>};
166        print qq{<dt>日付</dt><dd>};        print qq{<dt>日付</dt><dd>};
167        print rfc3339date ([stat $dir.'/'.$file_name]->[9]);        print rfc3339date ([stat $dir.'/'.$file_name]->[9]);
168          print qq{<dt>大きさ</dt><dd>};
169          print filesize ([stat $dir.'/'.$file_name]->[7]);
170        print qq{</dd>};        print qq{</dd>};
171        print qq{</dl>};        print qq{</dl>};
172      print q{</div>};      print q{</div>};
# Line 148  if ($Opt{detail}) { Line 178  if ($Opt{detail}) {
178      my $uri = $efile;      my $uri = $efile;
179      $uri =~ s/\..+//g;      $uri =~ s/\..+//g;
180      print q{<div class="image-with-desc">};      print q{<div class="image-with-desc">};
181        print qq{<a href="$uri"$viewtarget><img src="/~wakaba/archive/2005/movie-1" alt=""></a>};        print qq{<a href="$uri"$viewtarget><img src="/~wakaba/archive/2005/movie-1" alt="" /></a>};
182        print qq{<dl><dt>URI</dt><dd>};        print qq{<dl><dt>URI</dt><dd>};
183        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>};
184        print qq{<dt>ファイル名</dt><dd>};        print qq{<dt>ファイル名</dt><dd>};
# Line 168  if ($Opt{detail}) { Line 198  if ($Opt{detail}) {
198      print q{<div class="dir dir-with-desc">};      print q{<div class="dir dir-with-desc">};
199        if (-f $dir . '/' . $dir_name . '/favicon.png' or        if (-f $dir . '/' . $dir_name . '/favicon.png' or
200            -f $dir . '/' . $dir_name . '/favicon.ico') {            -f $dir . '/' . $dir_name . '/favicon.ico') {
201          print qq{<img src="$edir/favicon" alt="" class="mini-icon">};          print qq{<img src="$edir/favicon" alt="" class="mini-icon" />};
202        } else {        } else {
203          print qq{<img src="/icons/folder" alt="" class="mini-icon">};          print qq{<img src="/icons/folder" alt="" class="mini-icon" />};
204        }        }
205        print qq{<code class="file"><a href="$edir/$LISTq"$listtarget>$edir/</a></code>};        print qq{<code class="file"><a href="$edir/$LISTq"$listtarget>$edir/</a></code>};
206      print q{</div>};      print q{</div>};
# Line 188  if ($Opt{detail}) { Line 218  if ($Opt{detail}) {
218         ['current', '現行版']) {         ['current', '現行版']) {
219      if (has_file $_->[0]) {      if (has_file $_->[0]) {
220        print q{<div class="file file-with-desc">};        print q{<div class="file file-with-desc">};
221          print q{<img src="/icons/layout" alt="" class="mini-icon">};          print q{<img src="/icons/layout" alt="" class="mini-icon" />};
222          print qq{<a href="$_->[0]" rel="$_->[2]"$viewtarget>$_->[1]</a>};          print qq{<a href="$_->[0]" rel="$_->[2]"$viewtarget>$_->[1]</a>};
223        print q{</div>};        print q{</div>};
224      }      }
225    }    }
226    
227    print q{<div class="dir-up dir-with-desc">};    print q{<div class="dir-up dir-with-desc">};
228      print q{<img src="/icons/forward" alt="" class="mini-icon">};      print q{<img src="/icons/forward" alt="" class="mini-icon" />};
229      print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>};      print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>};
230    print q{</div>};    print q{</div>};
231        
# Line 210  if ($Opt{detail}) { Line 240  if ($Opt{detail}) {
240    for my $file_name (@files) {    for my $file_name (@files) {
241      my $uri = escape $file_name;      my $uri = escape $file_name;
242      $uri =~ s/\..+$//g;      $uri =~ s/\..+$//g;
243        my $preview_uri = escape preview_uri $file_name;
244      print '<a href="'.$uri.'"'.$viewtarget.'>';      print '<a href="'.$uri.'"'.$viewtarget.'>';
245      print '<img src="'.$uri.'" alt="'.$uri.'"'.$imgsattr.' />';      print '<img src="'.$preview_uri.'" alt="'.$uri.'"'.$imgsattr.' />';
246      print "</a>\n";      print "</a>\n";
247    }    }
248    
# Line 231  my $cvslink = ''; Line 262  my $cvslink = '';
262  if (-d $dir . '/CVS') {  if (-d $dir . '/CVS') {
263    if (-f $dir . '/CVS/Root') {    if (-f $dir . '/CVS/Root') {
264      open my $root, '<', $dir . '/CVS/Root';      open my $root, '<', $dir . '/CVS/Root';
265      if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)$#) {      if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)/?$#) {
266        my $rpath = $1;        my $rpath = $1;
267        if (-f $dir . '/CVS/Repository') {        if (-f $dir . '/CVS/Repository') {
268          open my $repo, '<', $dir . '/CVS/Repository';          open my $repo, '<', $dir . '/CVS/Repository';
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.8
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24