view release on metacpan or  search on metacpan

Ace/Browser/AceSubs.pm  view on Meta::CPAN

  return <<END;
<TABLE WIDTH="100%" BORDER=0 CELLPADDING=0 CELLSPACING=0>
<TR CLASS="technicalinfo">
    <TD  CLASS="small" VALIGN="TOP">
    $hlink<br>$clink
    </TD>
    <TD  CLASS="small" ALIGN=RIGHT VALIGN=TOP><p><strong>$feedback_link</strong><br>
    $privacy_link<br>
    <A HREF="mailto:$webmaster"><address>$webmaster</address></A><br>
    </TD>
</TR>
</TABLE>
END
}

=item $object = GetAceObject()

This function is called by display scripts to return the
Ace::Object.that the user wishes to view.  It automatically opens or
refreshes the database, and performs the request using the values of the
"name" and "class" CGI variables.

If a single object is found, the function returns it as the function
result.  If no objects are found, it returns undef.  If more than one
object is found, the function invokes AceMultipleChoices() and exits
the script.

=cut

# open database, return object requested by CGI parameters
sub GetAceObject {
  my $db = OpenDatabase() ||  AceError("Couldn't open database."); # exits
  my $name  = param('name') or return;
  my $class = param('class') or return;
  my @objs = $db->fetch($class => $name);
  if (@objs > 1) {
    AceMultipleChoices($name,'',\@objs);
    Apache->exit(0) if defined &Apache::exit;
    exit(0);
  }
  return $objs[0];
}

=item $html = Header()

This subroutine returns the boilerplate at the top of the HTML page as 
a string, but does not print it out.  It is not exported by default.

=cut

sub Header {
  my $config = Configuration();
  my $dbname = get_symbolic();

  return unless my $searches = $config->Searches;
  my $banner                 = $config->Banner;

  # next select the correct search script
  my @searches = @{$searches};
  my $self = url(-relative=>1);
  my $modperl = $ENV{MOD_PERL} && Apache->can('request') && eval {Apache->request->dir_config('AceBrowserConf')};
  my @row;
  foreach (@searches) {
    my ($name,$url,$on,$off,$size) = @{$config->searches($_)}{qw/name url onimage
								offimage size/};
    my $active = $url =~ /\b$self\b/;
    my $image = $active ? $on : $off;

    # replace the url with a cookie, if one is defined
    my $cookie_name = "SEARCH_${dbname}_${_}";
    my $query_string = cookie($cookie_name) unless /blast/;
    $url .= "/$dbname" unless $url =~ /\b$dbname\b/ or $modperl;
    $url .= "?$query_string" if $query_string;

    if ($image) {
    push @row,a({-href=>$url},img({-src=>$image,-border=>0,
				   -width=>$size->[0],-height=>$size->[1],
				   -alt=>$name}));

  } else {
    push @row,$active ? font({-color=>'black'},$name) : a({-href=>$url,-class=>'searchbanner'},$name);
  }
  }

  my ($home,$label) = @{$config->Home} if $config->Home;

  return table({-border=>0,-cellspacing=>1,-width=>'100%'},
	       Tr(td({-align=>'CENTER',-class=>'searchbanner'},\@row)),
	       Tr(td({-align=>'CENTER',-valign=>'BOTTOM',colspan=>scalar(@row)},
		     a({-href=>$home},$banner))
		 )
	      );
}

=item $url = Object2URL($object)

=item $url = Object2URL($name,$class)

In its single-argument form, this function takes an AceDB Object and
returns an AceBrowser URL.  The URL chosen is determined by the
configuration settings.

It is also possible to pass Object2URL an object name and class, in
the case that an AceDB object isn't available.

The return value is a URL.

=cut

# general mapping from a display to a url
sub Object2URL {
    my ($object,$extra) = @_;
    my ($name,$class);
    if (ref($object)) {
	($name,$class) = ($object,$object->class);
    } else {
	($name,$class) = ($object,$extra);
    }
    my $display = url(-relative=>1);
    my ($disp,$parameters) = Configuration()->map_url($display,$name,$class);
    return $disp unless $parameters;

Ace/Browser/AceSubs.pm  view on Meta::CPAN

                    '-Style'   => Style(),
                    @additional_header_stuff,
                    );
  print Header();
  print TypeSelector($object,$class) if defined $object;
  print h1($title) if $title;
}

=item PrintBottom()

The PrintBottom() function outputs all the boilerplate at the bottom
of a typical AceBrowser page.  If a user-defined footer is present in
the configuration file, that is printed.  Otherwise, the method prints 
a horizontal rule followed by links to the site home page, the AcePerl 
home page, the privacy policy, and the feedback page.

=cut

sub PrintBottom {
  print hr,Footer(),end_html();
}


=item $hashref = Style()

This subroutine returns a hashref containing a reference to the
configured stylesheet, in the following format:

  { -src => '/ace/stylesheets/current_stylesheet.css' }

This hash is suitable for passing to the -style argument of CGI.pm's
start_html() function, or for use as an additional header in
PrintTop().  You may add locally-defined stylesheet elements to the
hash before calling start_html().  See the pic script for an example
of how this is done this.

This function is not exported by default.

=cut

=item $url = ResolveUrl($url,$param)

Given a URL and a set of parameters, this function does the necessary
magic to add the symbolic database name to the end of the URL (if
needed) and then tack the parameters onto the end.

A typical call is:

  $url = ResolveUrl('/cgi-bin/ace/generic/tree','name=fred;class=Author');

This function is not exported by default.

=cut

sub ResolveUrl {
    my ($url,$param) = @_;
    my ($main,$query,$frag) = $url =~ /^([^?\#]+)\??([^\#]*)\#?(.*)$/ if defined $url;
    $main ||= '';
    
    if (!defined $APACHE_CONF) {
      $APACHE_CONF = eval { Apache->request->dir_config('AceBrowserConf') } ? 1 : 0;
    }

    $main = Configuration()->resolvePath($main) unless $main =~ m!^/!;
    if (my $id = get_symbolic()) {
      $main .= "/$id" unless $main =~ /$id/ or $APACHE_CONF;
    }

    $main .= "?$query" if $query; # put the query string back
    $main .= "?$param" if $param and !$query;
    $main .= ";$param" if $param and  $query;
    $main .= "#$frag" if $frag;
    return $main;
}

# A consistent stylesheet across pages
sub Style {
    my $stylesheet = Configuration()->Stylesheet;
    return { -src => $stylesheet };
}

=item $boolean = Toggle($section,[$label,$object_count,$add_plural,$add_count])

=item ($link,$bool) = Toggle($section,$label,$object_count,$add_plural,$add_count)

The Toggle() subroutine makes it easy to create HTML sections that
open and close when the user selects a toggle icon (a yellow
triangle).

Toggle() can be used to manage multiple collapsible HTML sections, but
each section must have a unique name.  The required first argument is
the section name.  Optional arguments are:

  $label         The text of the generated link, for example "sequence"

  $object_count  The number of objects that opening the section will reveal

  $add_plural    If true, the label will be pluralized when
		 appropriate

  $add_count	 If true, the label will have the object count added
		 when appropriate

In a scalar context, Toggle() prints the link HTML and returns a
boolean flag.  A true result indicates that the section is expanded
and should be generated.  A false result indicates that the section is 
collapsed.

In a list context, Toggle() returns a two-element list.  The first
element is the HTML link that expands and contracts the section.  The
second element is a boolean that indicates whether the section is
currently open or closed.

This example indicates typical usage:

  my $sequence = GetAceObject();
  print "sequence name = ",$sequence,"\n";
  print "sequence clone = ",$sequence->Clone,"\n";
  if (Toggle('dna','Sequence DNA')) {
      print $sequence->asDNA;
  }