/[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.5 by wakaba, Sat Feb 26 04:15:33 2005 UTC revision 1.6 by wakaba, Fri Mar 11 11:51:48 2005 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    unless (-d $dir) {
58    #  $dir =~ s#/+[^/]+$##;
59    }
60    
61  opendir DIR, $dir or die "$dir: $!";  opendir DIR, $dir or die "$dir: $!";
62    my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/}    my @all_files = sort grep {not /^\./ and /^[A-Za-z0-9._-]+$/}
63                    (readdir DIR)[0..1000];                    (readdir DIR)[0..1000];
# Line 77  sub has_file ($) { Line 79  sub has_file ($) {
79  my $title = '画像一覧';  my $title = '画像一覧';
80  my $dirpath = escape $ENV{REQUEST_URI};  my $dirpath = escape $ENV{REQUEST_URI};
81  $dirpath =~ s/\?.*$//;  $dirpath =~ s/\?.*$//;
82  $dirpath =~ s#/LIST$##;  $dirpath =~ s#/[^/]+$##;
83  $dirpath ||= '/';  $dirpath ||= '/';
84    
85  print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";  print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";
# Line 102  $LISTq = 'LIST' . ($LISTq ? '?' . $LISTq Line 104  $LISTq = 'LIST' . ($LISTq ? '?' . $LISTq
104  if ($Opt{cframe}) {  if ($Opt{cframe}) {
105    my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view';    my $LISTqt = ($LISTq eq 'LIST' ? $LISTq . '?' : $LISTq . ';') . 'target=view';
106    print qq{<frameset cols="25%,*">    print qq{<frameset cols="25%,*">
107               <frame src="$LISTqt" name="list">               <frame src="$LISTqt" name="list" />
108               <frame src="./" name="view">               <frame src="./" name="view" />
109               <noframes>};               <noframes>};
110  }  }
111    
# Line 130  if ($Opt{detail}) { Line 132  if ($Opt{detail}) {
132      shift @cls;      shift @cls;
133      print q{<div class="image-with-desc">};      print q{<div class="image-with-desc">};
134        print qq{<a href="$uri"$viewtarget>};        print qq{<a href="$uri"$viewtarget>};
135        print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}"></a>};        print qq{<img src="$uri" alt="" class="@{[join ' ', @cls, 's']}" /></a>};
136        print qq{<dl><dt>URI</dt><dd>};        print qq{<dl><dt>URI</dt><dd>};
137        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>};
138        print qq{<dt>ファイル名</dt><dd>};        print qq{<dt>ファイル名</dt><dd>};
# Line 148  if ($Opt{detail}) { Line 150  if ($Opt{detail}) {
150      my $uri = $efile;      my $uri = $efile;
151      $uri =~ s/\..+//g;      $uri =~ s/\..+//g;
152      print q{<div class="image-with-desc">};      print q{<div class="image-with-desc">};
153        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>};
154        print qq{<dl><dt>URI</dt><dd>};        print qq{<dl><dt>URI</dt><dd>};
155        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>};
156        print qq{<dt>ファイル名</dt><dd>};        print qq{<dt>ファイル名</dt><dd>};
# Line 168  if ($Opt{detail}) { Line 170  if ($Opt{detail}) {
170      print q{<div class="dir dir-with-desc">};      print q{<div class="dir dir-with-desc">};
171        if (-f $dir . '/' . $dir_name . '/favicon.png' or        if (-f $dir . '/' . $dir_name . '/favicon.png' or
172            -f $dir . '/' . $dir_name . '/favicon.ico') {            -f $dir . '/' . $dir_name . '/favicon.ico') {
173          print qq{<img src="$edir/favicon" alt="" class="mini-icon">};          print qq{<img src="$edir/favicon" alt="" class="mini-icon" />};
174        } else {        } else {
175          print qq{<img src="/icons/folder" alt="" class="mini-icon">};          print qq{<img src="/icons/folder" alt="" class="mini-icon" />};
176        }        }
177        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>};
178      print q{</div>};      print q{</div>};
# Line 188  if ($Opt{detail}) { Line 190  if ($Opt{detail}) {
190         ['current', '現行版']) {         ['current', '現行版']) {
191      if (has_file $_->[0]) {      if (has_file $_->[0]) {
192        print q{<div class="file file-with-desc">};        print q{<div class="file file-with-desc">};
193          print q{<img src="/icons/layout" alt="" class="mini-icon">};          print q{<img src="/icons/layout" alt="" class="mini-icon" />};
194          print qq{<a href="$_->[0]" rel="$_->[2]"$viewtarget>$_->[1]</a>};          print qq{<a href="$_->[0]" rel="$_->[2]"$viewtarget>$_->[1]</a>};
195        print q{</div>};        print q{</div>};
196      }      }
197    }    }
198    
199    print q{<div class="dir-up dir-with-desc">};    print q{<div class="dir-up dir-with-desc">};
200      print q{<img src="/icons/forward" alt="" class="mini-icon">};      print q{<img src="/icons/forward" alt="" class="mini-icon" />};
201      print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>};      print qq{<a href="../$LISTq" rel="up"$listtarget>上の階層</a>};
202    print q{</div>};    print q{</div>};
203        
# Line 231  my $cvslink = ''; Line 233  my $cvslink = '';
233  if (-d $dir . '/CVS') {  if (-d $dir . '/CVS') {
234    if (-f $dir . '/CVS/Root') {    if (-f $dir . '/CVS/Root') {
235      open my $root, '<', $dir . '/CVS/Root';      open my $root, '<', $dir . '/CVS/Root';
236      if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)$#) {      if (<$root> =~ m#^(/home/cvs|/home/wakaba/pub/cvs)/?$#) {
237        my $rpath = $1;        my $rpath = $1;
238        if (-f $dir . '/CVS/Repository') {        if (-f $dir . '/CVS/Repository') {
239          open my $repo, '<', $dir . '/CVS/Repository';          open my $repo, '<', $dir . '/CVS/Repository';
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24