index.cgi

   1 #!/usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5
   6 use CGI::Simple;
   7 use File::Find;
   8 use File::stat;
   9
  10 my $q = CGI::Simple->new({num=>100});
  11
  12 my $cat_dir = '/home/don/debian/.cat/';
  13
  14
  15 my %pics;
  16 find(sub {
  17          if (/\.html$/) {
  18              $pics{$_} = stat($_);
  19          }
  20       },
  21      $cat_dir);
  22
  23 print $q->header(-status => 200);
  24
  25 print <<EOF;
  26 <!DOCTYPE html>
  27 <html>
  28 <head>
  29 <title>Cat Pictures!</title>
  30 </head>
  31 <body>
  32 <header class="header"><span class="title">Cat Pictures!</span></header>
  33
  34 <section class="catpictures">
  35 EOF
  36
  37 my $num = 0;
  38 my $previous_date = '';
  39 for my $pic (sort {$pics{$b}->ctime <=> $pics{$a}->ctime} keys %pics) {
  40     my $this_date = POSIX::strftime('%Y-%m-%d',time($pics{$pic}->ctime));
  41     if ($previous_date ne $this_date){
  42         print "<p>$this_date</p>\n";
  43         $this_date = $previous_date;
  44     }
  45     my $basename = $pic;
  46     $basename =~ s/\.html//;
  47     print <<EOF;
  48 <a href="$pic"><img src="${basename}.jpg" width=100 height=100 alt="$basename"></a>
  49 EOF
  50     $num++;
  51     last if $num > 30;
  52 }
  53
  54 print <<EOF;
  55 </section>
  56 <footer>
  57 <span class="footer">A silly CGI script</span>
  58 </footer>
  59 </html>
  60 EOF
  61
  62 sub error {
  63     my ($q,$error,$text) = @_;
  64     $text //= '';
  65     print $q->header(-status => $error);
  66     print "<h2>$error: $text</h2>";
  67     exit 0;
  68 }