package SBEAMS::Connection::HTMLPrinter;
###############################################################################
# Program : SBEAMS::Connection::HTMLPrinter
# Author : Eric Deutsch
# $Id$
#
# Description : This is part of the SBEAMS::Connection module which handles
# standardized parts of generating HTML.
#
# This really begs to get a lot more object oriented such that
# there are several different contexts under which the a user
# can be in, and the header, button bar, etc. vary by context
#
# SBEAMS is Copyright (C) 2000-2005 Institute for Systems Biology
# This program is governed by the terms of the GNU General Public License (GPL)
# version 2 as published by the Free Software Foundation. It is provided
# WITHOUT ANY WARRANTY. See the full description of GPL terms in the
# LICENSE file distributed with this software.
#
###############################################################################
use strict;
use vars qw($current_contact_id $current_username $q
$current_work_group_id $current_work_group_name
$current_project_id $current_project_name $current_user_context_id);
use CGI::Carp qw(croak);
use SBEAMS::Connection::DBConnector;
use SBEAMS::Connection::Log;
use SBEAMS::Connection::Authenticator qw($q);
use SBEAMS::Connection::Settings;
use SBEAMS::Connection::Tables;
use SBEAMS::Connection::TableInfo;
use SBEAMS::Connection::TabMenu;
use Env qw (HTTP_USER_AGENT);
my $log = SBEAMS::Connection::Log->new();
###############################################################################
# Constructor
###############################################################################
sub new {
my $this = shift;
my $class = ref($this) || $this;
my $self = {};
bless $self, $class;
return($self);
}
###############################################################################
# display_page_header
###############################################################################
sub display_page_header {
my $self = shift;
$self->printPageHeader(@_);
}
###############################################################################
# printPageHeader
###############################################################################
sub printPageHeader {
my $self = shift;
my %args = @_;
my $navigation_bar = $args{'navigation_bar'} || "YES";
my $minimal_header = $args{'minimal_header'} || "NO";
#### If the output mode is interactive text, display text header
if ($self->output_mode() eq 'interactive') {
$self->printTextHeader();
return;
}
#### If the output mode is not html, then we don't need the rest
return unless $self->output_mode() eq 'html';
my $http_header = $self->get_http_header( $self->get_output_mode() );
print $http_header;
print qq~
$DBTITLE - Systems Biology Experiment Analysis Management System
~;
#### Only send Javascript functions if the full header desired
unless ($minimal_header eq "YES") {
$self->printJavascriptFunctions();
}
#### Send the style sheet
$self->printStyleSheet();
#### Determine the Title bar background decoration
my $header_bkg = "bgcolor=\"$BGCOLOR\"";
$header_bkg = "background=\"$HTML_BASE_DIR/images/plaintop.jpg\"" if ($DBVERSION =~ /Primary/);
print qq~
$DBTITLE - Systems Biology Experiment Analysis Management System $DBVERSION
~;
#### Get the list of Modules available to us
my @modules = $self->getModules();
#### Print out entries for each module
my $module;
foreach $module (@modules) {
print qq~
~;
}
}
###############################################################################
# printStyleSheet
#
# Print the standard style sheet for pages. Use a font size of 10pt if
# remote client is on Windows, else use 12pt. This ends up making fonts
# appear the same size on Windows+IE and Linux+Netscape. Other tweaks for
# different browsers might be appropriate.
###############################################################################
sub printStyleSheet {
my $self = shift;
my $FONT_SIZE=9;
my $FONT_SIZE_SM=8;
my $FONT_SIZE_MED=12;
my $FONT_SIZE_LG=12;
my $FONT_SIZE_HG=14;
if ( $HTTP_USER_AGENT =~ /Mozilla\/4.+X11/ ) {
$FONT_SIZE_SM=11;
$FONT_SIZE=12;
$FONT_SIZE_MED=3;
$FONT_SIZE_LG=14;
$FONT_SIZE_HG=19;
}
print qq~
\n";
#### Boneyard:
# th { font-family: Arial, Helvetica, sans-serif; font-size: ${FONT_SIZE}pt; font-weight: bold; background-color: #A0A0A0;}
# pre { font-family: Courier; font-size: ${FONT_SIZE}pt}
}
###############################################################################
# printJavascriptFunctions
#
# Print the standard Javascript functions that should appear at the top of
# most pages. There probably should be some customization allowance here.
# Not sure how to design that yet.
###############################################################################
sub printJavascriptFunctions {
my $self = shift;
my $javascript_includes = shift;
print qq~
~;
}
###############################################################################
# printMinimalPageHeader
###############################################################################
sub printMinimalPageHeader {
my $self = shift;
my $head = shift || $self->get_http_header;
print qq~$head
$DBTITLE - Systems Biology Experiment Analysis Management System
$DBTITLE - Systems Biology Experiment Analysis Management System $DBVERSION
~;
}
###############################################################################
# printUserContext
###############################################################################
sub printUserContext {
my $self = shift;
my %args = @_;
#### This is now obsoleted and ignored
my $style = $args{'style'} || "HTML";
my $subdir = $self->getSBEAMS_SUBDIR();
$subdir .= "/" if ($subdir);
#### If the output mode is interactive text, switch to text mode
if ($self->output_mode() eq 'interactive') {
$style = 'TEXT';
#### If the output mode is html, then switch to html mode
} elsif ($self->output_mode() eq 'html') {
$style = 'HTML';
# if ($subdir eq 'Proteomics/' || $subdir eq 'Microarray/' || $subdir eq '') {
$self->printUserChooser(%args);
return;
# }
#### Otherwise, we're in some data mode and don't want to see this
} else {
return;
}
$current_username = $self->getCurrent_username;
$current_contact_id = $self->getCurrent_contact_id;
$current_work_group_id = $self->getCurrent_work_group_id;
$current_work_group_name = $self->getCurrent_work_group_name;
$current_project_id = $self->getCurrent_project_id;
$current_project_name = $self->getCurrent_project_name;
$current_user_context_id = $self->getCurrent_user_context_id;
my $temp_current_work_group_name = $current_work_group_name;
if ($current_work_group_name eq "Admin") {
$temp_current_work_group_name = "";
}
if ($style eq "HTML") {
print qq!
Current Login: $current_username ($current_contact_id)
Current Group: $temp_current_work_group_name ($current_work_group_id)
Current Project: $current_project_name ($current_project_id)
[CHANGE]
!;
}
if ($style eq "TEXT") {
print qq!Current Login: $current_username ($current_contact_id) Current Group: $current_work_group_name ($current_work_group_id)
Current Project: $current_project_name ($current_project_id)
!;
}
}
###############################################################################
# printPageFooter
###############################################################################
sub printPageFooter {
my $self = shift;
$self->display_page_footer(@_);
}
###############################################################################
# display_page_footer
###############################################################################
sub display_page_footer {
my $self = shift;
my %args = @_;
#### Process the arguments list
my $close_tables = $args{'close_tables'} || 'YES';
my $display_footer = $args{'display_footer'} || 'YES';
my $separator_bar = $args{'separator_bar'} || 'NO';
#### Hack to support previous, lame API. Get rid of this eventually
if (exists($args{'CloseTables'})) {
$display_footer = 'NO';
}
#### If the output mode is interactive text, display text header
if ($self->output_mode() eq 'interactive' && $display_footer eq 'YES') {
$self->printTextHeader(%args);
return;
}
#### If the output mode is not html, then we don't want a header here
if ($self->output_mode() ne 'html') {
return;
}
#### If closing the content tables is desired
if ($close_tables eq 'YES') {
print qq~
~;
}
#### If displaying a fat bar separtor is desired
if ($separator_bar eq 'YES') {
print " \n";
}
#### If finishing up the page completely is desired
if ($display_footer eq 'YES') {
my $module_name = '';
$module_name = " - $SBEAMS_PART" if (defined($SBEAMS_PART));
print qq~
\n\n
~;
}
}
###############################################################################
# getGoBackButton
###############################################################################
sub getGoBackButton {
my $self = shift;
my $button = qq~
~;
return $button;
}
###############################################################################
# Print Insufficient Project Permissions Message
###############################################################################
sub printInsufficientPermissions {
my $self = shift;
my $errors = shift;
my $back_button = $self->getGoBackButton();
my $msg =<<" END_MSG";
Unable to execute requested action due to insufficient privileges. Please
see specific errors below for details.
END_MSG
print qq!
Permissions Error
$LINESEPARATOR
$msg
$errors
$back_button
$LINESEPARATOR
!;
} # end printIncompleteForm
###############################################################################
# Print Incomplete Form Message
###############################################################################
sub printIncompleteForm {
my $self = shift;
my $errors = shift;
my $mode = shift || 'Incomplete';
my $back_button = $self->getGoBackButton();
my $msg =<<" END_MSG";
All required form fields must be filled in. Please see the
errors listed below and click the Back button to return to
the form.
END_MSG
print qq!
Incomplete Form
$LINESEPARATOR
$msg
$errors
$back_button
$LINESEPARATOR
!;
} # end printIncompleteForm
###############################################################################
# printTextHeader
###############################################################################
sub printTextHeader {
my $self = shift;
my %args = @_;
print qq~---------------------------------- SBEAMS -------------------------------------
~;
}
###############################################################################
# printTextFooter
###############################################################################
sub printTextFooter {
my $self = shift;
my %args = @_;
print qq~
---------------------------------- SBEAMS -------------------------------------
~;
}
###############################################################################
# Print Debugging Information
###############################################################################
sub printDebuggingInfo {
my $self = shift;
my $q = shift;
my $element;
#### Write out a HTTP header
print $self->get_http_header;
#### Write out all the environment variables
print "Environment variables:\n";
foreach $element (keys %ENV) {
print "$element = '$ENV{$element}'\n";
}
#### Write out all the supplied parameters
print "\nCGI parameters:\n";
foreach $element ( $q->param ) {
my $liststr = join(",",$q->param($element));
print "$element = '$liststr'\n";
}
print " \n";
} # end printDebuggingInfo
sub printCGIParams {
my $self = shift;
my $q = shift;
my $element;
#### Write out a HTTP header
print $self->get_http_header;
#### Write out all the supplied parameters
print "\nCGI parameters:\n";
foreach $element ( $q->param ) {
my $liststr = join(",",$q->param($element));
print "$element = '$liststr'\n";
}
print " \n";
} # end printCGIParams
sub getMainPageTabMenu {
my $self = shift;
my $tabmenu = $self->getMainPageTabMenuObj( @_ );
my $HTML = "$tabmenu";
return \$HTML;
}
sub getMainPageTabMenuObj {
my $self = shift;
my %args = @_;
# Create new tabmenu item.
my $tabmenu = SBEAMS::Connection::TabMenu->new( cgi => $args{cgi} );
# Add tabs
$tabmenu->addTab( label => 'Current Project',
helptext => 'View details of current Project' );
$tabmenu->addTab( label => 'My Projects',
helptext => 'View all projects owned by me' );
$tabmenu->addTab( label => 'Accessible Projects',
helptext => 'View projects I have access to' );
$tabmenu->addTab( label => 'Recent Resultsets',
helptext => 'View recent SBEAMS resultsets' );
my $content = ''; # Scalar to hold content.
# conditional block to exec code based on selected tab.
if ( $tabmenu->getActiveTabName() eq 'Current Project' ) {
my $project_id = $self->getCurrent_project_id();
if ( $project_id ) {
$content = $self->getProjectDetailsTable( project_id => $project_id );
} else {
my $pad = ' ' x 5;
$content = $pad . $self->makeInfoText('No current project selected');
}
} elsif ( $tabmenu->getActiveTabName() eq 'My Projects' ){
$content = $self->getProjectsYouOwn();
} elsif ( $tabmenu->getActiveTabName() eq 'Accessible Projects' ){
$content = $self->getProjectsYouHaveAccessTo();
} elsif ( $tabmenu->getActiveTabName() eq 'Recent Resultsets' ){
$content = $self->getRecentResultsets();
} else {
my $pad = ' ' x 5;
$content = $pad . $self->makeInfoText('Unknown tab selected');
return \$content;
}
$tabmenu->addContent( $content );
return($tabmenu);
}
###############################################################################
# Report Exception
###############################################################################
sub reportException {
my $self = shift;
my $METHOD = 'reportException';
my %args = @_;
#### Process the arguments list
my $state = $args{'state'} || 'INTERNAL ERROR';
my $type = $args{'type'} || '';
my $message = $args{'message'} || 'NO MESSAGE';
my $HTML_message = $args{'HTML_message'} || '';
#### If invocation_mode is HTTP, then printout an HTML message
if ($self->invocation_mode() eq 'http') {
print "
$state: ";
print "$type \n" if ($type);
if ($HTML_message) {
print "$HTML_message
\n";
} else {
print "$message\n";
}
return;
} else {
$self->handle_error( state => $args{state},
error_type => lc($args{type}).
message => $args{message} );
}
if (1 == 1) {
print "$state: ";
print "$type\n" if ($type);
print "$message\n";
return;
}
} # end reportException
#+
# Utility method, returns passed text enclosed in
#-
sub makeInactiveText {
my $self = shift;
my $text = shift;
return( "$text" );
}
#+
# Utility method, returns text formatted for INFO messages
#-
sub makeInfoText {
my $self = shift;
my $text = shift;
return( "$text" );
}
#+
# Utility method, returns text formatted for INFO messages
#-
sub makeErrorText {
my $self = shift;
my $text = shift;
return( "$text" );
}
#+
# returns http Content-type based on user-supplied 'mode'
#-
sub get_content_type {
my $self = shift;
my $type = shift || 'html';
my %ctypes = ( tsv => 'text/tab-separated-values',
tsvfull => 'text/tab-separated-values',
csv => 'text/comma-separated-values',
csvfull => 'text/comma-separated-values',
css => 'text/css',
xml => 'text/xml',
text => 'text/plain',
html => 'text/html',
excel => 'application/excel',
force => 'application/force-download',
jpg => 'image/jpeg',
png => 'image/png',
jnlp => 'application/x-java-jnlp-file',
cytoscape => 'application/x-java-jnlp-file'
);
return $ctypes{$type};
}
#+
# Method returns an http header based on user supplied info.
#
# @narg type Explicit content type supercedes mode-based type.
# @narg mode Output mode, will fetch if not supplied. Begets content-type
# @narg cookies Boolean (perl true/false), supply cookies with the header?
# -
sub get_http_header {
my $self = shift;
my %args = @_;
# output mode
my $mode = $args{mode} || $self->output_mode();
$mode =~ s/full//g; # Simplify tsvfull, csvfull modes
my %param_hash;
# explicit content type
my $type = $args{type} || $self->get_content_type( $mode );
# use cookies?
my $cookies = $args{cookies} || 1;
my $header;
my @cookie_jar;
for ( qw( _session_cookie _sbname_cookie _sbeamsui ) ) {
push @cookie_jar, $self->{$_} if $self->{$_};
}
if ( @cookie_jar && $cookies ) {
$param_hash{'-cookie'} = \@cookie_jar;
# $header = $q->header( -type => $type, -cookie => \@cookie_jar );
} elsif ( $args{filename} ) {
$param_hash{'Content-Disposition'}="attachment;filename=$args{filename}";
# $header = $q->header( -type => $type );
} else {
# $header = $q->header( -type => $type );
}
$header = $q->header( '-type' => $type, %param_hash );
return $header;
}
#+
# Routine to process SBEAMS UI cookie, if it exists.
# Gets called from Authenticator, but put here since it is a UI feature.
#-
sub processSBEAMSuiCookie {
my $self = shift;
# Fetch cookie from cgi object
my %ui_cookie = $q->cookie('SBEAMSui');
# If the cookie is there, process.
if ( scalar(keys(%ui_cookie)) ) {
# Transfer any settings to session hash
for my $key ( keys (%ui_cookie) ) {
$key = $q->unescape( $key ); # Key should probably always be clean...
my $value = $q->unescape( $ui_cookie{$key} );
$self->setSessionAttribute( key => $key,
value => $ui_cookie{$key} );
}
# Figure out path from referer, cache blank cookie to reset.
my $ref = $q->referer();
$ref =~ /.*($HTML_BASE_DIR.*\/).*/;
my $cpath = $1 || '/';
my $cookie = $q->cookie(-name => 'SBEAMSui',
-path => $cpath,
-value => {} );
$self->{_sbeamsui} = $cookie;
}
}
sub getModuleButton {
my $self = shift;
my $module = shift || 'unknown';
my %colors = ( Immunostain => '#77A8FF',
Microarray => '#FFCC66',
Biomarker => '#CC99CC',
Proteomics => '#66CC66',
Cytometry => '#EEEEEE',
Inkjet => '#AABBFF',
Interactions => '#DDFFFF',
PeptideAtlas => '#FFBBEE',
ProteinStructure => '#CCCCFF',
unknown => '#888888' );
return( <<" END" );
END
my $extra =<<" END";
padding: 1px;
margin-top: 100px;
margin-left: 37.5%;
text-align: center;
text-decoration: none;
margin-right: 37.5%;
#${module}_button A:visited, A:active, A:link {
text-decoration: none;
}
#${module}_button A:hover {
background:#0090D0;
color:#0090D0;
}
END
}
#+
# Routine to unset sticky toggle; not a display method per se, but placed
# here as it is a companion method to make_toggle_section
#-
sub unstickToggleSection {
my $self = shift;
my %args = @_;
return unless $args{stuck_name};
$self->deleteSessionAttribute( key => $args{stuck_name} );
}
#+
# Generates CSS, javascript, and HTML to render a section (DIV) 'toggleable'
# @narg content - The actual content (generally HTML) to hide/show, required
# @narg visible - default visiblity, orignal state of content (default is 0)
# @narg textlink - 0/1, should show/hide text be shown (default is 0)
# @narg imglink - 0/1, should plus/minus widget be shown (default is 1)
# @narg name - Name for this toggle thingy
# @narg sticky - Remember the state of this toggle in session? Requires name,
# defaults to 0 (false)
# @narg width - Minimum width to reserve for hidden items.
#-
sub make_toggle_section {
my $self = shift;
my %args = @_;
# Initialize some variables
my $html = ''; # HTML string to return
my $hidetext = ''; # Text for 'hide content' link
my $showtext = ''; # Text for 'show content' link
my $neuttext = ''; # Auxilary text for show/hide
# No content, bail
return $html unless $args{content};
$args{imglink} = 1 unless defined $args{textlink};
$args{textlink} = 0 unless defined $args{textlink};
if ( $args{textlink} ) {
$hidetext = ( $args{textlink} ) ? $args{hidetext} : ' hide ';
$showtext = ( $args{textlink} ) ? $args{showtext} : ' show ' ;
$neuttext = $args{neutraltext} if $args{neutraltext};
}
for my $i ( $hidetext, $showtext ) {
$i = " $i ";
}
# Default visiblity is hidden
$args{visible} = 0 unless defined $args{visible};
my $set_cookie_code = '';
# If it is a sticky cookie, we might have a cached value
if ( $args{sticky} && $args{name} ) {
$set_cookie_code =<<" END";
// Set cookie?
make_sticky_toggle( div_name, new_appearance );
END
my $sticky_value = $self->getSessionAttribute( key => $args{name} );
if ( $sticky_value ) {
$args{visible} = ( $sticky_value eq 'visible' ) ? 1 : 0;
}
}
$args{name} ||= $self->getRandomString( num_chars => 12,
char_set => [ 'A'..'z' ]
);
my $hideclass = ( $args{visible} ) ? 'visible' : 'hidden';
my $showclass = ( $args{visible} ) ? 'hidden' : 'visible';
my $initial_gif = ( $args{visible} ) ? 'small_gray_minus.gif'
: 'small_gray_plus.gif';
$args{extra_style} ||=<<" END";
background: #F0F0F0;
border: #000 1px solid;
padding: 4px;
width: 80%;
END
$args{extra_style} = "";
# Add css/javascript iff necessary
unless ( $self->{_toggle_section_exists} ) {
$self->{_toggle_section_exists}++;
$html =<<" END"
END
}
my $width = ( !$args{width} ) ? '' :
"";
$html .=<<" END";
$width
$args{content}
END
my $tip = ( $args{tooltip} ) ? "TITLE='$args{tooltip}'" : '';
my $imghtml = '';
if ($args{imglink} ) {
$imghtml = "";
}
my $texthtml = '';
if ( $args{textlink} ) {
$texthtml = "
$hidetext
";
$texthtml .= "
$showtext
";
}
my $linkhtml = qq~$imghtml $texthtml $neuttext~;
# Return html as separate content/widget, or as a concatentated thingy
return wantarray ? ( $html, $linkhtml ) : $linkhtml . $html;
}
#+
# Generates CSS, javascript, and HTML to render table row or column 'toggleable'
# @narg visible - default visiblity, orignal state of content (default is 0)
# @narg textlink - 0/1, should show/hide text be shown (default is 0)
# @narg imglink - 0/1, should plus/minus widget be shown (default is 1)
# @narg name - Name for this toggle thingy
# @narg tooltip - Help text to display on image link
# @narg sticky - Remember the state of this toggle in session? Requires name,
# defaults to 0 (false)
#-
sub make_table_toggle {
my $self = shift;
my %args = @_;
# Initialize some variables
my $html = ''; # HTML string to return
my $hidetext = ''; # Text for 'hide content' link
my $showtext = ''; # Text for 'show content' link
my $neuttext = ''; # Auxilary text for show/hide
$args{imglink} = 1 unless defined $args{textlink};
$args{textlink} = 0 unless defined $args{textlink};
if ( $args{textlink} ) {
$hidetext = ( $args{textlink} ) ? $args{hidetext} : ' hide ';
$showtext = ( $args{textlink} ) ? $args{showtext} : ' show ' ;
$neuttext = $args{neutraltext} if $args{neutraltext};
}
for my $i ( $hidetext, $showtext ) {
$i = " $i ";
}
# Default visiblity is hidden
$args{visible} = 0 unless defined $args{visible};
my $set_cookie_code = '';
# If it is a sticky cookie, we might have a cached value
if ( $args{sticky} && $args{name} ) {
$set_cookie_code =<<" END";
// Set cookie?
make_sticky_tbl_toggle( obj_name, new_state );
END
my $sticky_value = $self->getSessionAttribute( key => $args{name} );
if ( $sticky_value ) {
$args{visible} = ( $sticky_value eq 'tbl_visible' ) ? 1 : 0;
}
}
$args{name} ||= $self->getRandomString( num_chars => 12,
char_set => [ 'A'..'z' ]
);
my $hideclass = ( $args{visible} ) ? 'tbl_visible' : 'tbl_hidden';
my $showclass = ( $args{visible} ) ? 'tbl_hidden' : 'tbl_visible';
my $initial_gif = ( $args{visible} ) ? 'small_gray_minus.gif'
: 'small_gray_plus.gif';
# Add css/javascript iff necessary
unless ( $self->{_tbl_toggle_section_exists} ) {
$self->{_tbl_toggle_section_exists}++;
$html =<<" END";
END
# Put this here for expediency. If it causes trouble we can cat it
# together with one of the other returned items.
print $html if $self->output_mode() =~ /html/i;
}
# Set up the TR/TD attributes
my $tbl_html .= "NAME='$args{name}' ID='$args{name}' ";
# Image isn't hidden, it is switched in the javascript
my $imghtml = '';
if ( $args{imglink} ) {
my $tip = ( $args{tooltip} ) ? "TITLE='$args{tooltip}'" : '';
$imghtml = "";
}
# The show/hide text is in two opposite toggling sections
my $texthtml = '';
if ( $args{textlink} ) {
$texthtml = "
$neuttext~ :
qq~$imghtml ~;
# Return html as separate content/widget, or as a concatentated thingy
if ( $args{as_hashref} ) {
$tbl_html =~ s/=/=>/g;
$tbl_html =~ s/\s+/,/g;
my %ashash = eval("$tbl_html");
return wantarray ? ( \%ashash, $linkhtml ) : $linkhtml . $tbl_html;
}
return wantarray ? ( $tbl_html, $linkhtml ) : $linkhtml . $tbl_html;
}
############
sub getGifSpacer {
my $self = shift;
my $size = shift || 120; # Default?
return "";
}
sub truncateStringWithMouseover {
my $self = shift;
my %args = @_;
return undef unless $args{string};
my $string = $args{string};
my $len = $args{len} || 35;
my $shorty = $self->truncateString( %args );
return qq~
$shorty
~;
}
#+
# Returns array of HTML form buttons
#
# arg types arrayref, required, values of submit, back, reset
# arg name name of submit button (if any)
# arg value value of submit button (if any)
# arg back_name name of submit button (if any)
# arg back_value value of submit button (if any)
# arg reset_value value of reset button (if any)
#-
sub getFormButtons {
my $this = shift;
my %args = @_;
$args{name} ||= 'Submit';
$args{value} ||= 'Submit';
$args{onclick} ||= '';
$args{back_name} ||= 'Back';
$args{back_value} ||= 'Back';
$args{back_onclick} ||= '';
$args{reset_value} ||= 'Reset';
$args{reset_onclick} ||= '';
for ( qw( reset_onclick back_onclick onclick ) ) {
$args{$_} = "onClick=$args{$_}" if $args{$_};
}
$args{types} ||= [];
my @b;
for my $type ( @{$args{types}} ) {
push @b, <<" END" if $type =~ /^submit$/i;
END
push @b, <<" END" if $type =~ /^back$/i;
END
push @b, <<" END" if $type =~ /^reset$/i;
END
}
return @b;
}
###############################################################################
1;
__END__
###############################################################################
###############################################################################
###############################################################################
=head1 SBEAMS::Connection::HTMLPrinter
SBEAMS Core HTML and general header/footer display methods
=head2 SYNOPSIS
See SBEAMS::Connection for usage synopsis.
=head2 DESCRIPTION
This module is inherited by the SBEAMS::Connection module, although it
can be used on its own. Its main function is to encapsulate common
HTML printing routines used by this application.
=head2 METHODS
=over
=item * B
Prints the common HTML header used by all HTML pages generated
by theis application
=item* B
Prints the common HTML footer used by all HTML pages generated
by this application
=item * B
Returns a form button, coded with javascript, so that when it
is clicked the user is returned to the previous page in the
browser history.
=back
=head2 BUGS
Please send bug reports to the author
=head2 AUTHOR
Eric Deutsch
=head2 SEE ALSO
SBEAMS::Connection
=cut
";
}
sub truncateStringWithMouseover {
my $self = shift;
my %args = @_;
return undef unless $args{string};
my $string = $args{string};
my $len = $args{len} || 35;
my $shorty = $self->truncateString( %args );
return qq~
";
}
my $texthtml = '';
if ( $args{textlink} ) {
$texthtml = "