X-Git-Url: https://git.dogcows.com/gitweb?a=blobdiff_plain;f=samples%2Findex.cgi;fp=samples%2Findex.cgi;h=eb9a3995818899adae553c63cd8cb2b7cae31977;hb=d710d6cd21be21c0ab2df3566c2bd61d9015cac6;hp=0000000000000000000000000000000000000000;hpb=d2b7c937e86e6e8c4b4193e9f4a8da075919b4fd;p=chaz%2Fp5-CGI-Ex diff --git a/samples/index.cgi b/samples/index.cgi new file mode 100755 index 0000000..eb9a399 --- /dev/null +++ b/samples/index.cgi @@ -0,0 +1,105 @@ +#!/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; +} +