package Safari::Edit::Default ;
=head1
Safari::Edit::Default - output routine used to add menus to Safari output
=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 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 $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 = "$project/$file"
if ( length( $title ) == 0 ) ;
my $file_type = $options->{'file-type'} ;
my $mime_type = (grep( /^Content-type: /i, @$headers ))[0] ;
if ( defined( $mime_type ) ) {
$mime_type =~ s/^.*: //g ;
}
my $project_menu =
project_menu(
$file_type,
$mime_type,
$up_to_project,
$up_to_filter,
$filter,
$file,
$project
) ;
my $filter_menu =
filter_menu(
$file_type,
$mime_type,
$up_to_rev,
$filter,
$file
) ;
my $tool_menu =
tool_menu(
$file_type,
$mime_type,
$filter,
$file
) ;
my $file_date = localtime ;
my $rev_anchor ;
for ($rev) {
my ( $stripped ) = /^@(.*)/ ;
$rev_anchor =
/^@\d+$/ ?
qq{$_} :
/^@[^\d].*$/ ?
qq{$_} :
$_ ;
}
#
# Set up sections to insert
#
my $header = qq{
$rev_anchor
$title ($filter filter)
$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 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 HTML POD pretty plain ) ;
@filters = grep( $_ ne 'POD', @filters ) unless $file_type eq 'perl' ;
@filters = grep( $_ ne 'HTML', @filters ) unless $file_type eq 'html' ;
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( gcclint wc /_head/filelog ) ;
# $file_type is either 'text' or 'html', usually. We need to come up
# with a awy to pass the underlying file type.
# @tools = grep( $_ ne 'gcclint', @tools )
# unless $file_type eq 'c' || $file_type eq 'c++' ;
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 = join(
'',
'',
$name,
'',
) ;
return join( ' ', $name, @_) .
"