|
$key | +$val | +
\n"; - my $url_base=&{$W->{"mailman_url_sub"}}()."/subscribe/$list"; - my $t=LWP::Simple::get("$url_base?" - .join('&', - "list=$list", - map({ $_."=".uri_escape($W->{"args"}{$_}); } qw(email pw pw-conf)))); + my $url_base=$W->{"mailman_url"}."/subscribe/$list"; + my $url=URI->new($url_base); + $url->query_form( + "list"=>$list, + map(($_=>$W->{"args"}{$_}),qw(email pw pw-conf)), + ); + my $t=LWP::Simple::get($url); $t=($t=~m#^.*]*>(.*?)#is)[0]; $t=~s#(href=")(../[^"]*)(")#$1$url_base/$2$3#gi; print $t; @@ -66,4 +71,6 @@ if ($W->{"args"}{"back"}) { } -My::Web->footer(); +exit; +} +1; diff --git a/Makefile-head.am b/Makefile-head.am index 40656bc..d31c09c 100644 --- a/Makefile-head.am +++ b/Makefile-head.am @@ -19,30 +19,36 @@ # Set all needed variables to their empty values to prevent "variable `...' not defined" # Any further settings should be done exclusively by += operator EXTRA_DIST= -BUILT_SOURCES= CLEANFILES= MAINTAINERCLEANFILES= -noinst_DATA= +TESTS= # Force delete of target file if command fails. # Generally better behaviour but it requires GNU make. Harmless otherwise. .DELETE_ON_ERROR: -%.ppm: %.fig Makefile - fig2dev -L ppm -S4 -m1.75 -b10 $< | pnmgamma 0.4 >$@ +# This target is used for "httpd.conf.pl" generator. +MODPERL_PM= +EXTRA_DIST+=$(MODPERL_PM) +MODPERL_PM-print: $(MODPERL_PM) + @echo "MODPERL_PM:$(subdir):$(MODPERL_PM)" + @for subdir in . $(SUBDIRS);do \ + if test "$$subdir" = . -o "$$subdir" = intl -o "$$subdir" = po -o "$$subdir" = m4;then :;else \ + (cd "$$subdir" && $(MAKE) $(AM_MAKEFLAGS) $@) || exit 1; \ + fi; \ + done -%.gif: %.ppm - ppmquant -quiet 256 $< | ppmtogif -quiet -sort >$@ +# PiNG is our exchange format. Prevent: make: Circular %.ppm <- %.EXT dependency dropped. -# Prevent: make: Circular %.ppm <- %.gif dependency dropped. -#%.ppm: %.gif -# giftopnm $< >$@ +# Prevent gs(1) EPIPE as it writes about 2x more data out: ( ... ;cat >/dev/null) +%.png: %.fig Makefile + $(PATH_FIG2DEV) -L ppm -S4 -m1.75 -b10 $< | ($(PATH_PNMGAMMA) 0.4;cat >/dev/null) | $(PATH_PNMTOPNG) >$@ -%.png: %.ppm - pnmtopng $< >$@ +%.png: %-badgamma.ppm + $(PATH_PNMGAMMA) 0.4 <$< | $(PATH_PNMTOPNG) >$@ -%.ppm: %.png - pngtopnm $< >$@ +%.gif: %.png + $(PATH_PNGTOPNM) $< | $(PATH_PPMQUANT) -quiet 256 | $(PATH_PPMTOGIF) -quiet -sort >$@ %.png: %.dia $(top_srcdir)/dia-w.sh $(top_srcdir)/dia-w.sh --nosplash --export $@ $< diff --git a/Makefile.am b/Makefile.am index cf27f8b..2749d39 100644 --- a/Makefile.am +++ b/Makefile.am @@ -53,12 +53,24 @@ ChangeLog: endif +CLEANFILES+=httpd.conf +EXTRA_DIST+=httpd.conf.pl + +httpd.conf: httpd.conf.pl Makefile project/Makefile + perl -I$$PWD ./$< >$@ + +TESTS+=html-test + +html-test: + ./$@.pl + EXTRA_DIST+= \ - Index.html.pl \ - WebConfig.pm \ - Redirect.pl \ - have_js.js.pl \ - robots.txt \ - SendMsg.pl \ - Contact.html.pl \ - Mailman.pl + WebConfig.pm \ + robots.txt \ + html-test.pl + +MODPERL_PM+= \ + Index.pm \ + Contact.pm \ + Mailman.pm + diff --git a/Redirect.pl b/Redirect.pl deleted file mode 100755 index 327ef14..0000000 --- a/Redirect.pl +++ /dev/null @@ -1,41 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# URL redirector of &My::Web::a_href Perl template. -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package Redirect; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -use Apache::Constants qw(MOVED); - - -my $W=My::Web->init( - "__PACKAGE__"=>__PACKAGE__, - "header_only"=>1, - "args_check"=>{ - "location"=>'^\w+://', - }, - ); -$W->{"r"}->status(MOVED); -$W->{"r"}->header_out("Location"=>$W->{"args"}{"location"}); diff --git a/SendMsg.pl b/SendMsg.pl deleted file mode 100755 index 1f7b4fb..0000000 --- a/SendMsg.pl +++ /dev/null @@ -1,59 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Quick Send Message -# Copyright (C) 2003 Jan Kratochvil -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package SendMsg; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -use Apache::Constants qw(HTTP_NO_CONTENT); -require Mail::Send; - - -my $W=My::Web->init( - "__PACKAGE__"=>__PACKAGE__, - "header_only"=>1, - "args_check"=>{ - "msgscript"=>'', # If 'text/javascript' is supported. - "msghtml"=>'', # No 'text/javascript' available. - }, - ); -my $msg=$W->{"args"}{"msghtml"} || $W->{"args"}{"msgscript"}; -if ($msg) { - - my $subject=$msg.' @'.$W->{"r"}->uri(); - print STDERR "Message: $subject\n"; - - my $send=Mail::Send->new(); - $send->to(split /,/,$W->{"SendMsg_to"}); - $send->subject($subject); - my $fh=$send->open(); - print $fh "$subject\n\n"; - for (sort keys %ENV) { - print $fh $_."=".$ENV{$_}."\n"; - } - $fh->close(); # send it here - - } -$W->{"r"}->status(HTTP_NO_CONTENT); diff --git a/WebConfig.pm b/WebConfig.pm index 76a2970..1b3ea33 100644 --- a/WebConfig.pm +++ b/WebConfig.pm @@ -32,83 +32,74 @@ use vars qw(@ISA @EXPORT); @EXPORT=qw(%WebConfig); use My::Web; -require CGI; -my $resume_url="/resume/Resume-JanKratochvil.html.pl/Resume-JanKratochvil.html"; +my $resume_url="/resume/ResumeJanKratochvil.pm/ResumeJanKratochvil.html"; +# Only to be used privately by My::Web ! our %WebConfig=( "admin_mail"=>'web-www.jankratochvil.net@jankratochvil.net', - "SendMsg_to"=>'web-www.jankratochvil.net@jankratochvil.net', - "cvs_id_author"=>sub { + "cvs_id_author_sub"=>sub { my($name)=@_; return My::Web::a_href("http://www.jankratochvil.net/","Jan Kratochvil") if 0 || $name eq "short" || $name eq "lace"; - return CGI::escapeHTML($name); + return escapeHTML($name); }, + "viewcvs_My"=>"http://cvs.jankratochvil.net/viewcvs/MyWeb/", "viewcvs"=>"http://cvs.jankratochvil.net/viewcvs/www/www.jankratochvil.net/", "title_prefix"=>"Jan Kratochvil", - "footer_mailme"=>0, "project_viewcvs"=>"http://cvs.jankratochvil.net/viewcvs/", "pserver"=>':pserver:pserver:@cvs.jankratochvil.net', "pserver_path"=>"/cvs", "resume_url"=>$resume_url, - "web_hostname_sub"=>sub () { return "www.jankratochvil.net"; }, # $My::Web::W->{"r"}->hostname() - "mailman_url_sub" =>sub () { return "http://".&{$My::Web::W->{"web_hostname_sub"}}."/mailman/"; }, - "pipermail_url_sub"=>sub () { return "http://".&{$My::Web::W->{"web_hostname_sub"}}."/pipermail/"; }, + "mailman_url" =>sub { return "http://".$My::Web::W->{"web_hostname"}."/mailman/"; }, + "pipermail_url"=>sub { return "http://".$My::Web::W->{"web_hostname"}."/pipermail/"; }, "heading"=>sub () { - print ' '."\n"; -# print '
'."\n"; + if (!$My::Web::W->{"heading_novskip"}) { + $r.="'."\n"; -# print ' '."\n"; -# print ' '."\n"; - print ' '."\n"; - print ' '."\n"; - print ' '."\n"; + $r.=''."\n"; - print '
'; + $r.=''."\n"; - print ' '."\n"; - print 'Jan Kratochvil'; -# print My::Web::a_href('http://www.jankratochvil.net/','Jan Kratochvil', + my $r=""; + $r.=' '."\n"; - if (!$My::Web::W->{"WebConfig::heading_novskip"}) { - print "
'."\n"; + # Do not: '."\n"; - print '+ # as the constant are always bad. + $r.=' '."\n"; + $r.=' '."\n"; - print '' + .'
'; - print ''."\n"; - print ' '."\n"; + $r.='Jan Kratochvil'; +# $r.=My::Web::a_href('http://www.jankratochvil.net/','Jan Kratochvil', # "attr"=>'style="text-decoration: inherit; /* revoke underline */;"'); - print ' '."\n"; - print ''."\n"; - print ' '."\n"; - print ''."\n"; - print '
'."\n"; - print ''."\n"; - my @sections=( - "/project/"=>"Projects", - "http://cvs.jankratochvil.net/"=>"CVS", -# "/News.html.pl"=>"News", - $resume_url=>"Resume", - "/Contact.html.pl"=>"Contact", - ); - while (@sections) { - my $section_path=shift @sections; - my $section_name=shift @sections; - print ' '."\n"; - print ''; - print(($My::Web::W->{"section"} || "") eq $section_name ? "$section_name" - : My::Web::a_href($section_path,$section_name, - "attr"=>'style="text-decoration: inherit; /* revoke underline */;"')); - print " \n"; - } - print '
\n"; - print My::Web::vskip("6ex"); + $r.=''."\n"; + $r.=' '."\n"; + $r.='' + .'
'."\n"; + $r.=''."\n"; + my @sections=( + "/project/"=>"Projects", + "http://cvs.jankratochvil.net/"=>"CVS", +# "/News.pm"=>"News", + $resume_url=>"Resume", + "/Contact.pm"=>"Contact", + ); + while (@sections) { + my $section_path=shift @sections; + my $section_name=shift @sections; + $r.=' '; + $r.=(($My::Web::W->{"section"} || "") eq $section_name ? "$section_name" + : My::Web::a_href($section_path,$section_name, + "attr"=>'style="text-decoration: inherit; /* revoke underline */;"')); + $r.=" \n"; + } + $r.='
\n"; + $r.=My::Web::vskip("6ex"); } + return $r; }, - "footing"=>sub () { -# print "footing
\n"; - }, - "footing_delimit"=>sub () { + ###"footing"=>"footing
\n", + "footing_delimit_sub_push"=>sub () { return if $My::Web::W->{"no_job"}; print <<"HERE";@@ -125,6 +116,7 @@ our %WebConfig=( HERE }, "no_job"=>1, + "css_inherit"=>1, ); 1; diff --git a/autogen.pl b/autogen.pl index d1c9fc2..acc0bf8 100755 --- a/autogen.pl +++ b/autogen.pl @@ -38,8 +38,10 @@ AutoGen->run( "clean"=>[qw( .xvpics ./ChangeLog.bak + ./httpd.conf ./INSTALL ./dia-w.sh + ./project/SUBDIRS ./project/Nokia61/Nokia61 ./project/Nokia61/Nokia61_23.cache ./project/line9k/line9k.png @@ -60,7 +62,6 @@ AutoGen->run( ./resume/*.aux ./resume/*.log ./resume/*.out - ./resume/Resume-JanKratochvil-face.pdf ./etmms/*.dia~ ./project/TraceFS/*.gif ./project/pgsqlsubstr/*.gif diff --git a/configure.ac b/configure.ac index 57922d6..7821e25 100644 --- a/configure.ac +++ b/configure.ac @@ -16,13 +16,26 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -AC_INIT(./Makefile-head.am) +AC_INIT(./project/ChangeLog.pm) AM_INIT_AUTOMAKE(www.jankratochvil.net,1.0cvs) AM_MAINTAINER_MODE +AC_DEFUN([PATH_PROG_CHECKED], +[ + AC_PATH_PROG($1,$2) + eval 'echo $'$1|grep >/dev/null . || AC_MSG_ERROR([Program '$2' not found.]) +]) + AC_PATH_PROG(PATH_XVNC,Xvnc) AC_PATH_PROG(PATH_BC,bc) -AC_PATH_PROG(PATH_DIA,dia) +PATH_PROG_CHECKED(PATH_DIA,dia) +PATH_PROG_CHECKED(PATH_FLOCK,flock) +PATH_PROG_CHECKED(PATH_FIG2DEV,fig2dev) +PATH_PROG_CHECKED(PATH_PPMQUANT,ppmquant) +PATH_PROG_CHECKED(PATH_PPMTOGIF,ppmtogif) +PATH_PROG_CHECKED(PATH_PNMTOPNG,pnmtopng) +PATH_PROG_CHECKED(PATH_PNGTOPNM,pngtopnm) +PATH_PROG_CHECKED(PATH_PNMGAMMA,pnmgamma) dnl "Makefile" output files MUST have pathnames incl./excl. "./" prefix as specified! AC_OUTPUT([ @@ -30,6 +43,7 @@ Makefile ./dia-w.sh ./macros/Makefile ./My/Makefile +./My/Hash/Makefile ./resume/Makefile ./etmms/Makefile ./project/Makefile diff --git a/etmms/Index.html.pl b/etmms/Index.pm old mode 100755 new mode 100644 similarity index 90% rename from etmms/Index.html.pl rename to etmms/Index.pm index 3481e7d..9bc6a44 --- a/etmms/Index.html.pl +++ b/etmms/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ # Contact page Perl template. -# Copyright (C) 2003 Jan Kratochvil
+# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package Contact; +package etmms::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway use vars qw($VERSION $CVS_ID); $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; @@ -26,14 +24,13 @@ $CVS_ID=q$Id$; use strict; use warnings; -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } use My::Web; -require CGI; -Wrequire 'My::Project'; +Wrequire 'project::Lib'; +sub handler +{ my $W=My::Web->init( - "__PACKAGE__"=>__PACKAGE__, "title"=>"MMS Center Debugging", ); My::Web->heading(); @@ -43,8 +40,8 @@ sub project ($) { my($name)=@_; - my %name_item=( My::Project->one_item_list_read($name) ); - return a_href "/project/$name/",$name_item{"name"}.': '.$name_item{"summary"}; + my $name_item=project::Lib->name_to_hashref($name); + return a_href "/project/$name/",$name_item->{"name"}.': '.$name_item->{"summary"}; }; @@ -149,19 +146,9 @@ MMS definition file URL decoded out of the data stream above: @{[ project 'etherealwsp' ]} - - - - - - - - - - - - HERE -My::Web->footer(); +exit; +} +1; diff --git a/etmms/Makefile.am b/etmms/Makefile.am index 920c2bf..1416e64 100644 --- a/etmms/Makefile.am +++ b/etmms/Makefile.am @@ -18,4 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= +MODPERL_PM+= \ + Index.pm + diff --git a/have_js.js.pl b/have_js.js.pl deleted file mode 100755 index efc19d4..0000000 --- a/have_js.js.pl +++ /dev/null @@ -1,64 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# JavaScript detection scriptlet Perl template. -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package have_js; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; - - -my $W=My::Web->init( - "__PACKAGE__"=>__PACKAGE__, - "title"=>'Homepage of Jan Kratochvil', - ); -# Do not: My::Web->heading(); -$W->{"r"}->send_http_header("text/javascript"); - -# Prevent redirection of some top (referring) foreign webpage as it -# may not pass "have_js=1" to us anyway. (for example Google cache) -print "" - .'if (0'."\n" - ."\t\t".'|| window.location.hostname=="'.$W->{"r"}->hostname().'" && window.location.port== 80'."\n" - ."\t\t".'|| window.location.hostname=="'.'localhost' .'" && window.location.port==7680)'."\n"; -print <<'HERE'; - { - var searchN=window.location.search; - if (searchN=="" || searchN=="?") - searchN="?"; - else - searchN+="&"; - searchN+="have_js=1"; - - window.location.href - =window.location.protocol+"//" - +window.location.hostname - +(window.location.port==80 ? "" : ":"+window.location.port) - +window.location.pathname - +window.location.hash - +searchN; - } -HERE - -# Do not: My::Web->footer(); diff --git a/html-test.pl b/html-test.pl new file mode 100755 index 0000000..ce68887 --- /dev/null +++ b/html-test.pl @@ -0,0 +1,82 @@ +#! /usr/bin/perl +# +# $Id$ + + +use strict; +use warnings; +use My::ModPerlPm; +require LWP::UserAgent; +require HTTP::Status; +require LWP; +use Carp qw(confess cluck); +use Getopt::Long; +use Sys::Hostname::Long; +use URI::Escape; + + +my $URL_BASE="http://".hostname_long().":7680"; +my $URL_VALIDATOR_BASE="http://validator.w3.org/check?uri="; +my $URL_VALIDATOR_BASE_LOCAL="http://localhost/cgi-bin/check.cgi?uri="; + + +my $opt_validate; +my $opt_local; +die if !GetOptions( + "validate!",\$opt_validate, + "local!",\$opt_local, + ); + +my($first_pattern)=@ARGV; +die if @ARGV>=2; + + +$|=1; + +my $UA=LWP::UserAgent->new(); +$UA->env_proxy(); + +my $first_seen=!$first_pattern; +My::ModPerlPm->list("sub"=>sub { + my($p)=@_; + require $p->{"file"}; + eval 'require '.$p->{"module"}.'; 1;' + or cluck "Error loading module ".$p->{"module"}.": $@"; + my $HTML_TEST=eval '$'.$p->{"module"}.'::HTML_TEST;'; + return if defined $HTML_TEST && !$HTML_TEST; + my $validate=$opt_validate; + $validate=0 if $HTML_TEST && $HTML_TEST eq "download"; + my $HTML_TEST_QUERY_STRING=eval '$'.$p->{"module"}.'::HTML_TEST_QUERY_STRING;'; + for my $query_string ("ARRAY" eq ref $HTML_TEST_QUERY_STRING ? @$HTML_TEST_QUERY_STRING : $HTML_TEST_QUERY_STRING) { + my $url=$URL_BASE.$p->{"url"}.(!$query_string ? "" : "?".$query_string); + my $url_matches=1 if $first_pattern && $url=~/$first_pattern/o; + die "Pattern amiguous on: $url\n" if $first_seen && $url_matches; + if (!$first_seen && !($first_seen=($url=~/$first_pattern/o))) { + print "_"; + next; + } + print "."; + if ($validate) { + $url=($opt_local ? $URL_VALIDATOR_BASE_LOCAL : $URL_VALIDATOR_BASE).uri_escape($url); + } + my $request=HTTP::Request->new("GET",$url); + $request->header("Cache-control"=>"no-cache"); + # Do not: ...->request(...); + # as it would follow our tested 403 redirect responses. + my $response=$UA->simple_request($request); + my $HTML_TEST_RC=eval '$'.$p->{"module"}.'::HTML_TEST_RC;'; + $HTML_TEST_RC=HTTP::Status::RC_OK() if !defined $HTML_TEST_RC; + if ($response->code()==$HTML_TEST_RC) { + next if !$validate; + local $_=$response->content(); + my $valid=/\bclass="valid"\s*>/; + my $invalid=/\bclass="invalid"\s*>/; + die "\nUnexpected response: $url\n" if $valid==$invalid; + next if $valid; + die "\n$url\n"; + } + die "\n$url: ".$response->code()."\n"; + } + }) for (0,($opt_validate ? 1 : ())); +print "\n"; +die "Nothing seen for: $first_pattern\n" if !$first_seen; diff --git a/httpd.conf.pl b/httpd.conf.pl new file mode 100755 index 0000000..7746866 --- /dev/null +++ b/httpd.conf.pl @@ -0,0 +1,50 @@ +#! /usr/bin/perl +# +# $Id$ + + +use strict; +use warnings; +use My::ModPerlPm; + + +print <<"HERE"; +# Auto-generated from: @{[ '$Id$' ]} +# DO NOT EDIT! + + +PerlOptions +GlobalRequest + +HERE +print <<'HERE'; + + use Carp qw(confess cluck); + $SIG{"__WARN__"}=sub { $_[0]=~/\n./ ? warn @_ : cluck @_; }; + $SIG{"__DIE__" }=sub { $_[0]=~/\n./ ? die @_ : confess @_; }; + + ++ Order Allow,Deny + Deny from all + +HERE + + +My::ModPerlPm->list("sub"=>sub { + my($p)=@_; + print <<"HERE" + +PerlModule @{[ $p->{"module"} ]} +{"url"} ]}"> + SetHandler modperl + PerlResponseHandler @{[ $p->{"module"} ]} + Order Deny,Allow + Allow from localhost + +HERE + }); + +print <<"HERE"; + +# EOF +HERE diff --git a/project/332/Index.html.pl b/project/332/Index.pm old mode 100755 new mode 100644 similarity index 75% rename from project/332/Index.html.pl rename to project/332/Index.pm index 63000a9..ddf3be0 --- a/project/332/Index.html.pl +++ b/project/332/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ # Main page of 'My::Project::332' -# Copyright (C) 2003 Jan Kratochvil+# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -25,18 +23,34 @@ our $CVS_ID=q$Id$; use strict; use warnings; -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } use My::Web; -Wuse 'My::Project'; -Wuse 'project::332::ListItem'; +Wuse 'project::Lib'; -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::332::ListItem::ListItem, +our @ListItem=( + "name"=>"332", + "platform"=>"unixdevel", + "priority"=>630, + "icon"=>"332-front-icon.jpeg", + # FIXME: Relative 'download': + "download-sources without patched core"=>"/project/332/332-noexec.tar.gz", + "summary"=>"AmigaOS kernel port to embedded Motorola 68332", + "license"=>"PD", + "maintenance"=>"ready", + "sponsorship"=>sub { return a_href('http://www.geoinvest.cz/','Geoinvest'); }, + "language"=>"680x0 asm, C", + "description"=><<"HERE", + Core of the AmigaOS kernel (exec.library) ported to embedded Motorola 68332 computer. +Reusable as OS for your embedded device suitable for developers with AmigaOS experience.
+HERE ); +sub handler +{ +project::Lib->init(); + + print <<"HERE";Project was destined as the kernel for GPS-tracking device. Used Motorola 68332 computer features 1.25MB of RAM and 512KB of FlashEPROM. @@ -69,4 +83,6 @@ AmigaOS kernel core disassembled sources.
HERE -My::Web->footer(); +exit; +} +1; diff --git a/project/332/ListItem.pm b/project/332/ListItem.pm deleted file mode 100755 index 264204f..0000000 --- a/project/332/ListItem.pm +++ /dev/null @@ -1,49 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Definition of 'My::Project::332' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::332::ListItem; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -use My::Web; - - -our @ListItem=( - "name"=>"332", - "platform"=>"unixdevel", - "priority"=>630, - "icon"=>"332-front-icon.jpeg", - # FIXME: Relative 'download': - "download-sources without patched core"=>"/project/332/332-noexec.tar.gz", - "summary"=>"AmigaOS kernel port to embedded Motorola 68332", - "license"=>"PD", - "maintenance"=>"ready", - "sponsorship"=>@{[ a_href('http://www.geoinvest.cz/','Geoinvest') ]}, - "language"=>"680x0 asm, C", - "description"=><<"HERE", - Core of the AmigaOS kernel (exec.library) ported to embedded Motorola 68332 computer. -Reusable as OS for your embedded device suitable for developers with AmigaOS experience.
-HERE - ); - -1; diff --git a/project/332/Makefile.am b/project/332/Makefile.am index 5a40374..7c8b48c 100644 --- a/project/332/Makefile.am +++ b/project/332/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/AutoGen/Index.html.pl b/project/AutoGen/Index.html.pl deleted file mode 100755 index ffdf9b6..0000000 --- a/project/AutoGen/Index.html.pl +++ /dev/null @@ -1,39 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::AutoGen' -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::AutoGen::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::AutoGen::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::AutoGen::ListItem::ListItem, - ); - -My::Web->footer(); diff --git a/project/AutoGen/ListItem.pm b/project/AutoGen/Index.pm old mode 100755 new mode 100644 similarity index 87% rename from project/AutoGen/ListItem.pm rename to project/AutoGen/Index.pm index 28f0f75..a08cbfa --- a/project/AutoGen/ListItem.pm +++ b/project/AutoGen/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::AutoGen' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::AutoGen' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::AutoGen::ListItem; +package project::AutoGen::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -33,7 +32,7 @@ our @ListItem=( "platform"=>"unixdevel", "priority"=>540, "cvs"=>"macros", - "link-Documentation"=>'/project/Pod2Html.html.pl?cvs=macros/AutoGen.pm', + "link-Documentation"=>'/project/Pod2Html.pm?cvs=macros/AutoGen.pm', # FIXME: 'http://cvs.jankratochvil.net/viewcvs/' -> $W->{"project_viewcvs"} "link-Source file"=>'http://cvs.jankratochvil.net/viewcvs/'."*checkout*/macros/AutoGen.pm?rev=HEAD", "summary"=>"autogen.sh while supporting CVS/.rpm/.deb", @@ -66,4 +65,9 @@ This project has some additional features: HERE ); +sub handler +{ +project::Lib->init(); +exit; +} 1; diff --git a/project/AutoGen/Makefile.am b/project/AutoGen/Makefile.am index a5a52c7..8a0ba99 100644 --- a/project/AutoGen/Makefile.am +++ b/project/AutoGen/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/CasioA/Index.html.pl b/project/CasioA/Index.html.pl deleted file mode 100755 index d2c5930..0000000 --- a/project/CasioA/Index.html.pl +++ /dev/null @@ -1,47 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::CasioA' -# Copyright (C) 2003 Jan Kratochvil -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::CasioA::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::CasioA::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::CasioA::ListItem::ListItem, - ); - - -print <<"HERE"; -@{[ centerimg "Casio-A","Casio-A Snapshot" ]} -@{[ vskip "1ex" ]} -@{[ centerimg "CasioSchema","Casio-A Interface Scheme" ]} -HERE - - -My::Web->footer(); diff --git a/project/CasioA/ListItem.pm b/project/CasioA/Index.pm old mode 100755 new mode 100644 similarity index 79% rename from project/CasioA/ListItem.pm rename to project/CasioA/Index.pm index 2d6d088..0540773 --- a/project/CasioA/ListItem.pm +++ b/project/CasioA/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::CasioA' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::CasioA' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::CasioA::ListItem; +package project::CasioA::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -39,7 +38,7 @@ our @ListItem=( "license"=>"PD", "maintenance"=>"obsolete-Casio SF-A10 diary and AmigaOS are no longer being used.", "language"=>"680x0 asm", - "description"=><<"HERE", + "description"=>sub { return <<"HERE"; }, Casio-A is a software for backup/restore of Casio SF-A10 personal digital diary. Its development involved reverse-engineering the Casio communication protocol by sniffing serial communication of the vendor's MS-DOS backup tool.
@@ -48,4 +47,18 @@ protocol by sniffing serial communication of the vendor's MS-DOS backup tool.init(); + + +print <<"HERE"; +@{[ centerimg "Casio-A","Casio-A Snapshot" ]} +@{[ vskip "1ex" ]} +@{[ centerimg "CasioSchema","Casio-A Interface Scheme" ]} +HERE + + +exit; +} 1; diff --git a/project/CasioA/Makefile.am b/project/CasioA/Makefile.am index 544d810..fed041e 100644 --- a/project/CasioA/Makefile.am +++ b/project/CasioA/Makefile.am @@ -18,7 +18,9 @@ include $(top_srcdir)/Makefile-head.am +MODPERL_PM+= \ + Index.pm + EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl \ - Casio-A.png + Casio-A.png + diff --git a/project/ChangeLog.txt.pl b/project/ChangeLog.pm similarity index 75% rename from project/ChangeLog.txt.pl rename to project/ChangeLog.pm index 6c85224..4cae2ac 100755 --- a/project/ChangeLog.txt.pl +++ b/project/ChangeLog.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ # URL redirector of &My::Web::a_href Perl template. -# Copyright (C) 2003 Jan Kratochvil+# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -25,25 +23,35 @@ our $CVS_ID=q$Id$; use strict; use warnings; -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } use My::Web; -use Apache::Constants qw(MOVED); +our $HTML_TEST="download"; +our $HTML_TEST_QUERY_STRING="cvs=MyWeb"; + +sub handler +{ my $W=My::Web->init( - "__PACKAGE__"=>__PACKAGE__, "header_only"=>1, "args_check"=>{ - "cvs"=>'^[\w\d][\w\d/.]*$', + "cvs"=>'^[\w\d][-\w\d/.]*$', }, + "content_type"=>"text/plain", + "http_safe"=>0, # cvs(1) downloads. ); +My::Web->heading(); + -$W->{"r"}->send_http_header("text/plain"); local *F; open F,"" ."cvs -n -q -d ".$W->{"pserver"}.":".$W->{"pserver_path"}." rlog ".$W->{"args"}{"cvs"} ." |perl -p -e 's#^RCS file: ".$W->{"pserver_path"}.'/(.*?)(?:/Attic/|/)?([^/]*),v$#$&\nWorking file: $1/$2#;'."'" - ." |cvs2cl --stdin --stdout --window 3600 --separate-header --no-wrap --usermap ".top_dir_disk()."/cvs2cl-usermap" + ." |cvs2cl --stdin --stdout --window 3600 --separate-header --no-wrap --usermap ".path_abs_disk("/cvs2cl-usermap") ." |"; -print while ; +print $_ while ; close F; + + +exit; +} +1; diff --git a/project/FordFulk/Index.html.pl b/project/FordFulk/Index.html.pl deleted file mode 100755 index d2ab68d..0000000 --- a/project/FordFulk/Index.html.pl +++ /dev/null @@ -1,51 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::FordFulk' -# Copyright (C) 2003 Jan Kratochvil -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::FordFulk::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::FordFulk::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::FordFulk::ListItem::ListItem, - ); - - -print <<"HERE"; - -Program on-line. - - -@{[ vskip "3ex" ]} - -@{[ centerimg "FordFulk","Applet Screenshot" ]} -HERE - - -My::Web->footer(); diff --git a/project/FordFulk/ListItem.pm b/project/FordFulk/Index.pm old mode 100755 new mode 100644 similarity index 74% rename from project/FordFulk/ListItem.pm rename to project/FordFulk/Index.pm index 9d929b4..8558ac9 --- a/project/FordFulk/ListItem.pm +++ b/project/FordFulk/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::FordFulk' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::FordFulk' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::FordFulk::ListItem; +package project::FordFulk::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -43,4 +42,22 @@ our @ListItem=( HERE ); +sub handler +{ +project::Lib->init(); + + +print <<"HERE"; + + @{[ a_href 'FordFulk/','Program on-line.' ]}
+ + +@{[ vskip "3ex" ]} + +@{[ centerimg "FordFulk","Applet Screenshot" ]} +HERE + + +exit; +} 1; diff --git a/project/FordFulk/Makefile.am b/project/FordFulk/Makefile.am index 0c1658b..8579d4f 100644 --- a/project/FordFulk/Makefile.am +++ b/project/FordFulk/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/Heat/Index.html.pl b/project/Heat/Index.html.pl deleted file mode 100755 index ff2caad..0000000 --- a/project/Heat/Index.html.pl +++ /dev/null @@ -1,51 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::Heat' -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::Heat::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::Heat::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::Heat::ListItem::ListItem, - ); - - -print <<"HERE"; - -Program on-line. - - -@{[ vskip "3ex" ]} - -@{[ centerimg "Heat","Applet Screenshot" ]} -HERE - - -My::Web->footer(); diff --git a/project/Heat/ListItem.pm b/project/Heat/Index.pm old mode 100755 new mode 100644 similarity index 74% rename from project/Heat/ListItem.pm rename to project/Heat/Index.pm index 592efd7..73a00e8 --- a/project/Heat/ListItem.pm +++ b/project/Heat/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::Heat' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::Heat' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::Heat::ListItem; +package project::Heat::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -43,4 +42,22 @@ our @ListItem=( HERE ); +sub handler +{ +project::Lib->init(); + + +print <<"HERE"; + + @{[ a_href 'Heat/','Program on-line.' ]}
+ + +@{[ vskip "3ex" ]} + +@{[ centerimg "Heat","Applet Screenshot" ]} +HERE + + +exit; +} 1; diff --git a/project/Heat/Makefile.am b/project/Heat/Makefile.am index 88d647c..794cf21 100644 --- a/project/Heat/Makefile.am +++ b/project/Heat/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/Index.html.pl b/project/Index.pm similarity index 73% rename from project/Index.html.pl rename to project/Index.pm index 9a207a1..c0ba713 100755 --- a/project/Index.html.pl +++ b/project/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ # List of projects Perl template. -# Copyright (C) 2003 Jan Kratochvil+# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -25,33 +23,32 @@ our $CVS_ID=q$Id$; use strict; use warnings; -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } use My::Web; -Wrequire 'My::Project'; +Wrequire 'project::Lib'; +use Carp qw(confess cluck); +sub handler +{ My::Web->init( - "__PACKAGE__"=>__PACKAGE__, "title"=>'Project List', "section"=>"Projects", -# "rel_up"=>top_dir(), # TODO:homepage -# "rel_start"=>top_dir(), # TODO:homepage +# "rel_up"=>"/", # TODO:homepage +# "rel_start"=>"/", # TODO:homepage "footer_ids"=>0, ); My::Web->heading(); -print My::Project->views("Detailed"); -print My::Project->platforms(undef(),"novskip"=>1); +print(project::Lib->views("Detailed")); +print(project::Lib->platforms(undef(),"novskip"=>1)); -my %item=( My::Project::item_hash_read() ); +my %item=project::Lib->name_to_hashref(); -my @platforms=@My::Project::platforms; +my @platforms=@project::Lib::platforms; while (@platforms) { my $platform_sym =shift @platforms; my $platform_name=shift @platforms; - print ''; - print " $platform_name
"; - print ''."\n"; + print ''.$platform_name.'
'."\n"; my @projects=sort { ($item{$b}{"priority"} <=> $item{$a}{"priority"}) or @@ -76,4 +73,6 @@ while (@platforms) { } -My::Web->footer(); +exit; +} +1; diff --git a/project/Islet/Index.html.pl b/project/Islet/Index.html.pl deleted file mode 100755 index 731a9bc..0000000 --- a/project/Islet/Index.html.pl +++ /dev/null @@ -1,49 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::Islet' -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::Islet::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::Islet::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::Islet::ListItem::ListItem, - ); - - -print <<"HERE"; - -Program on-line. - - -@{[ centerimg "Islet","Applet demo screen" ]} -HERE - - -My::Web->footer(); diff --git a/project/Islet/ListItem.pm b/project/Islet/Index.pm old mode 100755 new mode 100644 similarity index 75% rename from project/Islet/ListItem.pm rename to project/Islet/Index.pm index e3cc9c3..7c4d869 --- a/project/Islet/ListItem.pm +++ b/project/Islet/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::Islet' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::Islet' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::Islet::ListItem; +package project::Islet::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -43,4 +42,20 @@ our @ListItem=( HERE ); +sub handler +{ +project::Lib->init(); + + +print <<"HERE"; + + @{[ a_href 'Islet/','Program on-line.' ]}
+ + +@{[ centerimg "Islet","Applet demo screen" ]} +HERE + + +exit; +} 1; diff --git a/project/Islet/Makefile.am b/project/Islet/Makefile.am index d71feb9..54adb9f 100644 --- a/project/Islet/Makefile.am +++ b/project/Islet/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/LaserGame/Index.html.pl b/project/LaserGame/Index.html.pl deleted file mode 100755 index 412d472..0000000 --- a/project/LaserGame/Index.html.pl +++ /dev/null @@ -1,47 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::LaserGame' -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::LaserGame::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::LaserGame::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::LaserGame::ListItem::ListItem, - ); - - -print <<"HERE"; -@{[ centerimg "hw.jpeg","LaserGame Hardware" ]} -@{[ vskip "1ex" ]} -@{[ centerimg "LaserComm","LaserComm Utility" ]} -HERE - - -My::Web->footer(); diff --git a/project/LaserGame/ListItem.pm b/project/LaserGame/Index.pm old mode 100755 new mode 100644 similarity index 81% rename from project/LaserGame/ListItem.pm rename to project/LaserGame/Index.pm index a0f2c8f..e333d7f --- a/project/LaserGame/ListItem.pm +++ b/project/LaserGame/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::LaserGame' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::LaserGame' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::LaserGame::ListItem; +package project::LaserGame::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -39,7 +38,7 @@ our @ListItem=( "license"=>"PD", "maintenance"=>"obsolete-Config tool is written for the discontinued Amiga platform.", "language"=>"i8051 asm, 680x0 asm", - "description"=><<"HERE", + "description"=>sub { return <<"HERE"; }, LaserGame is a clone of commercial shoot'n'run game. Each player has its own hardware with multiple infra detecting sensor and one laser/infra gun. Shooting is visually targeting by red laser diode while the shooting @@ -51,4 +50,18 @@ also capable of remote hardware configuration.
HERE ); +sub handler +{ +project::Lib->init(); + + +print <<"HERE"; +@{[ centerimg "hw.jpeg","LaserGame Hardware" ]} +@{[ vskip "1ex" ]} +@{[ centerimg "LaserComm","LaserComm Utility" ]} +HERE + + +exit; +} 1; diff --git a/project/LaserGame/Makefile.am b/project/LaserGame/Makefile.am index c848438..28867ce 100644 --- a/project/LaserGame/Makefile.am +++ b/project/LaserGame/Makefile.am @@ -18,7 +18,9 @@ include $(top_srcdir)/Makefile-head.am +MODPERL_PM+= \ + Index.pm + EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl \ - LaserGame.png + LaserGame.png + diff --git a/project/Lib.css b/project/Lib.css new file mode 100644 index 0000000..3c1dd92 --- /dev/null +++ b/project/Lib.css @@ -0,0 +1,20 @@ +/* $Id$ + * CSS of project functions for HTML/XHTML output generation + * Copyright (C) 2003-2005 Jan Kratochvil+ * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation; exactly version 2 of June 1991 is required + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + */ + + +table.print_project td { vertical-align: top; } diff --git a/project/Lib.pm b/project/Lib.pm new file mode 100644 index 0000000..4fde277 --- /dev/null +++ b/project/Lib.pm @@ -0,0 +1,370 @@ +# $Id$ +# Common functions for HTML/XHTML output generation +# Copyright (C) 2003 Jan Kratochvil +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; exactly version 2 of June 1991 is required +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the Free Software +# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + +package project::Lib; +require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway +our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; +our $CVS_ID=q$Id$; +use strict; +use warnings; + +use My::Web; +use Carp qw(cluck confess); + +use Exporter; +our @EXPORT=qw(); +our @ISA=qw(My::Web Exporter); + + +sub LIST_FILENAME() +{ + # Do not: path_abs_disk("/project/SUBDIRS"); + # as we would need $W->{"r"} for the possibly relative path resolving. + return My::Web::dir_top_abs_disk()."/project/SUBDIRS"; +} + + +sub print_project +{ +my($class,$ListItem)=@_; + + print " ".$class->title($ListItem)."
\n"; + do { print $_ if $_; } for ($W->{"project_text_after_title"}); + print $ListItem->{"description"}; + print "
\n"; + print($W->{"before_project_data"}||""); + return if $W->{"no_project_data"}; + my @table=( + {"key"=>"summary","text"=>"Summary"}, + {"key"=>"license","text"=>"License","format"=>sub ($) { + my %known=( + "PD"=>"Public Domain", + "GPL"=>a_href("http://www.gnu.org/licenses/gpl.html","GNU General Public License"), + "LGPL"=>a_href("http://www.gnu.org/licenses/lgpl.html","GNU Lesser General Public License"), + "com"=>"Commercial" + ); + return $known{$_[0]}; + }}, + {"key"=>"maintenance","text"=>"State","format"=>sub ($) { + my %known=( + "active"=>"Ready to use. Project is now actively developed.", + "ready"=>"Ready to use. Maintained.", + "dead"=>"Dead code, no longer supported.", + "merge"=>"Functions belong to existing other project.", + "obsolete"=>"Obsoleted.", + "update"=>"Package needs updating to recent software.", + "accepted"=>"This patch got already integrated by the original package maintainer.", + "pending"=>"Patch is ready to be applied to the mainstream.", + "ignored"=>"Patch was ignored. It is not applied in the mainstream.", + ""=>"", + ); + my @r; + for ($known{($_[0]=~/^([^-]*)-?/)[0] || ""}) { + push @r,$_ if $_; + push @r," $'" if $'; + } + return join(" ",@r); + }}, + {"key"=>"aminet","text"=>a_href('http://www.aminet.net/','Aminet'),"format"=>sub ($) { + return join(" ", + a_href('http://www.aminet.net/'.$_[0].".lha",$_[0].".lha"), + "(".a_href('http://www.aminet.net/'.$_[0].".readme","readme").")"); + }}, + {"key"=>qr(^download\b),"text"=>sub ($) { + $_[0]=~s/^download//; + $_[0]=~s/^-/ /; + return "Download".$_[0]; + }, + "format"=>sub ($) { + return a_href($_[0],escapeHTML(File::Basename::basename($_[0])),"size"=>2); + }}, + {"key"=>qr(^link\b),"text"=>sub ($) { + $_[0]=~s/^link-//; + return $_[0]; + }, + "format"=>sub ($) { + return($_[0]=~/^qr(^cvs\b),"text"=>sub ($) { + $_[0]=~s/^cvs//; + $_[0]=~s/^-/ /; + return "CVS".$_[0]; + }, + "format"=>sub ($$) { + my($val,$key)=@_; + $key=~s/^cvs//; + $key=~s/^-/ /; + my $branch=""; + $branch=$1 if $val=~s/:(.*)//; + return join("
\n\t\t", + escapeHTML("cvs -d ".$W->{"pserver"}.":".$W->{"pserver_path"}." -z3" + ." checkout".(!$branch ? "" : " -r $branch -kk") + .($val!~m#/# ? "" : " -d ".File::Basename::basename($val)) + ." $val"), + join(" | \n\t\t", + map({ a_href($_->[1],$_->[0]); } + ["ViewCVS CVS repository",$W->{"project_viewcvs"}.$val."/".(!$branch ? "" : '?only_with_tag='.$branch)], + ["Download CVS snapshot" , + $W->{"project_viewcvs"}.$val."/".File::Basename::basename($val).".tar.gz?tarball=1" + .(!$branch ? "" : '&only_with_tag='.$branch)], + ["CVS ChangeLog" ,"/project/ChangeLog.pm?cvs=$val"]))); + }}, + {"key"=>"ownership","text"=>"Ownership"}, + {"key"=>"sponsorship","text"=>"Sponsorship"}, + {"key"=>"language","text"=>"Programming language","format"=>sub ($) { + return a_href("http://java.sun.com/",escapeHTML($_[0])) + if $_[0]=~/^Java\b/; + return a_href("http://www.php.net/",escapeHTML($_[0])) + if $_[0]=~/^PHP\b/; + return undef(); + }}, + ); + +sub tableit_func +{ +my($tableit,$val,$key,$ListItem)=@_; + + my $r=""; + $r.=""; + if ($tableit->{"text"}) { + $r.=" "; + $r.=(!ref $_ ? $_ : &{$_}($key)) for ($tableit->{"text"}); + $r.=" "; + } + if ($tableit->{"format"}) { + do { $val=$_ if defined $_; } for (&{$tableit->{"format"}}($val,$key)); + } + return join("",map("\n",@$val)) + if ref $val; + $r.=" ".$_->[0]." ".$_->[1]." $val "; + $r.="\n"; +} + + my %used_key; + print ''."\n"; + for my $tableit (@table) { + if (!ref $tableit->{"key"}) { + print tableit_func($tableit,$ListItem->{$tableit->{"key"}},$tableit->{"key"},$ListItem) + if $ListItem->{$tableit->{"key"}} && !$used_key{$tableit->{"key"}}++; + } + else { + for my $key (@{$ListItem->{"keys_array"}}) { + my $keyregex=$tableit->{"key"}; + next if $key!~/$keyregex/; + print tableit_func($tableit,$ListItem->{$key},$key,$ListItem); + } + } + } + print "
\n"; + print vskip; +} + +sub hashlikearray_get_keys(@) +{ +my(@hashlikearray)=@_; + + my @r; + while (@hashlikearray) { + push @r,shift @hashlikearray; # key + shift @hashlikearray; # val + } + return @r; +} + +sub project_arrayref_to_hashref($$) +{ +my($self,$arrayref)=@_; + + Wrequire 'My::Hash'; + return My::Hash->new({ + @$arrayref, + "keys_array"=>[ hashlikearray_get_keys(@$arrayref) ], + },"My::Hash::Sub","My::Hash::Readonly"); +} + +sub title ($$) +{ +my($class,$hashref)=@_; + + cluck if !$hashref->{"name"} || !$hashref->{"summary"}; + return $hashref->{"name"}.": ".$hashref->{"summary"}, +} + +# Returns: hashref if !wantarray(), list if wantarray(). +sub list($) +{ +my($self)=@_; + + # This cache is "headers_in" hits safe - only local files reading. + our %list_cache; + our @list_cache; + if (!@list_cache) { + My::Web->make_file(LIST_FILENAME()); + local *F; + open F,LIST_FILENAME() or do { + cluck "Error opening \"".LIST_FILENAME()."\": $!"; + return; + }; + my @r=split(" ",do { undef $/;; }); + close F or cluck "Error closing \"".LIST_FILENAME()."\": $!"; + cluck "No projects found?" if !@r; + @list_cache=@r; + %list_cache=map(($_=>1),@list_cache); + } + return \%list_cache if !wantarray(); + return @list_cache; +} + +# Returns: hashlist of hashrefs if !$name. +sub name_to_hashref($;$) +{ +my($class,$name)=@_; + + cluck if !wantarray() && !$name; + # Do not cache the result to get all the items &Wrequire-mapped. + return map(($_=>$class->name_to_hashref($_)),$class->list()) if !$name; + cluck join(" ","Project name \"$name\" not listed in 'list_cache':",$class->list()) + if !$class->list()->{$name}; + # Never cache anything to be stable for "headers_in" hits. + Wrequire "project::${name}::Index"; + my $arrayref=eval('\@project::'.$name.'::Index::ListItem'); + do { warn "Broken project/$name/Index.pm"; return undef(); } if !@$arrayref; + return $class->project_arrayref_to_hashref($arrayref); +} + +# $args{"ListItem"}=\%...; +sub init($%) +{ +my($class,%args)=@_; + + $args{"__PACKAGE__"}||=caller(); + $args{"project_name"}||=($args{"__PACKAGE__"}=~/^project::(\w+)::Index$/)[0] + or cluck "Error finding project name of the package: ".$args{"__PACKAGE__"}; + my $ListItem=$class->name_to_hashref($args{"project_name"}); + my $W=$class->SUPER::init( + "title"=>My::Web->a_href_inhibit(sub { return $class->title($ListItem); }), + map(("rel_$_"=>'/project/Rel.pm?rel='.$_.'&project='.$args{"project_name"}),qw(prev next)), + "rel_up"=>'/project/', +# "rel_start"=>"/", # TODO:homepage + "css_push"=>"/project/Lib.css", + %args, + "heading_novskip"=>1, + ); + $class->heading(); + print $class->platforms($ListItem->{"platform"}); + $class->print_project($ListItem,%args); + return $W; +} + +our @platforms=( + "unixuser"=>"UNIX", + "unixdevel"=>"UNIX-devel", + "web"=>"Web", + "amiga"=>"Amiga", + "w32"=>"MS-Windows", + "dos"=>"MS-DOS", + "patch"=>"Patches", + ); + +sub views ($$) +{ +my($class,$view_selected)=@_; + + my $view=sub ($$) + { + my($current,$href,$content)=@_; + + return a_href($href,$content) if $current ne $view_selected; + return "".$content." (current)"; + }; + + return <<"HERE"; + Project List of @{[ a_href 'http://www.jankratochvil.net/','Jan Kratochvil' ]}
+ ++
+@{[ vskip "1ex" ]} +HERE +} + +sub platforms ($;$%) +{ +my($class,$platform_selected,%args)=@_; + + my $r=""; + $r.='- @{[ &{$view}('Detailed' ,'/project/','Detailed project listing per platform') ]}
+- @{[ &{$view}('BriefPlatform','/project/List.pm?platform=platform', + 'Brief project listing per platform') ]}
+- @{[ &{$view}('BriefUnified' ,'/project/List.pm', + 'Unified brief project listing') ]}
+'."\n"; + if (!$args{"novskip"}) { + $r.="
'."\n"; + $r.=' '; + $r.=' '; + $r.=''."\n"; + $r.='
'; + $r.=''."\n"; + $r.=' '."\n"; + $r.=''."\n"; + $r.='Projects'; + $r.=' '."\n"; + $r.=''; + $r.=' '."\n"; + $r.=''."\n"; + $r.='
'."\n"; + $r.=''."\n"; + my @platforms=@platforms; + while (@platforms) { + my $platform_sym =shift @platforms; + my $platform_name=shift @platforms; + my $chosen=($platform_selected && $platform_selected eq $platform_sym); + $r.=' '."\n"; + $r.=''; + $r.=a_href((!$platform_selected ? "" : "/project/").'#'.$platform_sym,$platform_name, + "attr"=>($chosen + ? 'style="text-decoration: underline; font-weight: bold;"' + : 'style="text-decoration: inherit; /* revoke underline */"')); + $r.=" \n"; + } + $r.='
\n"; + $r.=My::Web::vskip "6ex"; + } + return $r; +} + +sub section ($$) +{ +my($class,$name)=@_; + + my $item=$class->name_to_hashref($name); + my $title=$class->title($item); + my $r=""; + + print $class->platforms($item->{"platform"},"novskip"=>1); + + $r.=''."\n"; + $r.='
'."\n"; + $r.=vskip "1ex"; + return $r; +} + +1; diff --git a/project/List.html.pl b/project/List.pm similarity index 82% rename from project/List.html.pl rename to project/List.pm index fc149c9..e8e913d 100755 --- a/project/List.html.pl +++ b/project/List.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ # List of projects Perl template. -# Copyright (C) 2003 Jan Kratochvil'."\n"; + $r.=' '."\n"; + $r.=a_href "/project/$name/",$title; + $r.=' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -25,30 +23,28 @@ our $CVS_ID=q$Id$; use strict; use warnings; -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } use My::Web; -require CGI; -Wrequire 'My::Project'; +Wrequire 'project::Lib'; +sub handler +{ My::Web->init( - "__PACKAGE__"=>__PACKAGE__, "title"=>'Project List', "args_check"=>{ "platform"=>'^(?:platform)?$', }, -# "rel_up"=>top_dir(), # TODO:homepage -# "rel_start"=>top_dir(), # TODO:homepage +# "rel_up"=>"/", # TODO:homepage +# "rel_start"=>"/", # TODO:homepage "footer_ids"=>0, ); My::Web->heading(); -my $CGI=CGI->new(); -print My::Project->views(($W->{"args"}{"platform"} ? "BriefPlatform" : "BriefUnified")); -print My::Project->platforms(undef(),"novskip"=>1) if $W->{"args"}{"platform"}; +print(project::Lib->views(($W->{"args"}{"platform"} ? "BriefPlatform" : "BriefUnified"))); +print(project::Lib->platforms(undef(),"novskip"=>1)) if $W->{"args"}{"platform"}; -my %item=( My::Project::item_hash_read() ); +my %item=project::Lib->name_to_hashref(); # $col{"name"}{"show"}=1 # $col{"name"}{"format"}=sub { "<".$_[0].">"; } @@ -62,10 +58,11 @@ my %col; sub format_url ($) { return (!$_[0] ? "" : 'X'); } $col{"name"}{"format"}=sub { - $_[0]=~s#]*>([^<]*)#$1#g; + local $_=$_[0]; + s#]*>([^<]*)#$1#g; return "" .(!$My::Web::W->{"args"}{"W"} ? "" : $item{$_[1]}{"priority"}.":") - .$_[0].""; + .$_.""; }; $col{"license"}{"format"}=sub { @@ -133,7 +130,7 @@ my($platform)=@_; print ''; } print ''."\n"; - if ($CGI->param("description_opt")) { + if ($W->{"args"}{"description_opt"}) { print ' '."\n"; @@ -148,16 +145,16 @@ if (!$W->{"args"}{"platform"}) { &{$print_one_platform}(undef()); } else { - my @platforms=@My::Project::platforms; + my @platforms=@project::Lib::platforms; while (@platforms) { my $platform_sym =shift @platforms; my $platform_name=shift @platforms; - print ''; - print " '; print ' '; print ' '.$item{$row}{"description"}.'$platform_name
"; - print ''."\n"; + print ''.$platform_name.'
'."\n"; &{$print_one_platform}($platform_sym); } } -My::Web->footer(); +exit; +} +1; diff --git a/project/Makefile.am b/project/Makefile.am index 5691c1d..71cf3b8 100644 --- a/project/Makefile.am +++ b/project/Makefile.am @@ -88,9 +88,17 @@ SUBDIRS= \ ntfsprogsgnomevfs \ udpgate +SUBDIRS: Makefile + @echo $(SUBDIRS) >$@ + +MODPERL_PM+= \ + Index.pm \ + ChangeLog.pm \ + Pod2Html.pm \ + List.pm \ + Rel.pm + EXTRA_DIST+= \ - Index.html.pl \ - ChangeLog.txt.pl \ - Pod2Html.html.pl \ - List.html.pl \ - Rel.pl + Lib.pm \ + checkListItem.pl + diff --git a/project/MyWeb/Index.html.pl b/project/MyWeb/Index.html.pl deleted file mode 100755 index 2f48d0c..0000000 --- a/project/MyWeb/Index.html.pl +++ /dev/null @@ -1,39 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::MyWeb' -# Copyright (C) 2003 Jan Kratochvil-# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::MyWeb::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::MyWeb::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::MyWeb::ListItem::ListItem, - ); - -My::Web->footer(); diff --git a/project/MyWeb/ListItem.pm b/project/MyWeb/Index.pm old mode 100755 new mode 100644 similarity index 77% rename from project/MyWeb/ListItem.pm rename to project/MyWeb/Index.pm index e9b9bec..c76b535 --- a/project/MyWeb/ListItem.pm +++ b/project/MyWeb/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::MyWeb' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil +# Main page of 'My::Project::MyWeb' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::MyWeb::ListItem; +package project::MyWeb::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -35,8 +34,8 @@ our @ListItem=( "cvs"=>"MyWeb", "cvs-for mod_perl2"=>"MyWeb:apache2", "cvs-of example web"=>"www/www.jankratochvil.net", - "link-Example web"=>a_href('http://www.jankratochvil.net/'), - "summary"=>a_href('http://www.perl.org/','Perl')." web framework", + "link-Example web"=>sub { return a_href('http://www.jankratochvil.net/'); }, + "summary"=>sub { return a_href('http://www.perl.org/','Perl')." web framework"; }, "license"=>"GPL", "maintenance"=>"ready", "language"=>"Perl", @@ -47,4 +46,9 @@ it. HERE ); +sub handler +{ +project::Lib->init(); +exit; +} 1; diff --git a/project/MyWeb/Makefile.am b/project/MyWeb/Makefile.am index abc4f09..1321d93 100644 --- a/project/MyWeb/Makefile.am +++ b/project/MyWeb/Makefile.am @@ -18,6 +18,6 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm + diff --git a/project/Nokia61/Index.html.pl b/project/Nokia61/Index.html.pl deleted file mode 100755 index 82b1953..0000000 --- a/project/Nokia61/Index.html.pl +++ /dev/null @@ -1,55 +0,0 @@ -#! /usr/bin/perl -# -# $Id$ -# Main page of 'My::Project::Nokia61' -# Copyright (C) 2003 Jan Kratochvil -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; exactly version 2 of June 1991 is required -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA - - -package project::Nokia61::Index; -require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway -our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; -our $CVS_ID=q$Id$; -use strict; -use warnings; - -BEGIN{ open F,"Makefile"; our $top_dir=pop @{[split /\s/,(grep /^top_srcdir/, )[0]]}; eval "use lib '$top_dir'"; close F; } -use My::Web; -Wuse 'My::Project'; -Wuse 'project::Nokia61::ListItem'; - - -My::Project->init_project( - "__PACKAGE__"=>__PACKAGE__, - "ListItem"=>\@project::Nokia61::ListItem::ListItem, - ); - -do { My::Web::make("make -s $_") if ! -f $_; } for ("./Nokia61"); -print <<"HERE"; - -
-HERE - -My::Web->footer(); diff --git a/project/Nokia61/ListItem.pm b/project/Nokia61/Index.pm old mode 100755 new mode 100644 similarity index 64% rename from project/Nokia61/ListItem.pm rename to project/Nokia61/Index.pm index d5b717a..026163a --- a/project/Nokia61/ListItem.pm +++ b/project/Nokia61/Index.pm @@ -1,8 +1,6 @@ -#! /usr/bin/perl -# # $Id$ -# Definition of 'My::Project::Nokia61' for list.cgi.pl -# Copyright (C) 2003 Jan Kratochvil- - - -- - -@{[ img 'Nokia61.jpeg','Illustration' ]} -+# Main page of 'My::Project::Nokia61' +# Copyright (C) 2003-2005 Jan Kratochvil # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -18,7 +16,7 @@ # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -package project::Nokia61::ListItem; +package project::Nokia61::Index; require 5.6.0; # at least 'use warnings;' but we need some 5.6.0+ modules anyway our $VERSION=do { my @r=(q$Revision$=~/\d+/g); sprintf "%d.".("%03d"x$#r),@r; }; our $CVS_ID=q$Id$; @@ -26,6 +24,7 @@ use strict; use warnings; use My::Web; +Wuse 'project::Lib'; our @ListItem=( @@ -47,4 +46,30 @@ in rows. HERE ); +sub handler +{ +project::Lib->init(); + + +My::Web->make_file(path_abs_disk("Nokia61")); +# FIXME: +# +# What was the reason? Currently it hides the whole in: +# Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.7.10) Gecko/20050719 Galeon/1.3.21 +print <<"HERE"; +
+
+HERE + + +exit; +} 1; diff --git a/project/Nokia61/Makefile.am b/project/Nokia61/Makefile.am index a7798b9..b9d78b3 100644 --- a/project/Nokia61/Makefile.am +++ b/project/Nokia61/Makefile.am @@ -18,13 +18,13 @@ include $(top_srcdir)/Makefile-head.am -EXTRA_DIST+= \ - ListItem.pm \ - Index.html.pl +MODPERL_PM+= \ + Index.pm Nokia61: Nokia61.c gcc -Wall -ggdb3 -o $@ $< CLEANFILES+= \ - Nokia61 \ - Nokia61_23.cache + Nokia61 \ + Nokia61_23.cache + diff --git a/project/Nokia61/Nokia61.php b/project/Nokia61/Nokia61.php index ef694fd..937631e 100644 --- a/project/Nokia61/Nokia61.php +++ b/project/Nokia61/Nokia61.php @@ -1,5 +1,7 @@ @@ -18,7 +20,9 @@ function table($array,$rw=0) { global $tables,$bgcolor_head,$bgcolor_body,$HTTP_GET_VARS; - print "+ ++ + +@{[ a_href 'Nokia61.php?base=.%2F','Program on-line.' ]}
+ +@{[ img 'Nokia61.jpeg','Illustration' ]} +