X-Git-Url: http://git.jankratochvil.net/?a=blobdiff_plain;f=Web.pm;h=1a3f9e0a072f9d1f3f7d85b4d091bb9e9e67f0dc;hb=6c5cf4306de5fcb4958519e0f73cac52fea32753;hp=f67c47d206c4678602ec97ff75f6de9a0397308b;hpb=209bb85c6749050cd5f57241f43d118b04cd41f3;p=MyWeb.git diff --git a/Web.pm b/Web.pm index f67c47d..1a3f9e0 100644 --- a/Web.pm +++ b/Web.pm @@ -31,14 +31,18 @@ our @EXPORT=qw( &Wrequire &Wuse &path_web &path_abs_disk &uri_escaped - &a_href &a_href_cz + &a_href &a_href_cc &vskip &img ¢erimg &rightimg $W &input_hidden_persistents + &escapeHTML ); our @ISA=qw(Tie::Handle Exporter); +my %packages_used_hash; # $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1; +my %packages_used_array; + BEGIN { use Carp qw(cluck confess); @@ -63,8 +67,10 @@ BEGIN for my $target ($class,__PACKAGE__) { for my $caller (keys(%callers)) { next if $caller eq $target; - next if $W->{'packages_used%'}{$caller}{$target}++; - push @{$W->{'packages_used@'}{$caller}},$target; + next if $packages_used_hash{$caller}{$target}++; + cluck "Appending to the '_done' package list: caller=$caller,target=$target" + if $packages_used_hash{$caller}{"_done"}; + push @{$packages_used_array{$caller}},$target; } } eval { CORE::require "$file"; } or confess $@; @@ -93,36 +99,37 @@ BEGIN } use WebConfig; # see also below: Wuse 'WebConfig'; -require CGI; # for &escapeHTML require Image::Size; # for &imgsize use File::Basename; # &basename use Carp qw(cluck confess); use URI::Escape; require HTTP::BrowserDetect; require HTTP::Negotiate; -my $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; } +our $have_Geo_IP; BEGIN { $have_Geo_IP=eval { require Geo::IP; 1; }; } # Do not: use ModPerl::Util qw(exit); # to prevent in mod_perl2: "exit" is not exported by the ModPerl::Util module # I do not know why. use POSIX qw(strftime); use Tie::Handle; -use Apache2::Const qw(HTTP_MOVED_TEMPORARILY); +use Apache2::Const qw(HTTP_MOVED_TEMPORARILY OK HTTP_OK); use URI; use URI::QueryParam; use Cwd; +require HTTP::Date; +require Storable; +require Digest::MD5; +require Data::Compare; +use Data::Dumper; +require Encode; +use Apache2::Filter; +use Apache2::Connection; +require MIME::Base64; +use Apache2::ServerUtil; +require MIME::Types; +require MIME::Parser; #our $W; - # $W->{"title"} - # $W->{"head"} - # $W->{"force_charset"} - # $W->{"heading_done"} - # $W->{"footer_passed"} - # %{$W->{"headers"}} - # %{$W->{"headers_lc"}} # maps lc($headers_key)=>$headers_key - # @{$W->{'packages_used@'}{callers...}} - # %{$W->{'packages_used%'}{callers...}} - # %{$W->{"args"}} sub init ($%) { @@ -134,31 +141,36 @@ my($class,%args)=@_; # We cannot do it in BEGIN { } block # as it would not be tracked for each of the toplevel users later. Wuse 'WebConfig'; - Wrequire 'My::Hash::Sub'; - - my $packages_used_array_save=$W->{'packages_used@'}; - my $packages_used_hash_save =$W->{'packages_used%'}; - $W={}; - tie %$W,"My::Hash::Sub"; - %$W=(%WebConfig,%args); # override %WebConfig settings - $W->{'packages_used@'}=$packages_used_array_save; - $W->{'packages_used%'}=$packages_used_hash_save; - $W->{"__PACKAGE__"}||=caller(); + Wrequire 'My::Hash'; + + # $W={} can get somehow created very easily. + # Do not: cluck "W not empty:\n".Dumper($W) if keys(%$W); + # to prevent (of $W->{"headers_in"}): TODO: Enumeration may not be expected. + cluck "W not empty; __PACKAGE__ was: ".$W->{"__PACKAGE__"} if keys(%$W); + $W=My::Hash->new({},"My::Hash::Sub","My::Hash::Push"); + bless $W,$class; + %$W=( + "__PACKAGE__"=>scalar(caller()), + %WebConfig, + %args, # override %WebConfig settings + ); # {"__PACKAGE__"} is mandatory for mod_perl-2.0; # $Apache2::Registry::curstash is no longer supported. do { cluck "No $_" if !$W->{$_}; } for "__PACKAGE__"; - - do { $W->{$_}=0 if !defined $W->{$_}; } for ("detect_ent"); - do { $W->{$_}=0 if !defined $W->{$_}; } for ("detect_js"); - do { $W->{$_}=1 if !defined $W->{$_}; } for ("have_css"); # AFAIK it does not hurt anyone. - do { $W->{$_}=1 if !defined $W->{$_}; } for ("footer"); - do { $W->{$_}=1 if !defined $W->{$_}; } for ("footer_delimit"); - do { $W->{$_}=1 if !defined $W->{$_}; } for ("footer_ids"); - do { $W->{$_}=1 if !defined $W->{$_}; } for ("indexme"); - do { $W->{$_}="" if !defined $W->{$_}; } for ("head"); - do { $W->{$_}="" if !defined $W->{$_}; } for ("body_attr"); - do { $W->{$_}="en-US" if !defined $W->{$_}; } for ("language"); + exit_hook_start(); + + do { $W->{$_}=0 if !defined $W->{$_}; } for "detect_ent"; + do { $W->{$_}=0 if !defined $W->{$_}; } for "detect_js"; + do { $W->{$_}=1 if !defined $W->{$_}; } for "have_css"; # AFAIK it does not hurt anyone. + do { $W->{$_}=0 if !defined $W->{$_}; } for "css_inherit"; + do { $W->{$_}=1 if !defined $W->{$_}; } for "footer"; + do { $W->{$_}=1 if !defined $W->{$_}; } for "footer_delimit"; + do { $W->{$_}=1 if !defined $W->{$_}; } for "footer_ids"; + do { $W->{$_}=1 if !defined $W->{$_}; } for "indexme"; + do { $W->{$_}="" if !defined $W->{$_}; } for "head"; + do { $W->{$_}="" if !defined $W->{$_}; } for "body_attr"; + do { $W->{$_}="en-US" if !defined $W->{$_}; } for "language"; my $footer_any=0; for (qw(footer_ids)) { @@ -170,60 +182,276 @@ my($class,%args)=@_; $W->{"r"}=Apache2::RequestUtil->request(); + $W->{"r"}->push_handlers("PerlCleanupHandler"=>\&cleanup); + + $W->{"web_hostname"}||=$W->{"r"}->hostname(); + tie *STDOUT,$W->{"r"}; select *STDOUT; $|=1; - $W->{"QUERY_STRING"}=$W->{"r"}->args() || ""; - if ($W->{"detect_ent"}) { - if ($W->{"QUERY_STRING"}=~/[&]amp;have_ent/) - { $W->{"have_ent"}=0; } - elsif ($W->{"QUERY_STRING"}=~ /[&]have_ent/) - { $W->{"have_ent"}=1; } - else - { delete $W->{"have_ent"}; } - if (!defined $W->{"have_ent"} && $W->{"r"}->method() eq "GET") { - $W->{"head"}.='{"web_hostname"}."/".($W->{"r"}->uri()=~m#^/*(.*)$#)[0] - ."?".($W->{"QUERY_STRING"} || "detect_ent_glue=1").'&have_ent=detect') - .'" />'."\n"; + $W->{"headers_in"}=$W->{"r"}->headers_in(); + Wrequire 'My::Hash::Merge'; + $W->{"headers_in"}=My::Hash::Merge->new( + $W->{"headers_in"}, + My::Hash::Sub->new({ + "_remote_ip"=>sub { return $W->{"r"}->connection()->remote_ip(); }, + }), + ); + Wrequire 'My::Hash::Readonly'; + $W->{"headers_in"}=My::Hash::Readonly->new($W->{"headers_in"}); + + if ($W->{"r"}->method() eq "GET" || $W->{"r"}->method() eq "HEAD") { + for (\$W->{"http_safe"}) { + # Do not: # Extend the current ETag system instead if you would need it: + # cluck "Explicitely NOT HTTP-Safe for method \"".$W->{"r"}->method()."\"?!?" + # if defined($$_) && !$$_; + # as sometimes it just does not make sense to cache it. + $$_=1 if !defined $$_; } } - $W->{"QUERY_STRING"}=~s/([&])amp;/$1/g; - $W->{"r"}->args($W->{"QUERY_STRING"}); - # Workaround: &CGI::Vars behaves weird if strings passed both as POST data and in: $QUERY_STRING - do { $W->{"r"}->args(""); delete $ENV{"QUERY_STRING"}; } if $W->{"r"}->method() eq "POST"; - # Do not: $W->{"r"}->args() - # as it parses only QUERY_STRING (not POST data). - $W->{"args"}={ CGI->new($W->{"r"})->Vars() }; - for my $name (keys(%{$W->{"args"}})) { - my @vals=split /\x00/,$W->{"args"}{$name}; - next if @vals<=1; - $W->{"args"}{$name}=[@vals]; + else { + for (\$W->{"http_safe"}) { + cluck "Undefined HTTP-Safe-ty for method \"".$W->{"r"}->method()."\"!" + if !defined($$_); + $$_=0 if !defined $$_; + } + } + if ($W->{"http_safe"}) { + Wrequire 'My::Hash::RecordKeys'; + $W->{"headers_in_RecordKeys"}=My::Hash::RecordKeys->new($W->{"headers_in"}); + $W->{"headers_in"}=$W->{"headers_in_RecordKeys"}; } - do { $W->{$_}=$W->{"r"}->headers_in()->{"Accept"} if !defined $W->{$_}; } for ("accept"); - do { $W->{$_}=$W->{"r"}->headers_in()->{"User-Agent"}||"" if !defined $W->{$_}; } for ("user_agent"); + { + local $_=$W->{"r"}->args() || ""; + if ($W->{"detect_ent"}) { + if (/[&]amp;have_ent/) + { $W->{"have_ent"}=0; } + elsif ( /[&]have_ent/) + { $W->{"have_ent"}=1; } + else + { delete $W->{"have_ent"}; } + if (!defined $W->{"have_ent"} && $W->{"r"}->method() eq "GET") { + $W->{"head"}.='{"web_hostname"}."/".($W->{"r"}->uri()=~m#^/*(.*)$#)[0] + ."?".($_ || "detect_ent_glue=1").'&have_ent=detect') + .'" />'."\n"; + } + } + s/([&])amp;/$1/g; + $W->{"r"}->args($_); + } + + $W->{"args"}=URI->new("?".$W->{"r"}->args())->query_form_hash(); + $W->merge_post_args() if $W->{"r"}->method() eq "POST"; + # Prepare '$args' first to (FIXME: Why?) prevent: Not a reference + my $args=$W->{"args"}; + $W->{"args_orig"}=Storable::dclone($args); - $W->{"browser"}=HTTP::BrowserDetect->new($W->{"user_agent"}); + $W->{"browser"}=sub { + # Lazy-evaluation, we may not need the "User-Agent" header at all. + return our $r||=HTTP::BrowserDetect->new($W->{"headers_in"}{"User-Agent"}); + }; if (!defined $W->{"have_style"}) { - $W->{"have_style"}=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0); + $W->{"have_style"}=sub { + # Lazy-evaluation, we may not need the "User-Agent" header at all. + return our $r||=(!$W->{"browser"}->netscape() || ($W->{"browser"}->major() && $W->{"browser"}->major()>4) ? 1 : 0); + }; } $W->{"have_js"}=($W->{"args"}{"have_js"} ? 1 : 0); if ($W->{"detect_js"} && !$W->{"have_js"}) { - $W->{"head"}.=''."\n"; + # Do not: + # as at least Lynx inhibits any further HTML output. + # Do not: text/javascript + # as it does not look as registered, at least according to: MIME::Types $VERSION 1.15 + # "application/javascript" so far standardized till 2005-12-08 by: + # http://www.ietf.org/internet-drafts/draft-hoehrmann-script-types-03.txt + $W->{"head"}.=''."\n"; } - do { args_check(%$_) if $_; } for ($W->{"args_check"}); + do { _args_check(%$_) if $_; } for ($W->{"args_check"}); + + $W->{"_init_done"}=1; + return $W; +} - $ENV{"HOSTNAME"}||=$W->{"web_hostname"}; +sub merge_post_args($) +{ +my($class)=@_; - return bless $W,$class; + my @post_args=$class->read_post_args(); + while (@post_args) { + my $name=shift @post_args; + my $data=shift @post_args; + my $ref=\$W->{"args"}{$name}; + if (!defined $$ref) { $$ref=$data; } + elsif (!ref $$ref) { $$ref=[$$ref,$data]; } + elsif ("ARRAY" eq ref $$ref) { push @$$ref,$data; } + else { + cluck "Ignoring POST argument \"$name\", orig is weird:\n",Dumper($$ref); + } + } + return; } -# Although we have &tie-d *STDOUT we try to not to be dependent on it in My::Web itself. +# Do not: use CGI; +# as CGI parsing of POST vs. QUERY_STRING data, multiple-valued keys etc. +# is too dense and causes weird problems, together with mod_perl etc. +sub read_post_args($) +{ +my($class)=@_; + + local $_=$class->http_headers_in_for("Content-type")->content_type(); + return $class->read_multipart_form_data() if $_ eq "multipart/form-data"; + return $class->read_application_x_www_form_urlencoded() if $_ eq "application/x-www-form-urlencoded"; + cluck "Unknown POST data body, ignored: $_"; + return; +} + +sub read_application_x_www_form_urlencoded($) +{ +my($class)=@_; + + my $body=""; + for (;;) { + my $got=$W->{"r"}->read(my($buf),0x1000); + # Do not: cluck "Error reading POST data: $!" if !defined $got; + # as it should be done using: APR::Error exceptions + last if !$got; + $body.=$buf; + } + return URI->new("?".$body)->query_form(); +} + +sub read_multipart_form_data($) +{ +my($class)=@_; + + my $parser=MIME::Parser->new(); + # FIXME: No unlink()s done! + $parser->output_under("/tmp"); + + local *R_FH; + tie *R_FH,$W->{"r"}; + local *FH; + tie *FH,"My::Web::ReadMerged", + join("",map(($_.": ".$W->{"headers_in"}{$_}."\n"),qw( + Content-type + )))."\n", + \*R_FH; + my $body=$parser->parse(\*FH); + cluck "No multipart POST request body?" if !$body->is_multipart(); + + return map(( + $_->head()->mime_attr("content-disposition.name") + => + join("",@{$_->body()}) + ),$body->parts()); + + # TODO: Globalize, make it IO::* compatible, split to the merging part + IO::Scalar. + package My::Web::ReadMerged; + + require Tie::Handle; + require Exporter; + our @ISA=qw(Tie::Handle Exporter); + use Carp qw(cluck confess); + + sub READLINE($) + { + my($self)=@_; + + confess "Slurp not yet implemented" if !defined $/; + # Apache2::RequestIO does not support 'READLINE'! + for (;;) { + if (defined $self->{"data"} && $self->{"data"}=~s{^.*\Q$/\E}{}) { + $self->{"offset"}+=length $&; + return $&; + } + my $fh_orig=$self->{"fh_orig"}; + if (!$fh_orig) { + my $r=$self->{"data"}; + delete $self->{"data"}; + $self->{"offset"}+=length $r if defined $r; + return $r; + } + my $got=read $fh_orig,my($buf),0x1000; + cluck "Error reading POST data: $!" if !defined $got; + delete $self->{"fh_orig"} if !$got; + cluck "INTERNAL: fh_orig should not exist here" if !defined $self->{"data"}; + $self->{"data"}.=$buf; + } + } + + sub TELL($) + { + my($self)=@_; + + return $self->{"offset"}; + } + + sub TIEHANDLE($$$) + { + my($class,$data,$fh_orig)=@_; + + my $self=bless {},$class; + $self->{"data"}=$data; + $self->{"offset"}=0; + $self->{"fh_orig"}=$fh_orig; + return $self; + } +} + +sub cleanup($) +{ +my($apache_request)=@_; + + cluck "CORE::GLOBAL::exit hook not ran" if !$W->{"_exit_done"}; + cluck "packages not finalized" if !$packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}; + cache_finish(); + # Sanity protection. + $W=undef(); + exit_hook_stop(); + return OK; +} + +# PerlResponseHandler is RUN_FIRST and &ModPerl::Util::exit returns OK, so no (sane) go. +# PerlLogHandler is already too late to be able to produce any output. +my $exit_orig; +sub exit_hook +{ + cluck "Missing ->init while in exit_hook()" if !$W->{"_init_done"}; + # &footer will call us recursively! + footer() if !$W->{"_exit_done"}++; + return &{$exit_orig}(@_); +} +sub exit_hook_start +{ + do { cluck "exit_hook_start() twice?"; return; } if defined $exit_orig; + $exit_orig=\&CORE::GLOBAL::exit; + # Prevent: Subroutine CORE::GLOBAL::exit redefined + no warnings 'redefine'; + *CORE::GLOBAL::exit=\&exit_hook; +} +sub exit_hook_stop +{ + do { cluck "exit_hook_stop() without exit_hook_start()?"; return; } + if \&exit_hook ne \&CORE::GLOBAL::exit; + do { cluck "INTERNAL: exit_orig uninitialized"; return; } + if !$exit_orig; + # Prevent: Subroutine CORE::GLOBAL::exit redefined + no warnings 'redefine'; + *CORE::GLOBAL::exit=$exit_orig; + $exit_orig=undef(); +} + +# Be aware other parts of code (non-My::Web) will NOT use this function! +# Do not: Wprint $W->{"heading"},"undef"=>1; +# as we would need to undef() it to turn it off and it would get defaulted in such case. +# Do not: exists $W->{"heading"} +# as we use a lot of 'for $W->{"heading"}' which instantiates it with the value: undef() sub Wprint($%) { my($text,%args)=@_; @@ -231,35 +459,35 @@ my($text,%args)=@_; cluck "undef Wprint" if !defined $text && !$args{"undef"}; delete $args{"undef"}; cluck join(" ","Invalid arguments:",keys(%args)) if keys(%args); - $W->{"r"}->puts($text) if defined $text; + return if !defined $text; + # Do not: cluck "utf-8 untested" if Encode::is_utf8($text); + # as it is valid here. + $W->{"r"}->puts($text); } -sub escapeHTML($) +sub request_check(;$) { -my($text)=@_; +my($self)=@_; # Use &eval to prevent: Global $r object is not available. Set:\n\tPerlOptions +GlobalRequest\nin ... - # CGI requires valid "r": check it beforehand here. - confess "Calling dynamic URL generator from a static code" if !eval { Apache2::RequestUtil->request(); }; - return CGI::escapeHTML($text); -} - -# local *FH; -# tie *FH,ref($W),$W; -sub TIEHANDLE($) -{ -my($class,$W)=@_; - - my $self={}; - $self->{"W"}=$W or confess "Missing W"; - return bless $self,$class; + confess "Calling sensitive dynamic code from a static code" if !eval { Apache2::RequestUtil->request(); }; + # Do not: confess "Calling sensitive dynamic code without My::Web::init" if !$W->{"__PACKAGE__"}; + # as it is valid at least while preparing arguments to call: &project::Lib::init } -sub WRITE +# Do not: use CGI; +# as it is too much backward compatible regarding the charset encodings etc. +# and the resulting code is too dense with no additional functionality for the recent content. +sub escapeHTML($) { -my($self,$scalar,$length,$offset)=@_; +my($text)=@_; - Wprint substr($scalar,0,$length); + local $_=$text; + s{&}{&}gso; + s{<}{<}gso; + s{>}{>}gso; + s{"}{"}gso; + return $_; } # /home/user/www/webdir @@ -286,13 +514,14 @@ sub dir_top_abs_disk() sub unparsed_uri() { + request_check(); if (!$W->{"unparsed_uri"}) { # Do not: $W->{"r"} # as we may be called before &init from: &My::Project::init my $r=Apache2::RequestUtil->request(); cluck "Calling ".'&unparsed_uri'." from a static code, going to fail" if !$r; my $uri_string=$r->unparsed_uri() or cluck "Valid 'r' missing unparsed_uri()?"; - my $uri=URI->new_abs($uri_string,"http://".($W->{"web_hostname"}||$WebConfig{"web_hostname"})."/"); + my $uri=URI->new_abs($uri_string,"http://".$W->{"web_hostname"}."/"); $W->{"unparsed_uri"}=$uri; } return $W->{"unparsed_uri"}; @@ -315,6 +544,7 @@ my($in)=@_; } # $args{"uri_as_in"}=1 to permit passing URI objects as: $in +# $args{"abs"}=1; sub path_web($%) { my($in,%args)=@_; @@ -323,6 +553,7 @@ my($in,%args)=@_; my $uri=in_to_uri_abs($in); if (uri_is_local($uri)) { # Prefer the $uri values over "args_persistent" values. + # &query_form_hash comes from: URI::QueryParam $uri->query_form_hash({ map({ my $key=$_; @@ -336,6 +567,13 @@ my($in,%args)=@_; return $uri->rel(unparsed_uri()); } +sub path_abs_disk_register($) +{ +my($path_abs_disk)=@_; + + $W->{"path_abs_disk_register"}{$path_abs_disk}=1; +} + # $args{"uri_as_in"}=1 to permit passing URI objects as: $in sub path_abs_disk($%) { @@ -346,12 +584,14 @@ my($in,%args)=@_; cluck if !uri_is_local($uri); my $path=$uri->path(); cluck "URI compatibility: ->path() not w/leading slash of URI \"$uri\"; path: $path" if $path!~m{^/}; - return dir_top_abs_disk().$path; + my $r=dir_top_abs_disk().$path; + path_abs_disk_register $r if !defined $args{"register"} || $args{"register"}; + return $r; } sub fatal (;$); -sub args_check (%) +sub _args_check (%) { my(%tmpl)=@_; @@ -398,21 +638,38 @@ my($msg)=@_; Wprint "\n".vskip("3ex")."
You can report this problem's details to" ." ".a_href("mailto:".$W->{"admin_mail"},"admin of this website").".
\n"; - footer(); + exit; } -sub footer (;$) +sub footer_packages_used_comments() { - exit 1 if $W->{"footer_passed"}++; # deadlock prevention: - - Wprint vskip if $W->{"footer_delimit"}; + my $packages_used=$packages_used_array{$W->{"__PACKAGE__"}}; + for my $package (@$packages_used) { + my $cvs_id=(eval('$'.$package."::CVS_ID") +# || $package # debug + ); + Wprint ''."\n" if $cvs_id; + } +} - Wprint $W->{"footing_delimit"},"undef"=>1; +sub footer() +{ + cluck 'Explicit &footer call is deprecated, !_exit_dne' if !$W->{"_exit_done"}; + exit if $W->{"footer_done"}++; # deadlock prevention: + &{$_}() for reverse @{$W->{"footer_sub_push"}}; + if ($W->{"header_only"}) { + $packages_used_hash{$W->{"__PACKAGE__"}}{"_done"}=1; + exit; + } + Wprint vskip if $W->{"footer_delimit"}; + &{$_}() for reverse @{$W->{"footing_delimit_sub_push"}}; Wprint "';
Wprint join("
\n",map({ my $package=$_;
@@ -438,11 +695,17 @@ sub footer (;$)
cluck "Class file $file not found; tried: ".join(" ",@tried) if !$ext;
}
$file.=$ext;
+ my $viewcvs;
+ if ((my $file_cvs=$file)=~s{^My/}{}) {
+ $viewcvs=$W->{"viewcvs_My"}.$file_cvs;
+ }
+ else {
+ $viewcvs=$W->{"viewcvs"}.$file;
+ }
$cvs_id_split[2]=""
- .a_href((map({ my $s=$_; $s=~s#/viewcvs/#$&~checkout~/#; $s; } $W->{"viewcvs"}))[0]."$file?rev=".$cvs_id_split[2],
+ .a_href((map({ my $s=$_; $s=~s#/viewcvs/#$&~checkout~/#; $s; } $viewcvs))[0]."?rev=".$cvs_id_split[2],
$cvs_id_split[2]);
- $cvs_id_split[1]=a_href($W->{"viewcvs"}.$file,
- ($package!~/^Apache2::/ ? $package : $cvs_id_split[1]));
+ $cvs_id_split[1]=a_href($viewcvs,($package!~/^Apache2::/ ? $package : $cvs_id_split[1]));
$cvs_id_split[5]=&{$W->{"cvs_id_author_sub"}}($cvs_id_split[5]);
}
join " ",@cvs_id_split;
@@ -451,30 +714,22 @@ sub footer (;$)
Wprint "