# $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(); Wrequire 'Lib'; our @ISA=qw(My::Web Lib Exporter); my $LIST_ABSPATH="/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 "GIT".$_[0]; }, "format"=>sub ($$) { my($val,$key)=@_; $key=~s/^cvs//; $key=~s/^-/ /; my $branch=""; $branch=$1 if $val=~s/:(.*)//; return join("
\n\t\t", #pserver: # 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)], ##FIXME: ["CVS ChangeLog" ,"/project/ChangeLog.pm?cvs=$val"] ["GIT repository",$W->{"project_viewcvs"}."?p=$val.git;a=tree".(!$branch ? "" : ";hb=$branch")], ["Download GIT snapshot",$W->{"project_viewcvs"}."?p=$val.git;a=snapshot;sf=tgz;h=".(!$branch ? "HEAD" : "$branch")], ["GIT shortlog",$W->{"project_viewcvs"}."?p=$val.git;a=shortlog".(!$branch ? "" : ";h=refs/heads/$branch")] ))); }}, {"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("".$_->[0]."".$_->[1]."\n",@$val)) if ref $val; $r.="$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; } # Returns: hashref if !wantarray(), list if wantarray(). sub list($) { my($self)=@_; return $self->list_abspath($LIST_ABSPATH); } # $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, ); do { &{$_}() if $_; } for $W->{__PACKAGE__."-init-hook"}; $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.=''."\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"}) { Wrequire 'WebConfig'; $r.=WebConfig->vskip_hr(); } return $r; } sub section($$) { my($class,$name)=@_; my $item=$class->name_to_hashref($name); return "" .$class->platforms($item->{"platform"},"novskip"=>1) .$class->SUPER::section($name); } 1;