/[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.1 by wakaba, Sat Aug 3 05:21:30 2002 UTC revision 1.2 by wakaba, Tue Aug 27 08:49:22 2002 UTC
# Line 1  Line 1 
1  #!/usr/local/bin/perl  #!/usr/local/bin/perl
2    
3  =pod  =pod
4    
5  Make list of pictures in directory.  Make list of pictures in directory.
6    
7  Copyright: Public Domain.  Copyright: Public Domain.
8    
9  Change:  Change:
10    
11  2001-06-25  wakaba <wakaba@61.201.226.127>  2001-06-25  wakaba <wakaba@61.201.226.127>
12    
13          - In default, images are sized by stylesheet.  When ?realsize=1,          - In default, images are sized by stylesheet.  When ?realsize=1,
14            images are not specified its size.            images are not specified its size.
15          - Images are linked to itself.          - Images are linked to itself.
16    
17  2001-05-17  wakaba  2001-05-17  wakaba
18    
19          - New File.          - New File.
20    
21  =cut  =cut
22    
23  use Suika::CGI;  use Suika::CGI;
24  unless ($main::ENV{PATH_TRANSLATED}) {  unless ($main::ENV{PATH_TRANSLATED}) {
25    Suika::CGI::Error::die('open');    Suika::CGI::Error::die('open');
26  }  }
27    
28  my $dir = $main::ENV{PATH_TRANSLATED};  my $dir = $main::ENV{PATH_TRANSLATED};
29  $dir =~ s#/LIST$##;  $dir =~ s#/LIST$##;
30    
31  opendir DIR, $dir or Suika::CGI::Error::die('open', $dir);  opendir DIR, $dir or Suika::CGI::Error::die('open', $dir);
32    my @files = readdir(DIR);    my @files = readdir(DIR);
33  close DIR;  close DIR;
34    
35  for (@files) {  for (@files) {
36    undef $_ if /^\./;    undef $_ if /^\./;
37    if (/(.+)\.(?:jpe?g|png)/i) {    if (/(.+)\.(?:jpe?g|png)/i) {
38      $_ = $1;      $_ = $1;
39    } else {undef $_}    } else {undef $_}
40  }  }
41    
42  my $title = '写真一覧';  my $title = '写真一覧';
43    
44  if (-e $dir.'/-TITLE') {  if (-e $dir.'/-TITLE') {
45    open TITLE, $dir.'/-TITLE';    open TITLE, $dir.'/-TITLE';
46      ($title) = <TITLE>;      ($title) = <TITLE>;
47    close TITLE;    close TITLE;
48  }  }
49  print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";  print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";
50    
51  #my $linkelement = '<link rel="stylesheet" href="/okuchuu/piclist-style" />'  #my $linkelement = '<link rel="stylesheet" href="/okuchuu/piclist-style" />'
52  my $linkelement = '<style type="text/css">img.s {width: 240px; height: 180px}</style>'  my $linkelement = '<style type="text/css">img.s {width: 240px; height: 180px}</style>'
53    unless $Suika::CGI::param{realsize};    unless $Suika::CGI::param{realsize};
54  my $imgsattr = ' class="s"' unless $Suika::CGI::param{realsize};  my $imgsattr = ' class="s"' unless $Suika::CGI::param{realsize};
55    
56  $| = '';  $| = '';
57  print <<EOH;  print <<EOH;
58  <html>  <html>
59  <head>  <head>
60  <title>${title}</title>  <title>${title}</title>
61  ${linkelement}  ${linkelement}
62  </head>  </head>
63  <body>  <body>
64  <h1>${title}</h1>  <h1>${title}</h1>
65  <div class="pictures">  <div class="pictures">
66  EOH  EOH
67    
68    
69  for (sort @files) {  for (sort @files) {
70    if ($_) {    if ($_) {
71      print '<a href="'.$_.'">';      print '<a href="'.$_.'">';
72      print '<img src="'.$_.'" alt="'.$_.'"'.$imgsattr.' />';      print '<img src="'.$_.'" alt="'.$_.'"'.$imgsattr.' />';
73      print "</a>\n";      print "</a>\n";
74    }    }
75  }  }
76    
77  print <<EOH;  print <<EOH;
78  </div>  </div>
79    
80  <address>  <address>
81  [<a href="/">/</a>]  [<a href="/">/</a>]
82  [<a href="/okuchuu/">伝説(謎)の「おくちゅ。」</a>]  </address>
83  </address>  </body>
84  </body>  </html>
85  </html>  EOH
86  EOH  
87    1;
88  1;  
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24