# $Id$ # Common 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 package 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); # Returns: hashref if !wantarray(), list if wantarray(). # This cache is "headers_in" hits safe - only local files reading. sub list_abspath($) { my($self,$list_abspath)=@_; Wrequire __PACKAGE__; # inheritance # Do not: path_abs_disk("/project/SUBDIRS"); # as we would need $W->{"r"} for the possibly relative path resolving. my $list_filename=My::Web::dir_top_abs_disk().$list_abspath; # %{$list_cache{$list_abspath}{"hash"}} # @{$list_cache{$list_abspath}{"array"}} our %list_cache; if (!$list_cache{$list_abspath}) { 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{$list_abspath}={ "array"=>\@r, "hash" =>{ map(($_=>1),@r) }, }; } return $list_cache{$list_abspath}{"hash"} if !wantarray(); return @{$list_cache{$list_abspath}{"array"}}; } sub _hashlikearray_get_keys(@) { my(@hashlikearray)=@_; my @r; while (@hashlikearray) { push @r,shift @hashlikearray; # key shift @hashlikearray; # val } return @r; } # $args{"override"}={"platform"=>"product"}; sub _project_arrayref_to_hashref($$) { my($self,$arrayref,%args)=@_; Wrequire 'My::Hash'; return My::Hash->new({ @$arrayref, map((!$_ ? () : %$_),$args{"override"}), "keys_array"=>[ _hashlikearray_get_keys(@$arrayref) ], },"My::Hash::Sub","My::Hash::Readonly"); } # Returns: hashlist of hashrefs if !$name. # 'abstract': requires: &$self::list sub name_to_hashref($;$%) { my($class,$name,%args)=@_; Wrequire __PACKAGE__; # inheritance my $project_product=($class=~/^(project|product)::/)[0] or cluck; cluck if !wantarray() && !$name; # Do not cache the result to get all the items &Wrequire-mapped. return map(($_=>$class->name_to_hashref($_,%args)),$class->list()) if !$name; cluck join(" ","Project name $project_product::\"$name\" not listed in 'list_cache':",$class->list()) if !$class->list()->{$name}; # Never cache anything to be stable for "headers_in" hits. Wrequire "${project_product}::${name}::Index"; my $arrayref=eval('\@'.$project_product.'::'.$name.'::Index::ListItem'); do { warn "Broken $project_product/$name/Index.pm"; return undef(); } if !@$arrayref; return $class->_project_arrayref_to_hashref($arrayref,%args); } sub title($$) { my($class,$hashref)=@_; cluck if !$hashref->{"name"} || !$hashref->{"summary"}; return $hashref->{"name"}.": ".$hashref->{"summary"}, } sub section($$) { my($class,$name)=@_; my $item=$class->name_to_hashref($name); my $title=$class->title($item); my $project_product=(caller()=~/^(project|product)::/)[0] or cluck; my $r=""; $r.=''."\n"; $r.=''."\n"; $r.='
'."\n"; $r.=a_href "/$project_product/$name/",$title; $r.='
'."\n"; $r.="
\n"; $r.=vskip "1ex"; return $r; } 1;