AcePerl
view release on metacpan or search on metacpan
Ace/Browser/AceSubs.pm view on Meta::CPAN
print $link,br;
return $OPEN{$section};
}
}
=item $html = TypeSelector($name,$class)
This subroutine generates the HTML for the type selector navigation
bar. The links in the bar are dynamically generated based on the
values of $name and $class. This function is called by PrintTop().
It is not exported by default.
=cut
# Choose a set of displayers based on the type.
sub TypeSelector {
my ($name,$class) = @_;
return unless $class;
my ($n,$c) = (escape("$name"),escape($class));
my @rows;
# add the special displays
my @displays = Configuration()->class2displays($class,$name);
my @basic_displays = Configuration()->class2displays('default');
@basic_displays = Ace::Browser::SiteDefs->getConfig(DEFAULT_DATABASE)->class2displays('default')
unless @basic_displays;
my $display = url(-absolute=>1,-path=>1);
foreach (@displays,@basic_displays) {
my ($url,$icon,$label) = @{$_}{qw/url icon label/};
next unless $url;
my $u = ResolveUrl($url,"name=$n;class=$c");
($url = $u) =~ s/[?\#].*$//;
my $active = $url =~ /^$display/;
my $cell;
unless ($active) {
$cell = defined $icon ? a({-href=>$u,-target=>'_top'},
img({-src=>$icon,-border=>0}).br().$label)
: a({-href=>$u,-target=>'_top'},$label);
} else {
$cell = defined $icon ? img({-src=>$icon,-border=>0}).br().font({-color=>'red'},$label)
: font({-color=>'red'},$label);
}
push (@rows,td({-align=>'CENTER',-class=>'small'},$cell));
}
return table({-width=>'100%',-border=>0,-class=>'searchtitle'},
TR({-valign=>'bottom'},@rows));
}
=item $url = Url($display,$params)
Given a symbolic display name, such as "tree" and a set of parameters,
this function looks up its URL and then calls ResolveUrl() to create a
single Url.
When hard-coding relative URLs into AceBrowser scripts, it is
important to pass them through Url(). The reason for this is that
AceBrowser may need to attach the database name to the URL in order to
identify it.
Example:
my $url = Url('../sequence_dump',"name=$name;long_dump=yes");
print a({-href=>$url},'Dump this sequence');
=cut
sub Url {
my ($display,$parameters) = @_;
my $url = Configuration()->display($display,'url');
return ResolveUrl($url,$parameters);
}
sub Open_table{
print '<table width=660>
<tr>
<td>';
}
sub Close_table{
print '</tr>
</td>
</table>';
}
# return host and port for symbolic database name
sub getDatabasePorts {
my $name = shift;
my $config = Ace::Browser::SiteDefs->getConfig($name);
return ($config->Host,$config->Port,
$config->Username,$config->Password,
$config->Cacheroot,$config->Cachesize,$config->Cacheexpires,$config->Cachepurge,
) if $config;
# If we get here, then try getservbynam()
# I think this is a bit of legacy code.
my @s = getservbyname($name,'tcp');
return unless @s;
return unless $s[2]>1024; # don't allow connections to reserved ports
return ('localhost',$s[2]);
}
sub get_symbolic {
if (exists $ENV{MOD_PERL} && Apache->can('request')) { # the easy way
if (my $r = Apache->request) {
if (my $conf = $r->dir_config('AceBrowserConf')) {
my ($name) = $conf =~ m!([^/]+)\.(?:pm|conf)$!;
return $name if $name;
}
}
}
# otherwise, the hard way
(my $name = path_info())=~s!^/!!;
return $name if defined $name && $name ne ''; # get from additional path info
( run in 1.279 second using v1.01-cache-2.11-cpan-39bf76dae61 )