X-Git-Url: http://git.jankratochvil.net/?p=MyWeb.git;a=blobdiff_plain;f=Project.pm;fp=Project.pm;h=3d836d8b95098eb82a6804cc062537a29eb43992;hp=0000000000000000000000000000000000000000;hb=633dc05b0519d86762bd084d872d34f9183237e0;hpb=b1db84dfd24064aa8bdf9edc49b417f9f2ffb2b2 diff --git a/Project.pm b/Project.pm new file mode 100644 index 0000000..3d836d8 --- /dev/null +++ b/Project.pm @@ -0,0 +1,338 @@ +# $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 My::Project; +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 Exporter; +our @EXPORT=qw(); +our @ISA=qw(My::Web Exporter); + + +sub ENTRIES { return top_dir_disk()."/project/CVS/Entries"; } +sub ENTRIES_LOG { return top_dir_disk()."/project/CVS/Entries.Log"; } + + +sub print_project +{ +my($class,$ListItem,%args)=@_; + + print "

".$W->{"title"}."

\n"; + print $ListItem->{"description"}; + print "
\n"; + print $args{"before_project_data"} || ""; + return if $args{"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],CGI::escapeHTML(File::Basename::basename($_[0]))); + }}, + {"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", + CGI::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.txt.pl?cvs=$val"]))); + }}, + {"key"=>"ownership","text"=>"Ownership"}, + {"key"=>"sponsorship","text"=>"Sponsorship"}, + {"key"=>"language","text"=>"Programming language","format"=>sub ($) { + return a_href("http://java.sun.com/",CGI::escapeHTML($_[0])) + if $_[0]=~/^Java\b/; + return a_href("http://www.php.net/",CGI::escapeHTML($_[0])) + if $_[0]=~/^PHP\b/; + return undef(); + }}, + ); + +sub tableit_func +{ +my($tableit,$val,$key,$ListItem)=@_; + + delete $ListItem->{$key}; + 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("".$_->[0]."".$_->[1]."\n",@$val)) + if ref $val; + $r.="$val"; + $r.="\n"; +} + + print ''."\n"; + for my $tableit (@table) { + if (!ref $tableit->{"key"}) { + print tableit_func($tableit,$ListItem->{$tableit->{"key"}},$tableit->{"key"},$ListItem) + if $ListItem->{$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 project_arr_to_hash (@) +{ +my(@arr)=@_; + + return ( + @arr, + "keys_array"=>[ My::Web::arr_keys(@arr) ], + ); +} + +sub title ($$) +{ +my($class,$hashref)=@_; + + return $hashref->{"name"}.": ".$hashref->{"summary"}, +} + +# $args{"ListItem"}=\%...; +sub init_project ($%) +{ +my($class,%args)=@_; + + my $ListItem={ project_arr_to_hash(@{$args{"ListItem"}}) }; + my $W=$class->init( + "title"=>$class->title($ListItem), + map(("rel_$_"=>top_dir('/project/Rel.pl?rel='.$_.'&project='.($args{"__PACKAGE__"}=~/^.*::([^:]+)::[^:]+$/)[0])), + qw(prev next)), + "rel_up"=>top_dir('/project/'), + "rel_start"=>top_dir(), + %args, + "head_css"=>($args{"head_css"} || "")." +table.print_project td { vertical-align: top; } +", + "WebConfig::heading_novskip"=>1, + ); + $class->heading(); + print $class->platforms($ListItem->{"platform"}); + $class->print_project({ %$ListItem },%args); + return $W; +} + +sub one_item_list_read($$) +{ +my($class,$name)=@_; + + Wrequire "project::${name}::ListItem"; + my $item=eval('\@project::'.$name.'::ListItem::ListItem'); + do { warn "Broken project/$name/ListItem.pm"; next; } if !defined $item; + return @$item; +} + +sub item_hash_read () +{ +# FIXME: $class + my %dirs; + for my $ENTRIES (ENTRIES(),ENTRIES_LOG()) { + local *E; + next if !open E,$ENTRIES; + while () { + chomp; + do { $dirs{$1}=1; next; } if m#^(?:A )?D/([^/]*)/#; + next if m#^/([^/]*)/# ; + next if /^D$/; + warn "File $ENTRIES contains invalid line \"$_\": $!"; + } + close E; + } + + my %item; + for my $dir (keys(%dirs)) { + Wrequire "project::${dir}::ListItem"; + my $item=eval('\@project::'.$dir.'::ListItem::ListItem'); + do { warn "Broken project/$dir/ListItem.pm"; next; } if !defined $item; + $item{$dir}={ My::Project::project_arr_to_hash(My::Project->one_item_list_read($dir)) }; + } + return %item; +} + +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' ]}

+ +
    +
  • @{[ &{$view}('Detailed' ,'/project/','Detailed project listing per platform') ]}
    • +
  • @{[ &{$view}('BriefPlatform','/project/List.html.pl?platform=platform', + 'Brief project listing per platform') ]}
    • +
  • @{[ &{$view}('BriefUnified' ,'/project/List.html.pl', + 'Unified brief project listing') ]}
    • +
+@{[ vskip "1ex" ]} +HERE +} + +sub platforms ($;$%) +{ +my($class,$platform_selected,%args)=@_; + + my $r=""; + $r.=''."\n"; + $r.=''; + $r.=''."\n"; + $r.='
Projects:  '; + $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.=''."\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.=vskip "1ex" if !$args{"novskip"}; + $r; +} + +sub section ($$) +{ +my($class,$name)=@_; + + my %item=( $class->one_item_list_read($name) ); + my $title=$class->title(\%item); + my $r=""; + + print $class->platforms($item{"platform"},"novskip"=>1); + + $r.=''."\n"; + $r.=''."\n"; + $r.='
'; + $r.=''."\n"; + $r.=''."\n"; + $r.='
'."\n"; + $r.=a_href "/project/$name/",$title; + $r.='
'."\n"; + $r.='
'."\n"; + $r.=vskip "1ex"; + $r; +} + +1;