#!/usr/bin/perl -w
=head1 NAME
index.cgi - Show a listing of available utilties in the samples directories.
=cut
use strict;
use base qw(CGI::Ex::App);
use FindBin qw($Bin);
__PACKAGE__->navigate;
sub main_file_print {
return \ q{
CGI::Ex Samples
CGI::Ex Samples
Looking at directory: [% base %]
All of the samples in this directory should be ready to run. To
enable this directory you should use something similar to the following in your apache conf file:
ScriptAlias /samples/ /home/pauls/perl/CGI-Ex/samples/
<Location /samples/>
SetHandler perl-script
PerlResponseHandler ModPerl::PerlRun
Options +ExecCGI
</Location>
For mod_perl 1 you would use something similar to:
ScriptAlias /samples/ /home/pauls/perl/CGI-Ex/samples/
<Location /samples/>
SetHandler perl-script
PerlHandler Apache::PerlRun
Options +ExecCGI
</Location>
Application examples
[% FOREACH file = app.keys.sort ~%]
[% script_dir ~ file %] - [% app.$file %]
[% END -%]
Benchmark stuff
[% FOREACH file = bench.keys.sort ~%]
[% file %] - [% bench.$file %]
[% END -%]
Other files
[% FOREACH file = therest.keys.sort ~%]
[% file %] - [% therest.$file %]
[% END -%]
};
}
sub main_hash_swap {
my $self = shift;
my $base = $self->base_dir_abs;
my $hash = {};
my %file;
require File::Find;
File::Find::find(sub {
return if ! -f;
return if $File::Find::name =~ / CVS | ~$ | ^\# /x;
$File::Find::name =~ /^\Q$base\E(.+)/ || return;
my $name = $1;
my $desc = '';
if (open FH, "<$_") {
read FH, my $str, -s;
close FH;
if ($str =~ /^=head1 NAME\s+(.+)\s+^=cut\s+/m) {
$desc = $1;
$desc =~ s/^\w+(?:\.\w+)?\s+-\s+//;
}
}
$file{$name} = $desc;
}, $base);
$hash->{'base'} = $base;
$hash->{'script_dir'} = $ENV{'SCRIPT_NAME'} || $0;
$hash->{'script_dir'} =~ s|/[^/]+$||;
$hash->{'app'} = {map {$_ => $file{$_}} grep {/app/ && /\.cgi$/} keys %file};
$hash->{'bench'} = {map {$_ => $file{$_}} grep {/bench/ && /\.pl$/} keys %file};
$hash->{'therest'} = {map {$_ => $file{$_}} grep {! exists $hash->{'bench'}->{$_}
&& ! exists $hash->{'app'}->{$_}} keys %file};
return $hash;
}
sub base_dir_abs {
my $dir = $0;
$dir =~ s|/[^/]+$||;
return $dir;
}