# $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"; do { print $_ if $_; } for ($args{"project_text_after_title"}); 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])),"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", 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(), # TODO:homepage %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.='
'; $r.=''."\n"; $r.=''."\n"; $r.=''."\n"; $r.=''."\n"; $r.='
'."\n"; $r.='Projects'; $r.='
'; $r.='
'; $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"; if (!$args{"novskip"}) { $r.="
\n"; $r.=My::Web::vskip "6ex"; } $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;