package Safari::Edit::p4 ; =head1 Safari::Edit::p4 - add banners, menus to Safari output for p4 archives =head1 DESCRIPTION This module can be used by saf_http_out to alter the contents of a page before it is sent to a browser. This is used to add a banner and menus to text and html pages. =cut use strict ; use File::Basename ; use HTML::Entities qw( encode_entities ) ; use vars qw( @options ) ; # # Allow extra command line options to be passed in. # @::option_specs = ( @::option_specs, 'title=s', ) ; # # edit() gets called by saf_http_out according to the settings in it's # configuration file. It may change any of the options (like file-type) # or any headers or the contents. # # $options is a ref to a hash containing command line options # $headers is a ref to an array of strings containing header lines in # the order they are to be printed, like "Content-type: text/html". # $contents is a ref to a scalar containing the entire contents of the file # to be modified. # sub edit { my ( $options, $headers, $contents ) = @_ ; my $file_type = $options->{'file-type'} ; my $mime_type = $options->{'mime-type'} ; my $source_file_type = $options->{'source-file-type'} ; my $source_mime_type = $options->{'source-mime-type'} ; return unless $mime_type eq 'text/html' ; my $title = ( exists $options->{'title'} && $options->{'title'} ) || '' ; my $project = $ENV{SAF_PROJECT} ; my $up_to_project = $ENV{SAF_UP_TO_PROJECT} ; my $up_to_rev = $ENV{SAF_UP_TO_REV} ; my $up_to_filter = $ENV{SAF_UP_TO_FILTER} ; my $rev = $ENV{SAF_REV} ; my $filter = $ENV{SAF_FILTER} ; my $file = $ENV{SAF_FILE} ; $rev =~ s/^_/#/ ; $title = "$file" if ( length( $title ) == 0 ) ; $title = encode_entities( $title ) . "
" ; my $locator = locator( $up_to_project, $project, $rev, $filter ) ; my $project_menu = project_menu( $source_file_type, $source_mime_type, $up_to_project, $up_to_filter, $filter, $file, $project ) ; my $filter_menu = filter_menu( $source_file_type, $source_mime_type, $up_to_rev, $filter, $file ) ; my $tool_menu = tool_menu( $source_file_type, $source_mime_type, $filter, $file ) ; my $file_date = localtime ; # # Set up sections to insert # my $header = qq{

$locator		$title
$project_menu$filter_menu$tool_menu	} ; my $footer = qq{
This page generated by Safari at $file_date

} ; # # insert them # $$contents = "$header$$contents" unless $$contents =~ s@()@$header@ims ; $$contents .= $footer unless $$contents =~ s@()@$footer$1@ims ; return 1 ; } ############################################################################# sub locator { my ( $up_to_project, $project, $rev, $filter ) = @_ ; my $rev_anchor ; $project = encode_entities( $project ) ; $filter = encode_entities( $filter ) ; for ($rev) { my ( $stripped ) = /^@(.*)/ ; my $enc_rev = encode_entities( $_ ) ; $rev_anchor = /^@\d+$/ ? qq{$enc_rev} : /^#head$/ ? qq{$enc_rev} : /^@[^\d].*$/ ? qq{$enc_rev} : $enc_rev ; } # my $prev_change_anchor = "<" ; # my $next_change_anchor = ">" ; return qq{

PROJ:	$project
REV:	$rev_anchor
FILT:	$filter

} ; } sub project_menu { my ( $file_type, $mime_type, $up_to_project, $up_to_filter, $filter, $file, $project ) =@_ ; my $project_url = "$up_to_filter" ; my $basename = basename( $file ) ; # # If we're browsing a file, then 'up' means go to our current directory, # otherwise it means '..', unless we're at the top of this filter. # my $up_url = ( $file =~ m@./$@ ) ? '../' : '' ; my $query_string = $ENV{QUERY_STRING} ; $query_string =~ s/force=yes&?//g ; $query_string =~ s/&force=yes//g ; $query_string =~ s/project=[^&]+&?//g ; $query_string =~ s/&project=[^&]//g ; # # We don't bother setting project= here because it's picked up out of # $script_uri. Of course, this needs to change... # my $reload_url = "$basename?force=yes&$query_string" ; my $project_anchor = "top" ; my $up_anchor = length( $up_to_filter ) ? "up" : "up" ; my $rebuild_anchor = "rebuild" ; my @reports = qw( changes labels ) ; for ( @reports ) { unless ( $_ eq $filter ) { my $url = $_ ; $url = "${up_to_project}_head/$_/index.html" ; $_ =~ s/ / / ; $_ = "$_" ; } } return build_menu( 'PROJECT', $project_anchor, $up_anchor, @reports, $rebuild_anchor, ) ; } sub filter_menu() { my ( $file_type, $mime_type, $up_to_rev, $filter, $file ) = @_ ; return '' if $file !~ m@[^/]$@ || grep( /^(changes|labels)$/, $filter ) ; my @filters = qw( Default ChLines NoMenus None pretty plain ) ; unshift( @filters, 'POD' ) if grep{ $_ eq $file_type } qw( perl ) ; @filters = sort { lc($a) cmp lc($b) } @filters ; for ( @filters ) { # unless ( $_ eq $filter ) { my $url = "$up_to_rev$_/$file" ; $_ =~ s/ / / ; $_ = "$_" ; # } # else { # $_ =~ s/ / / ; # } } return build_menu( 'FILTERS', @filters ) ; } sub tool_menu() { my ( $file_type, $mime_type, $filter, $file ) = @_ ; return '
' if $file !~ m@[^/]$@ || grep( /^(changes|labels)$/, $filter ) ; my @tools = qw( Download wc /_head/filelog ) ; unshift( @tools, 'gcclint' ) if grep { $_ eq $file_type } qw( c c++ ) ; @tools = sort { lc($a) cmp lc($b) } @tools ; my $basename = basename( $file ) ; # # 'tools' should not change the current filter. So, tools are launched # using a QUERY_STRING targets= entry which overrides the PATH_INFO # section when the make is done. This allows PATH_INFO to be unchanged # and the tool to be run instead. # for ( @tools ) { unless ( $_ eq $filter ) { my $url = $_ ; $url =~ s/ /_/ig ; if ( substr( $url, 0, 1 ) eq '/' ) { my ( $new_rev, $new_filter ) = m@/([^/]*)/(.*)@ ; $url = "$basename?rev=$new_rev&filter=$new_filter" ; } else { $url = "$basename?filter=$url" } $_ =~ s@^/[^/]*/@@ ; $_ =~ s/ / / ; $_ = "$_" ; } } return build_menu( 'TOOLS', @tools ) ; } sub build_menu { my $name = shift ; $name = qq{$name} ; return join( "
\n ", $name, @_) . "

\n"; }