Dogcows Code - chaz/p5-CGI-Ex/blob - samples/index.cgi

   1 #!/usr/bin/perl -w
   2
   3 =head1 NAME
   4
   5 index.cgi - Show a listing of available utilties in the samples directories.
   6
   7 =cut
   8
   9 use strict;
  10 use base qw(CGI::Ex::App);
  11 use FindBin qw($Bin);
  12
  13 __PACKAGE__->navigate;
  14
  15 sub main_file_print {
  16     return \ q{<html>
  17 <head><title>CGI::Ex Samples</title></head>
  18 <body>
  19 <h1>CGI::Ex Samples</h1>
  20 Looking at directory: [% base %]<br>
  21 All of the samples in this directory should be ready to run.  To
  22 enable this directory you should use something similar to the following in your apache conf file:
  23 <pre>
  24 ScriptAlias /samples/ /home/pauls/perl/CGI-Ex/samples/
  25 &lt;Location /samples/>
  26     SetHandler perl-script
  27     PerlResponseHandler ModPerl::PerlRun
  28     Options +ExecCGI
  29 &lt;/Location>
  30 </pre>
  31 For mod_perl 1 you would use something similar to:
  32 <pre>
  33 ScriptAlias /samples/ /home/pauls/perl/CGI-Ex/samples/
  34 &lt;Location /samples/>
  35     SetHandler perl-script
  36     PerlHandler Apache::PerlRun
  37     Options +ExecCGI
  38 &lt;/Location>
  39 </pre>
  40
  41 <h2>Application examples</h2>
  42 [% FOREACH file = app.keys.sort ~%]
  43 <a href="[% script_dir ~ file %]">[% script_dir ~ file %]</a> - [% app.$file %]<br>
  44 [% END -%]
  45
  46 <h2>Benchmark stuff</h2>
  47 [% FOREACH file = bench.keys.sort ~%]
  48 [% file %] - [% bench.$file %]<br>
  49 [% END -%]
  50
  51 <h2>Other files</h2>
  52 [% FOREACH file = therest.keys.sort ~%]
  53 [% file %] - [% therest.$file %]<br>
  54 [% END -%]
  55
  56 </body>
  57 </html>
  58     };
  59 }
  60
  61 sub main_hash_swap {
  62     my $self = shift;
  63     my $base = $self->base_dir_abs;
  64     my $hash = {};
  65     my %file;
  66
  67     require File::Find;
  68     File::Find::find(sub {
  69         return if ! -f;
  70         return if $File::Find::name =~ / CVS | ~$ | ^\# /x;
  71         $File::Find::name =~ /^\Q$base\E(.+)/ || return;
  72         my $name = $1;
  73         my $desc = '';
  74         if (open FH, "<$_") {
  75             read FH, my $str, -s;
  76             close FH;
  77             if ($str =~ /^=head1 NAME\s+(.+)\s+^=cut\s+/m) {
  78                 $desc = $1;
  79                 $desc =~ s/^\w+(?:\.\w+)?\s+-\s+//;
  80             }
  81         }
  82         $file{$name} = $desc;
  83     }, $base);
  84
  85     $hash->{'base'}    = $base;
  86
  87     $hash->{'script_dir'} = $ENV{'SCRIPT_NAME'} || $0;
  88     $hash->{'script_dir'} =~ s|/[^/]+$||;
  89
  90     $hash->{'app'}     = {map {$_ => $file{$_}} grep {/app/ && /\.cgi$/}    keys %file};
  91
  92     $hash->{'bench'}   = {map {$_ => $file{$_}} grep {/bench/ && /\.pl$/}   keys %file};
  93
  94     $hash->{'therest'} = {map {$_ => $file{$_}} grep {! exists $hash->{'bench'}->{$_}
  95                                                       && ! exists $hash->{'app'}->{$_}} keys %file};
  96
  97     return $hash;
  98 }
  99
 100 sub base_dir_abs {
 101     my $dir = $0;
 102     $dir =~ s|/[^/]+$||;
 103     return $dir;
 104 }
 105