/[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.3 by wakaba, Sun Aug 31 09:26:50 2003 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');    die;
26  }    #Suika::CGI::Error::die('open');
27    }
28  my $dir = $main::ENV{PATH_TRANSLATED};  
29  $dir =~ s#/LIST$##;  my $dir = $main::ENV{PATH_TRANSLATED};
30    $dir =~ s#/LIST$##;
31  opendir DIR, $dir or Suika::CGI::Error::die('open', $dir);  
32    my @files = readdir(DIR);  opendir DIR, $dir or die; #Suika::CGI::Error::die('open', $dir);
33  close DIR;    my @files = readdir(DIR);
34    close DIR;
35  for (@files) {  
36    undef $_ if /^\./;  for (@files) {
37    if (/(.+)\.(?:jpe?g|png)/i) {    undef $_ if /^\./;
38      $_ = $1;    if (/(.+)\.(?:jpe?g|png)/i) {
39    } else {undef $_}      $_ = $1;
40  }    } else {undef $_}
41    }
42  my $title = '写真一覧';  
43    my $title = '画像一覧';
44  if (-e $dir.'/-TITLE') {  
45    open TITLE, $dir.'/-TITLE';  if (-e $dir.'/-TITLE') {
46      ($title) = <TITLE>;    open TITLE, $dir.'/-TITLE';
47    close TITLE;      ($title) = <TITLE>;
48  }    close TITLE;
49  print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";  }
50    print STDOUT "Content-Type: text/html; charset=euc-jp\n\n";
51  #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 = '<link rel="stylesheet" href="/okuchuu/piclist-style" />'
53    unless $Suika::CGI::param{realsize};  my $linkelement = '<style type="text/css">img.s {width: 240px; height: 180px}</style>'
54  my $imgsattr = ' class="s"' unless $Suika::CGI::param{realsize};    unless $Suika::CGI::param{realsize};
55    my $imgsattr = ' class="s"' unless $Suika::CGI::param{realsize};
56  $| = '';  
57  print <<EOH;  $| = '';
58  <html>  print <<EOH;
59  <head>  <html>
60  <title>${title}</title>  <head>
61  ${linkelement}  <title>${title}</title>
62  </head>  ${linkelement}
63  <body>  </head>
64  <h1>${title}</h1>  <body>
65  <div class="pictures">  <h1>${title}</h1>
66  EOH  <div class="pictures">
67    EOH
68    
69  for (sort @files) {  
70    if ($_) {  for (sort @files) {
71      print '<a href="'.$_.'">';    if ($_) {
72      print '<img src="'.$_.'" alt="'.$_.'"'.$imgsattr.' />';      print '<a href="'.$_.'">';
73      print "</a>\n";      print '<img src="'.$_.'" alt="'.$_.'"'.$imgsattr.' />';
74    }      print "</a>\n";
75  }    }
76    }
77  print <<EOH;  
78  </div>  print <<EOH;
79    </div>
80  <address>  
81  [<a href="/">/</a>]  <address>
82  [<a href="/okuchuu/">伝説(謎)の「おくちゅ。」</a>]  [<a href="/">/</a>]
83  </address>  </address>
84  </body>  </body>
85  </html>  </html>
86  EOH  EOH
87    
88  1;  1;
89    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.3
admin@suikawiki.org
 ViewVC Help
Powered by ViewVC 1.1.24