# $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 print_project ($) { my($class,$ListItem)=@_; print "

".$ListItem->{"name"}."

\n"; print $ListItem->{"description"}; print "
\n"; 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 although no longer being actively developed.", "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.", ""=>"", ); my @r; for ($known{($_[0]=~/^([^-]*)-?/)[0] || ""}) { push @r,$_ if $_; push @r," $'" if $'; } return join(" ",@r); }}, {"key"=>qr(^download\b),"text"=>sub ($) { $_[0]=~s/^download//; $_[0]=~s/^-/ /; return "Download".$_[0]; }, "format"=>sub ($) { my $r; if ($_[0]=~m#^[a-z]+://#) { $r=a_href($_[0],CGI::escapeHTML($_[0])); } else { $r=a_href($_[0],CGI::escapeHTML(File::Basename::basename($_[0]))); my $size=(stat $_[0])[7]; die "Cannot stat \"".$_[0]."\": $!" if !defined $size; if ($size>=1024*1024) { $size=int($size/(1024*1024))." MB"; } elsif ($size>=1024 ) { $size=int($size/(1024 ))." KB"; } else { $size=int($size )." B"; } $r.=" ($size)"; } return $r; }}, {"key"=>qr(^link\b),"text"=>sub ($) { $_[0]=~s/^link-//; return $_[0]; }, "format"=>sub ($) { return a_href($_[0],CGI::escapeHTML($_[0])); }}, {"key"=>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" ,$W->{"top_dir"}."/project/ChangeLog.txt.pl?cvs=$val"]))); }}, {"key"=>"ownership","text"=>"Ownership"}, {"key"=>"sponsorship","text"=>"Sponsoring Company"}, {"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) ], ); } # $args{"ListItem"}=\%...; sub init_project ($%) { my($class,%args)=@_; my $ListItem={ project_arr_to_hash(@{$args{"ListItem"}}) }; my $name=$ListItem->{"name"}; $name=~s#]*>([^<]*)#$1#g; my $W=$class->init( "title"=>$name, %args, "head_css"=>($args{"head_css"} || "")." table.print_project td { vertical-align: top; } ", ); $class->heading(); $class->print_project({ %$ListItem }); return $W; } 1;