package SBEAMS::PeptideAtlas::HTMLPrinter; ############################################################################### # Program : SBEAMS::PeptideAtlas::HTMLPrinter # Author : Eric Deutsch # $Id$ # # Description : This is part of the SBEAMS::WebInterface 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 ############################################################################### use strict; use vars qw($sbeams $current_contact_id $current_username $current_work_group_id $current_work_group_name $current_project_id $current_project_name $current_user_context_id); use CGI::Carp qw(fatalsToBrowser croak); use SBEAMS::Connection qw($log); use SBEAMS::Connection::DBConnector; use SBEAMS::Connection::Settings; use SBEAMS::Connection::TableInfo; use SBEAMS::Connection::DataTable; use SBEAMS::PeptideAtlas::Settings; use SBEAMS::PeptideAtlas::TableInfo; use SBEAMS::PeptideAtlas::Tables; ############################################################################### # printPageHeader ############################################################################### sub printPageHeader { my $self = shift; $self->display_page_header(@_); } ############################################################################### # display_page_header ############################################################################### sub display_page_header { my $self = shift; my %args = @_; my $navigation_bar = $args{'navigation_bar'} || "YES"; my $sbeams = $self->getSBEAMS(); my $project_id = $args{'project_id'} || $sbeams->getCurrent_project_id(); #### If the output mode is interactive text, display text header my $http_header = $sbeams->get_http_header(); if ($sbeams->output_mode() eq 'interactive') { $sbeams->printTextHeader(); return; } #### If the output mode is not html, then we don't want a header here if ($sbeams->output_mode() ne 'html') { return; } #### Obtain main SBEAMS object and use its http_header $sbeams = $self->getSBEAMS(); if( $sbeams->isGuestUser() ) { $self->displayGuestPageHeader(); } elsif ( $self->isYeastPA(project_id => $project_id) ) { $self->displayInternalResearcherPageHeader(); } else { $self->displayStandardPageHeader(@_); } } ############################################################################### # displayInternalResearcherPageHeader ############################################################################### sub displayInternalResearcherPageHeader { my $self = shift; my %args = @_; my $navigation_bar = $args{'navigation_bar'} || "YES"; my $LOGOUT_URI = "$CGI_BASE_DIR/logout.cgi"; my $LOGOUT_LINK = qq~LOGOUT~; #### Obtain main SBEAMS object and use its http_header my $sbeams = $self->getSBEAMS(); my $http_header = $sbeams->get_http_header(); use LWP::UserAgent; use HTTP::Request; my $ua = LWP::UserAgent->new(); my $skinLink = 'http://www.peptideatlas.org'; my $response = $ua->request( HTTP::Request->new( GET => "$skinLink/.index.dbbrowse.php" ) ); my @page = split( "\r", $response->content() ); my $skin = ''; for ( @page ) { $_ =~ s/\<\!-- LOGIN_LINK --\>/$LOGOUT_LINK/; last if $_ =~ /--- Main Page Content ---/; $skin .= $_; } $skin =~ s/\/images\//\/sbeams\/images\//gm; print "$http_header\n\n"; print <<" END_PAGE"; $skin END_PAGE $self->printJavascriptFunctions(); } ############################################################################### # displayGuestPageHeader ############################################################################### sub displayGuestPageHeader { my $self = shift; my %args = @_; my $navigation_bar = $args{'navigation_bar'} || "YES"; my $LOGIN_URI = "$SERVER_BASE_DIR$ENV{REQUEST_URI}"; if ($LOGIN_URI =~ /\?/) { $LOGIN_URI .= "&force_login=yes"; } else { $LOGIN_URI .= "?force_login=yes"; } my $LOGIN_LINK = qq~LOGIN~; #### Obtain main SBEAMS object and use its http_header my $sbeams = $self->getSBEAMS(); my $http_header = $sbeams->get_http_header(); use LWP::UserAgent; use HTTP::Request; my $ua = LWP::UserAgent->new(); my $skinLink = 'http://www.peptideatlas.org'; #my $skinLink = 'http://dbtmp.systemsbiology.net/'; my $response = $ua->request( HTTP::Request->new( GET => "$skinLink/.index.dbbrowse.php" ) ); my @page = split( "\r", $response->content() ); my $skin = ''; for ( @page ) { $_ =~ s/\<\!-- LOGIN_LINK --\>/$LOGIN_LINK/; last if $_ =~ /--- Main Page Content ---/; $skin .= $_; } $skin =~ s#/images/#/sbeams/images/#gm; #$skin =~ s#/images/#/dev2/sbeams/images/#gm; print "$http_header\n\n"; print <<" END_PAGE"; $skin END_PAGE $self->printJavascriptFunctions(); } ############################################################################### # displayStandardPageHeader ############################################################################### sub displayStandardPageHeader { my $self = shift; my %args = @_; my $navigation_bar = $args{'navigation_bar'} || "YES"; #### Obtain main SBEAMS object and use its http_header my $sbeams = $self->getSBEAMS(); my $http_header = $sbeams->get_http_header(); print qq~$http_header $DBTITLE - $SBEAMS_PART ~; $self->printJavascriptFunctions(); $self->printStyleSheet(); my $loadscript = "$args{onload};" || ''; #### 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~ ~; #print ">>>http_header=$http_header
\n"; if ($navigation_bar eq "YES") { print qq~
ISB DBSBEAMS

$DBTITLE - $SBEAMS_PART
$DBVERSION
$DBTITLE Home
$SBEAMS_PART Home
Logout
 
Browse Data:
   Browse Peptides
   Browse Bioseqs
   Get Peptide Summary
   Get Protein Summary
   Pathway Search
   Search Glyco-Peptides
 
Manage Tables:
   Biosequence Sets
   Atlas Builds
   Default Builds
   Samples
   DB Xrefs
   Organisms
   Publication
~; } else { 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; #### Obtain main SBEAMS object and use its style sheet $sbeams = $self->getSBEAMS(); $sbeams->printStyleSheet(); } ############################################################################### # 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~ ~; } ############################################################################### # printPageFooter ############################################################################### sub printPageFooter { my $self = shift; $self->display_page_footer(@_); } ############################################################################### # display_page_footer ############################################################################### sub display_page_footer { my $self = shift; my %args = @_; #### If the output mode is interactive text, display text header my $sbeams = $self->getSBEAMS(); if ($sbeams->output_mode() eq 'interactive') { $sbeams->printTextHeader(%args); return; } #### If the output mode is not html, then we don't want a header here if ($sbeams->output_mode() ne 'html') { return; } #### 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'; #### 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 $close_main_tables = 'NO'; $close_main_tables = 'YES' unless ($close_tables eq 'YES'); #### Default to the Core footer $sbeams->display_page_footer(display_footer=>'YES', close_tables=>$close_main_tables); } } ############################################################################### # encodeSectionHeader ############################################################################### sub encodeSectionHeader { my $METHOD = 'encodeSectionHeader'; my $self = shift || die ("self not passed"); my %args = @_; # Default to BOLD $args{bold} = 1 if !defined $args{bold}; my $text = $args{text} || ''; $text = "$text" if $args{bold}; my $buffer = qq~ $text ~; return $buffer; } ############################################################################### # encodeSectionItem ############################################################################### sub encodeSectionItem { my $METHOD = 'encodeSectionItem'; my $self = shift || die ("self not passed"); my %args = @_; my $key = $args{key} || ''; my $value = $args{value} || ''; my $url = $args{url} || ''; my $kwid = ( $args{key_width} ) ? "WIDTH='$args{key_width}'" : ''; my $vwid = ( $args{val_width} ) ? "WIDTH='$args{val_width}'" : ''; $url =~ s/ /+/g; my $astart = ''; my $aend = ''; if ($url) { $astart = qq~~; $aend = qq~~; } my $buffer = qq~ $key$astart$value$aend ~; return $buffer; } ############################################################################### # encodeSectionTable ############################################################################### sub encodeSectionTable { my $METHOD = 'encodeSectionTable'; my $self = shift || die ("self not passed"); my %args = @_; my @table_attrs = ( 'BORDER' => 0 ); return '' unless $args{rows}; $args{header} ||= 0; if ( $args{width} ) { push @table_attrs, 'WIDTH', $args{width}; } my $first = 1; my $sbeams = $self->getSBEAMS(); my $tab = SBEAMS::Connection::DataTable->new( @table_attrs ); for my $row ( @{$args{rows}} ) { $tab->addRow( $row ); } # How many do we have? my $tot = $tab->getRowNum(); # No wrapping desired... $tab->setRowAttr( ROWS => [1..$tot], NOWRAP => 1 ); # Set header attributes if ( $args{header} ) { $tab->setRowAttr( ROWS => [1], BGCOLOR => '#CCCCCC' ); $tab->setRowAttr( ROWS => [1], ALIGN => 'CENTER' ) unless $args{nocenter}; } if ( $args{align} ) { for ( my $i = 0; $i <= $#{$args{align}}; $i++ ) { $tab->setColAttr( ROWS => [2..$tot], COLS => [$i + 1], ALIGN => $args{align}->[$i] ); } } my $html =<<" END"; $tab END return $html; } ############################################################################### # displaySamples ############################################################################### sub getSampleDisplay { my $self = shift; my $sbeams = $self->getSBEAMS(); my %args = @_; my $SUB_NAME = 'getSampleDisplay'; unless( $args{sample_ids} ) { $log->error( "No samples passed to display samples" ); return; } my $in = join( ", ", @{$args{sample_ids}} ); return unless $in; my $sql = qq~ SELECT sample_id,sample_title FROM $TBAT_SAMPLE WHERE sample_id IN ( $in ) AND record_status != 'D' ORDER BY sample_id ASC ~; my @samples = $sbeams->selectSeveralColumns($sql); my $header = $self->encodeSectionHeader( text=>'Observed in Samples:', ); my $html = ''; foreach my $sample (@samples) { my ($sample_id,$sample_title) = @{$sample}; $html .= $self->encodeSectionItem( key=>$sample_id, value=>$sample_title, key_width => '5%', val_width => '95%', url=>"$CGI_BASE_DIR/$SBEAMS_PART/ManageTable.cgi?TABLE_NAME=AT_SAMPLE&sample_id=$sample_id", ); } return ( wantarray() ) ? ($header, $html) : $header . "\n" . $html; } # end getSampleDisplay 1; __END__ ############################################################################### ############################################################################### ############################################################################### =head1 NAME SBEAMS::WebInterface::HTMLPrinter - Perl extension for common HTML printing methods =head1 SYNOPSIS Used as part of this system use SBEAMS::WebInterface; $adb = new SBEAMS::WebInterface; $adb->printPageHeader(); $adb->printPageFooter(); $adb->getGoBackButton(); =head1 DESCRIPTION This module is inherited by the SBEAMS::WebInterface module, although it can be used on its own. Its main function is to encapsulate common HTML printing routines used by this application. =head1 METHODS =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. =head1 AUTHOR Eric Deutsch =head1 SEE ALSO perl(1). =cut