# $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.='