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 ) . "<BR>" ;
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{
<TABLE WIDTH="100%" BORDER="0" CELLPADDING="3" CELLSPACING="0">
<TR BGCOLOR="#B0E0FF">
<TD VALIGN="TOP" ALIGN="LEFT" COLSPAN="2">$locator</TD>
<TD><FONT SIZE="+3">$title</FONT></TD>
</TR>
<TR>
<TD BGCOLOR="#B0E0FF" VALIGN="TOP">
$project_menu$filter_menu$tool_menu
</TD>
<TD WIDTH="99%" VALIGN="TOP" ALIGN="LEFT" COLSPAN="2">
} ;
my $footer = qq{
</TD>
</TR>
<TR BGCOLOR="#B0E0FF">
<TD ALIGN="CENTER" COLSPAN="3">This page generated by Safari at $file_date</TD>
</TR>
</TABLE>
} ;
#
# insert them
#
$$contents = "$header$$contents"
unless $$contents =~
s@(<BODY.*?>)@<BODY BGCOLOR="#FFFFFF">$header@ims ;
$$contents .= $footer
unless $$contents =~ s@(</BODY.*?>)@$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{<A HREF="${up_to_project}_head/changes/$stripped.html">$enc_rev</A>} :
/^#head$/ ?
qq{<A HREF="${up_to_project}_head/changes/">$enc_rev</A>} :
/^@[^\d].*$/ ?
qq{<A HREF="${up_to_project}_head/labels/">$enc_rev</A>} :
$enc_rev ;
}
# my $prev_change_anchor = "<" ;
# my $next_change_anchor = ">" ;
return qq{
<TABLE CELLPADDING="0" CELLSPACING="0">
<TR>
<TD VALIGN="BOTTOM" ALIGN="RIGHT"><FONT SIZE="-1"><B>PROJ:</FONT></B></TD>
<TD><B>$project</B></TD>
</TR>
<TR>
<TD VALIGN="BOTTOM" ALIGN="RIGHT"><FONT SIZE="-1"><B>REV:</B></FONT></TD>
<TD><B>$rev_anchor</B></TD>
</TR>
<TR>
<TD VALIGN="BOTTOM" ALIGN="RIGHT"><FONT SIZE="-1"><B>FILT:</B></FONT></TD>
<TD><B>$filter</B></TD>
</TR>
</TABLE>
} ;
}
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 = "<A HREF=\"$project_url\">top</A>" ;
my $up_anchor =
length( $up_to_filter ) ? "<A HREF=\"$up_url\">up</A>" : "up" ;
my $rebuild_anchor = "<A HREF=\"$reload_url\">rebuild</A>" ;
my @reports = qw( changes labels ) ;
for ( @reports ) {
unless ( $_ eq $filter ) {
my $url = $_ ;
$url = "${up_to_project}_head/$_/index.html" ;
$_ =~ s/ / / ;
$_ = "<A HREF=\"$url\">$_</A>" ;
}
}
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/ / / ;
$_ = "<A HREF=\"$url\">$_</A>" ;
# }
# else {
# $_ =~ s/ / / ;
# }
}
return build_menu( 'FILTERS', @filters ) ;
}
sub tool_menu() {
my ( $file_type, $mime_type, $filter, $file ) = @_ ;
return '<BR>'
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/ / / ;
$_ = "<A HREF=\"$url\">$_</A>" ;
}
}
return build_menu( 'TOOLS', @tools ) ;
}
sub build_menu {
my $name = shift ;
$name = qq{<FONT SIZE="-1"><B>$name</B></FONT>} ;
return
join( "<BR>\n ", $name, @_) . "<BR><BR>\n";
}
| # | Change | User | Description | Committed | |
|---|---|---|---|---|---|
| #5 | 195 | Barrie Slaymaker | Added filters NoMunes, None (replaces HTML), tool Download. | ||
| #4 | 187 | Barrie Slaymaker |
Added lots of options to saf_http_out to let the source file be used to figure out file type for determining filter and tool menus. Changed Makefiles to pass the original source file name in to saf_http_out. Added --PRE to saf_http_out. This is good for displaying plain text versions of HTML files. Improved the tool and filter logic in Safari::Edit::p4.pm to work with original file type to determine what makes sense for what kind of file. This really needs to be generalized in to a config file instead of being buried in a module. Increased usage of HTML::Entities::encode_entities instead of s///g . Moved Content-type: header to after the edit() routine call and now we pass and recover mime-type as an option. Added SAF_TARGET to environment under cgimake, Fixed updirectory counting, which broke when cgimake started parsing the project name from PATH_INFO. Removed all edit routines from saf_http_out.conf files. NOTE: we can now fall back to a single cgimake.conf file. Any day now. |
||
| #3 | 168 | Barrie Slaymaker | Added YAPC paper, slides | ||
| #2 | 165 | Barrie Slaymaker | Applied Greg KH's license patch. | ||
| #1 | 162 | Barrie Slaymaker | First code & documentation checkin |