AcePerl
view release on metacpan or search on metacpan
$NAME2DB{$name} = shift if @_;
$d;
}
# make a new object using indicated class and name pattern
sub new {
my $self = shift;
my ($class,$pattern) = rearrange([['CLASS'],['NAME','PATTERN']],@_);
croak "You must provide -class and -pattern arguments"
unless $class && $pattern;
# escape % signs in the string
$pattern = Ace->freeprotect($pattern);
$pattern =~ s/(?<!\\)%/\\%/g;
my $r = $self->raw_query("new $class $pattern");
if (defined($r) and $r=~/write access/im) { # this keeps changing
$Ace::Error = "Write access denied";
return;
}
unless ($r =~ /($class)\s+\"([^\"]+)\"$/im) {
$Ace::Error = $r;
Ace/Browser/AceSubs.pm view on Meta::CPAN
The following sections describe the exported subroutines.
=over 4
=cut
use strict;
use Ace::Browser::SiteDefs;
use Ace 1.76;
use CGI qw(:standard escape);
use CGI::Cookie;
use File::Path 'mkpath';
use vars qw/@ISA @EXPORT @EXPORT_OK $VERSION %EXPORT_TAGS
%DB %OPEN $HEADER $TOP @COOKIES
$APACHE_CONF/;
require Exporter;
@ISA = qw(Exporter);
$VERSION = 1.21;
Ace/Browser/AceSubs.pm view on Meta::CPAN
# Contents of the HTML footer. It gets printed immediately before the </BODY> tag.
# The one given here generates a link to the "feedback" page, as well as to the
# privacy statement. You may or may not want these features.
sub Footer {
if (my $footer = Configuration()->Footer) {
return $footer;
}
my $webmaster = $ENV{SERVER_ADMIN} || 'webmaster@sanger.ac.uk';
my $obj_name = escape(param('name'));
my $obj_class = escape(param('class')) || ucfirst url(-relative=>1);
my $referer = escape(self_url());
my $name = get_symbolic();
# set up the feedback link
my $feedback_link = Configuration()->Feedback_recipients &&
$obj_name &&
(url(-relative=>1) ne 'feedback') ?
a({-href=>ResolveUrl("misc/feedback/$name","name=$obj_name;class=$obj_class;referer=$referer")},
"Click here to send data or comments to the maintainers")
: '';
Ace/Browser/AceSubs.pm view on Meta::CPAN
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);
Ace/Browser/SiteDefs.pm view on Meta::CPAN
if (my $code = $self->Url_mapper) {
if (@result = $code->($display,$name,$class)) {
return @result;
}
}
# if we get here, then take the first display
my @displays = $self->displays($class,$name);
push @displays,$self->displays('default') unless @displays;
my $n = CGI::escape($name);
my $c = CGI::escape($class);
return ($displays[0],"name=$n;class=$c") if $displays[0];
return unless @result = $self->getConfig('default')->Url_mapper->($display,$name,$class);
return unless $url = $self->display($result[0],'url');
return ($url,$result[1]);
}
sub searches {
my $self = shift;
return unless my $s = $self->Searches;
Ace/Browser/TreeSubs.pm view on Meta::CPAN
package Ace::Browser::TreeSubs;
# constants used by the tree program (and its ilk)
use strict;
use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
use Ace::Browser::AceSubs qw(Configuration);
use CGI 'escape';
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(OPENCOLOR CLOSEDCOLOR MAXEXPAND
AceImageHackURL);
@EXPORT_OK = ();
%EXPORT_TAGS = ();
# colors
Ace/Browser/TreeSubs.pm view on Meta::CPAN
# We use the name of the database as a URL to an external image.
# The URL will look like this:
# /ace_images/external/database_name/foo.gif
# You must arrange for the URL to return the correct image, either with
# a CGI script, a symbolic link, or a redirection directive.
sub AceImageHackURL {
my $image_name = shift;
# correct some bad image file names in the database
$image_name .= '.jpeg' unless $image_name =~ /\.(gif|jpg|jpeg|png|tiff|ps)$/;
my $picture_path = Configuration->Pictures->[0];
return join('/',$picture_path,Configuration->Name,'external',escape("$image_name"));
}
1;
Ace/Object.pm view on Meta::CPAN
}
######### construct object from serialized input, not usually called directly ########
sub newFromText {
my ($pack,$text,$db) = @_;
$pack = ref($pack) if ref($pack);
my @array;
foreach (split("\n",$text)) {
next unless $_;
# this is a hack to fix some txt fields with unescaped tabs
# unfortunately it breaks other things
s/\?txt\?([^?]*?)\t([^?]*?)\?/?txt?$1\\t$2?/g;
push(@array,[split("\t")]);
}
my $obj = $pack->_fromRaw(\@array,0,0,$#array,$db);
$obj->_dirty(1);
$obj;
}
Ace/Object.pm view on Meta::CPAN
my $self = shift;
return exists($self->{'.right'}) || exists($self->{'.raw'});
}
#### return true if you can follow the object in the database (i.e. a class ###
sub isPickable {
return shift->isObject;
}
#### Return a string representation of the object subject to Ace escaping rules ###
sub escape {
my $self = shift;
my $name = $self->name;
my $needs_escaping = $name=~/[^\w.-]/ || $self->isClass;
return $name unless $needs_escaping;
$name=~s/\"/\\"/g; #escape quotes"
return qq/"$name"/;
}
############### object on the right of the tree #############
sub right {
my ($self,$pos) = @_;
$self->_fill;
$self->_parse;
Ace/Object.pm view on Meta::CPAN
@address_lines = $object->at('Address.Mail');
The second line above is equivalent to:
@address = $object->at('Address')->at('Mail');
Called without a tag name, at() just dereferences the object,
returning whatever is to the right of it, the same as
$object->right
If a path component already has a dot in it, you may escape the dot
with a backslash, as in:
$s=$db->fetch('Sequence','M4');
@homologies = $s->at('Homol.DNA_homol.yk192f7\.3';
This also demonstrates that path components don't necessarily have to
be tags, although in practice they usually are.
at() returns slightly different results depending on the context in
which it is called. In a list context, it returns the column of
Ace/Object.pm view on Meta::CPAN
my $self = shift;
my $string = "$self\t";
my $right = $self->right;
$right->_asTable(\$string,1,2) if defined($right);
return $string . "\n";
}
#### In "ace" format ####
sub asAce {
my $self = shift;
my $string = $self->isRoot ? join(' ',$self->class,':',$self->escape) . "\n" : '';
$self->right->_asAce(\$string,0,[]);
return "$string\n\n";
}
### Pretty-printed version ###
sub asString {
my $self = shift;
my $MAXWIDTH = shift || $DEFAULT_WIDTH;
my $tabs = $self->asTable;
return "$self" unless $tabs;
Ace/Object.pm view on Meta::CPAN
my (@last);
foreach (@{$self->{'.raw'}}[$start..$end]){
my $j=1;
$$out .= join("\t",@$tags) . "\t" if ($level==0) && (@$tags);
my (@to_modify) = @{$_}[$a..$#{$_}];
foreach (@to_modify) {
my ($class,$name) =Ace->split($_);
if (defined($name)) {
$name = $self->_ace_format($class,$name);
if (_isObject($class) || $name=~/[^\w.-]/) {
$name=~s/"/\\"/g; #escape quotes with slashes
$name = qq/\"$name\"/;
}
} else {
$name = $last[$j] if $name eq '';
}
$_ = $last[$j++] = $name;
$$out .= "$_\t";
}
$$out .= "\n";
$level = 0;
}
chop($$out);
return;
}
$$out .= join("\t",@$tags) . "\t" if ($level==0) && (@$tags);
$$out .= $self->escape . "\t";
if (defined $self->right) {
push(@$tags,$self->escape);
$self->right->_asAce($out,$level+1,$tags);
pop(@$tags);
}
if ($self->down) {
$$out .= "\n";
$self->down->_asAce($out,0,$tags);
}
}
sub _to_ace_date {
Ace/Object.pm view on Meta::CPAN
my ($do_content,$do_class,$do_value,$do_timestamps) = rearrange([qw(CONTENT CLASS VALUE TIMESTAMPS)],@_);
$do_content = 0 unless defined $do_content;
$do_class = 1 unless defined $do_class;
$do_value = 1 unless defined $do_value;
$do_timestamps = 1 unless (defined $do_timestamps && !$do_timestamps) || !$self->db->timestamps;
my %options = (content => $do_content,
class => $do_class,
value => $do_value,
timestamps => $do_timestamps);
my $name = $self->escapeXML($self->name);
my $class = $self->class;
my $string = '';
$self->_asXML(\$string,0,0,'',0,\%options);
return $string;
}
sub _asXML {
my($self,$out,$position,$level,$current_tag,$tag_level,$opts) = @_;
do {
my $name = $self->escapeXML($self->name);
my $class = $self->class;
my ($tagname,$attributes,$content) = ('','',''); # prevent uninitialized variable warnings
my $tab = " " x ($level-$position); # four spaces
$current_tag ||= $class;
$content = $name if $opts->{content};
if ($self->isTag) {
$current_tag = $tagname = $name;
$tag_level = 0;
} else {
$tagname = $tag_level > 0 ? sprintf "%s-%d",$current_tag,$tag_level + 1 : $current_tag;
$class = "#$class" unless $self->isObject;
$attributes .= qq( class="$class") if $opts->{class};
$attributes .= qq( value="$name") if $opts->{value};
}
if (my $c = $self->comment) {
$c = $self->escapeXML($c);
$attributes .= qq( comment="$c");
}
if ($opts->{timestamps} && (my $timestamp = $self->timestamp)) {
$timestamp = $self->escapeXML($timestamp);
$attributes .= qq( timestamp="$timestamp");
}
$tagname = $self->_xmlNumber($tagname) if $tagname =~ /^\d/;
unless (defined $self->right) { # lone tag
$$out .= $self->isTag || !$opts->{content} ? qq($tab<$tagname$attributes />\n)
: qq($tab<$tagname$attributes>$content</$tagname>\n);
} elsif ($self->isTag) { # most tags are implicit in the XML tag names
if (!XML_COLLAPSE_TAGS or $self->right->isTag) {
Ace/Object.pm view on Meta::CPAN
$level = $self->right->_asXML($out,$position,$level+1,$current_tag,$tag_level+1,$opts);
$$out .= qq($tab</$tagname>\n);
}
$self = $self->down;
} while defined $self;
return --$level;
}
sub escapeXML {
my ($self,$string) = @_;
$string =~ s/&/&/g;
$string =~ s/\"/"/g;
$string =~ s/</</g;
$string =~ s/>/>/g;
return $string;
}
sub _xmlNumber {
my $self = shift;
1.45. 1. Fixed problems with autogeneration
2. Added the format() routine 3. Added the model() methods and
Ace::Model class
1.44 1. Added the auto_save() routine to the API
2. Fixed problem of hanging tace processes after quitting local sessions
3. Fixed problem with creation of new objects in local
sessions.
1.43 1. Moved the unescape routine into the C level for performance reasons.
2. Should now escape \? correctly and handle most protection issues.
1.42 1. Numerous small bug fixes
1.41 1. Fixed problem with truncation of trees at zero values
2. Fixed implementation of updating wrt new aceservers
1.46 1. Fixed nasty replacement of newlines by "n" characters in text fields.
1.45 Internal release only.
1.44 1. Added the auto_save() routine to the API
2. Fixed problem of hanging tace processes after quitting local sessions
3. Fixed problem with creation of new objects in local sessions.
1.43 1. Moved the unescape routine into the C level for performance reasons.
2. Should now escape \? correctly and handle most protection issues.
1.42 1. Numerous small bug fixes
1.41 1. Fixed problem with truncation of trees at zero values
2. Fixed implementation of updating wrt new aceservers
1.40 Internal version, never released
1.39 1. Workaround for problem with dropped date fields
Freesubs/Freesubs.xs view on Meta::CPAN
MODULE = Ace::Freesubs PACKAGE = Ace
SV*
freeprotect(CLASS,string)
char* CLASS
char* string
PREINIT:
unsigned long count = 2;
char *cp,*new,*a;
CODE:
/* count the number of characters that need to be escaped */
for (cp = string; *cp; cp++ ) {
count += metachar(*cp) ? 2 : 1;
}
/* create a new char* large enough to hold the result */
New(0,new,count+1,char);
if (new == NULL) XSRETURN_UNDEF;
a = new;
*a++ = '"';
cp = string;
acebrowser/cgi-bin/generic/acetable view on Meta::CPAN
#!/usr/bin/perl
use strict 'vars';
use vars qw/$DB $URL $NAME $CLASS %PAPERS/;
use Ace 1.38;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
AceInit();
$NAME = param('name');
#$PARMS = param('parms');
# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");
acebrowser/cgi-bin/generic/acetable view on Meta::CPAN
<VAR>name</VAR> and <VAR>parms,</VAR> where
"name" is the name of a table definition in acedb
END
display_table($NAME," ");
exit 0;
sub display_table {
my ($name,$parms) = @_;
my $obj = $DB->raw_query("table -title -n $name $parms") || AceMissing($name,$parms);
my ($n,$c) = (escape($name),escape($parms));
print
start_html(-Title=>"$name: $parms",
-Style=>STYLE,
-Class=>'tree',
-Bgcolor=>BGCOLOR_TREE),
h1("$name: $parms"),
&show_table($obj),
#$obj->asHTML() || strong('No more text information about this object in the database'),
acebrowser/cgi-bin/generic/model view on Meta::CPAN
#!/usr/bin/perl
# -*- Mode: perl -*-
# file: model
# do an internal redirect to show the model for selected object
use strict;
use CGI qw(:standard escape);
use Ace::Browser::AceSubs;
use Ace::Browser::TreeSubs;
# get the requested object
my $object = GetAceObject;
PrintTop(param('name'),param('class'),"Acedb Schema for Class ".param('class'));
# get its model
my $db = OpenDatabase;
my $class = $object->class;
acebrowser/cgi-bin/generic/model view on Meta::CPAN
# if we get here, we're dealing with an object or tag
my $name = $obj->name;
# modperl screws up with subroutine references for some reason
my $page_name = param('name');
my $page_class = param('class');
my %squash = map { $_ => 1; } grep($_ ne '',param('squash'));
my %expand = map { $_ => 1; } grep($_ ne '',param('expand'));
my ($n,$c) = (escape($name),escape($obj->class));
my ($pn,$pc) = (escape($page_name),escape($page_class));
my $cnt = $obj->col;
my $title = $name;
if ($cnt > 1) {
if ($squash{$name} || ($cnt > MAXEXPAND && !$expand{$name})) {
my $to_squash = join('&squash=',map { escape($_) } grep $name ne $_,keys %squash);
my $to_expand = join('&expand=',map { escape($_) } (keys %expand,$name));
return (a({-href=>url(-relative=>1,-path_info=>1)
. "?name=$pn&class=$pc"
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>CLOSEDCOLOR},"$title ($cnt)"))),
1);
} else {
my $to_squash = join('&squash=',map { escape($_) } (keys %squash,$name));
my $to_expand = join('&expand=',map { escape($_) } grep $name ne $_,keys %expand);
return (a({-href=>url(-relative=>1,-path_info=>1)
. "?name=$pn&class=$pc"
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>OPENCOLOR},"$title"))),
0);
}
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
# NOTE: This is a very confusing looking script. It is basically a client-side image map, but it
# uses a variety of workarounds so that when the user clicks in an area that isn't part of the map,
# the coordinates of the click are passed back to the script as a server-side image map. It uses
# javascript tricks to do this, but unfortunately the tricks are different for Netscape and Internet
# explorer.
use strict;
use Ace 1.51;
use File::Path;
use CGI 2.42 qw/:standard escape Map Area Layer *p *TR *td *table/;
use CGI::Carp;
use Ace::Browser::AceSubs qw(:DEFAULT Style Url);
use Ace::Browser::GeneSubs 'NCBI';
# these constants should be moved into configuration file
use constant DISABLED => 0;
use constant WIDTH => 1024;
use constant HEIGHT => 768;
use constant ICONS => Configuration()->Icons;
use constant UP_ICON => ICONS .'/a_up.gif';
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
my $modern = $user_agent=~/Mozilla\/([\d.]+)/ && $1 >= 4;
my $max = Configuration()->Max_in_column || 100;
foreach my $box (@$boxes) {
my $center = center($box->{'coordinates'});
next if $centers{$center} > $max;
my $coords = join(',',@{$box->{'coordinates'}});
(my $jcomment = $box->{'comment'} || "$box->{class}:$box->{name}" )
=~ s/'/\\'/g; # escape single quotes for javascript
CASE :
{
if ($box->{name} =~ /gi\|(\d+)/ or
($box->{class} eq 'System' and $box->{'comment'}=~/([NP])ID:g(\d+)/)) {
my($db) = $2 ? $1 : 'n';
my($gid) = $2 || $1;
my $url = NCBI . "?db=$db&form=1&field=Sequence+ID&term=$gid";
push(@lines,qq(<AREA shape="rect"
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
my ($c) = map { "$_->[0]-$_->[1]" } [ map { 2+$_ } @{$box->{coordinates}}[0..1]];
my $clicks = $old_clicks ? "$old_clicks,$c" : $c;
my $url = Url('pic',query_string() . "&click=$clicks");
push(@lines,qq(<AREA shape="rect"
coords="$coords"
onMouseOver="return s(this,'$jcomment')"
target="_self"
href="$url">));
last CASE;
}
my $n = escape($box->{'name'});
my $c = escape($box->{'class'});
my $href = Object2URL($box->{'name'},$box->{'class'});
push(@lines,qq(<AREA shape="rect"
onMouseOver="return s(this,'$jcomment')"
coords="$coords"
href="$href">));
}
}
# Create default handling. Bad use of javascript, but can't think of any other way.
my $url = Url('pic', query_string());
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
#!/usr/bin/perl
# generic tree display
# should work with any data model
use strict;
use vars qw/$DB $URL $NAME $CLASS/;
use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs qw(:DEFAULT Url);
use Ace::Browser::TreeSubs;
my $obj = GetAceObject();
unless ($obj) {
AceError(<<END) if param() && !param('name') && !param('class')
Call this script with URL parameters of
<VAR>name</VAR> and <VAR>class,</VAR> where
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
th('Class'),td(textfield(-name=>'class',-size=>15,-onChange=>'document.question.submit()')),
td(submit({-style=>'background: white',-name=>'Change'}))),
),
end_form;
}
sub display_object {
my $obj = shift;
my $name = $obj->name;
my $class = $obj->class;
my ($n,$c) = (escape($name),escape($class));
my $myimage = ($class =~ /^Picture/ ? $obj->Pick_me_to_call->right->right : 'No_Image') ;
if ($class eq 'LongText'){
print $obj->asHTML(sub { pre(shift) });
}
else{
print $obj->asHTML(\&to_href) || strong('No more text information
about this object in the database'), "\n";
}
}
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
# if we get here, we're dealing with an object or tag
my $name = $obj->name;
# modperl screws up with subroutine references for some reason
my $page_name = param('name');
my $page_class = param('class');
my %squash = map { $_ => 1; } grep($_ ne '',param('squash'));
my %expand = map { $_ => 1; } grep($_ ne '',param('expand'));
my ($n,$c) = (escape($name),escape($obj->class));
my ($pn,$pc) = (escape($page_name),escape($page_class));
my $cnt = $obj->col;
# here's a hack case for external images
if ($obj->isTag && $name eq 'Pick_me_to_call' && $obj->right(2)=~/\.(jpg|jpeg|gif)$/i) {
return (td({-colspan=>2},img({-src=>AceImageHackURL($obj->right(2))})),1,1);
}
my $title = $name;
if ($cnt > 1) {
if ($squash{$name} || ($cnt > MAXEXPAND && !$expand{$name})) {
my $to_squash = join('&squash=',map { escape($_) } grep $name ne $_,keys %squash);
my $to_expand = join('&expand=',map { escape($_) } (keys %expand,$name));
return (a({-href=>Url(url(-relative=>1),"name=$pn&class=$pc")
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>CLOSEDCOLOR},"$title ($cnt)"))),
1);
} else {
my $to_squash = join('&squash=',map { escape($_) } (keys %squash,$name));
my $to_expand = join('&expand=',map { escape($_) } grep $name ne $_,keys %expand);
return (a({-href=>Url(url(-relative=>1), "name=$pn&class=$pc")
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>OPENCOLOR},"$title"))),
0);
}
}
acebrowser/cgi-bin/generic/xml view on Meta::CPAN
#!/usr/bin/perl
# generic xml display
# should work with any data model
use strict;
use vars qw($DB);
use Ace 1.65;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
AceError(<<END) unless param('name') && param('class');
Call this script with URL parameters of
<VAR>name</VAR> and <VAR>class,</VAR> where
"name" and "class" correspond to the name and class of the
Ace object of interest.
END
acebrowser/cgi-bin/moviedb/movie view on Meta::CPAN
# -*- Mode: perl -*-
# file: movie
# Moviedb "movie" display
use strict;
use lib '..';
use vars '$DB';
use Ace 1.51;
use Ace::Browser::AceSubs;
use CGI 2.42 qw/:standard :html3 escape/;
my $movie = GetAceObject();
PrintTop($movie,'Movie');
print_prompt();
AceNotFound() unless $movie;
print_report($movie);
PrintBottom();
exit 0;
acebrowser/cgi-bin/moviedb/person view on Meta::CPAN
# -*- Mode: perl -*-
# file: person
# Moviedb "person" display
use strict;
use lib '..';
use vars '$DB';
use Ace 1.51;
use Ace::Browser::AceSubs;
use CGI 2.42 qw/:standard :html3 escape/;
my $person = GetAceObject();
PrintTop($person,'Person');
print_prompt();
AceNotFound() unless $person;
print_report($person);
PrintBottom();
sub print_prompt {
acebrowser/cgi-bin/searches/basic view on Meta::CPAN
#!/usr/bin/perl
use strict 'vars';
use vars qw/$DB $URL %EQUIV/;
use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs qw(:DEFAULT DoRedirect);
use Ace::Browser::SearchSubs;
my $classlist = Configuration()->Basic_objects;
my @classlist = @{$classlist}[map {2*$_} (0..@$classlist/2-1)]; # keep keys, preserving the order
my $JSCRIPT=<<END;
function focussearch() {
document.SimpleForm.query.focus();
acebrowser/cgi-bin/searches/browser view on Meta::CPAN
#!/usr/bin/perl
use strict;
use vars qw($DB);
use lib '..';
use Ace 1.76;
use CGI::Carp qw/fatalsToBrowser/;
use CGI 2.42 qw/:standard :html3 escape/;
use Ace::Browser::AceSubs qw(:DEFAULT ResolveUrl DoRedirect);
use Ace::Browser::SearchSubs;
my $search_class = param('class');
my $search_pattern = param('query');
my $offset = AceSearchOffset();
# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");
acebrowser/cgi-bin/searches/query view on Meta::CPAN
#!/usr/bin/perl
use strict;
use vars qw/$DB $URL %PAPERS/;
use Ace 1.38;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs qw(:DEFAULT DoRedirect);
use Ace::Browser::SearchSubs;
# zero globals in utilities
my $query = param('query');
my $offset = AceSearchOffset();
$URL = url();
$URL=~s!^http://[^/]+!!;
acebrowser/cgi-bin/searches/text view on Meta::CPAN
#!/usr/bin/perl
use strict;
use vars qw/$DB $URL/;
use Ace 1.51;
use CGI 2.42 qw/:standard :html3 escape/;
use CGI::Carp qw/fatalsToBrowser/;
use Ace::Browser::AceSubs;
use Ace::Browser::SearchSubs;
# zero globals in utilities
my $pattern = param('query');
my $search_type = param('type');
my $offset = AceSearchOffset();
$URL = url();
acebrowser/conf/default.pm view on Meta::CPAN
# ========= &URL_MAPPER =========
# mapping from object type to URL. Return empty list to fall through
# to default.
sub URL_MAPPER {
my ($display,$name,$class) = @_;
# Small Ace inconsistency: Models named "#name" should be
# transduced to Models named "?name"
$name = "?$1" if $class eq 'Model' && $name=~/^\#(.*)/;
my $n = CGI->escape("$name"); # looks superfluous, but avoids Ace::Object name conversions errors
my $c = CGI->escape($class);
# pictures remain pictures
if ($display eq 'pic') {
return ('pic' => "name=$n&class=$c");
}
# otherwise display it with a tree
else {
return ('tree' => "name=$n&class=$c");
}
}
acebrowser/conf/elegans.pm view on Meta::CPAN
use CGI 'escape','img';
# here's the root of all our stuff
$ROOT = '/perl/ace/elegans';
$WB = '/wormbase'; # The root is at the top level
# ========= $NAME =========
# symbolic name of the database (defaults to name of file, lowercase)
$NAME = 'elegans';
# ========= $HOST =========
acebrowser/conf/elegans.pm view on Meta::CPAN
);
# ========= &URL_MAPPER =========
# mapping from object type to URL. Return empty list to fall through
# to default.
sub URL_MAPPER {
my ($display,$name,$class) = @_;
# Small Ace inconsistency: Models named "#name" should be
# transduced to Models named "?name"
$name = "?$1" if $class eq 'Model' && $name=~/^\#(.*)/;
my $n = escape($name);
my $c = escape($class);
my $qs = "name=$n";
my $qsc = "name=$n&class=$c";
return (laboratory => $qs) if $class eq 'Laboratory';
return (paper => $qs) if $class eq 'Paper';
return (biblio => "$qs&class=Keyword") if $class eq 'Keyword';
return (clone => $qs ) if $class eq 'Clone';
return (gene => $qs ) if $class eq 'Locus';
return (sequence => $qs ) if $class eq 'Sequence';
return (expr_pattern => $qs) if $class eq 'Expr_pattern';
acebrowser/conf/simple.pm view on Meta::CPAN
# ========= &URL_MAPPER =========
# mapping from object type to URL. Return empty list to fall through
# to default.
sub URL_MAPPER {
my ($display,$name,$class) = @_;
# Small Ace inconsistency: Models named "#name" should be
# transduced to Models named "?name"
$name = "?$1" if $class eq 'Model' && $name=~/^\#(.*)/;
my $n = CGI::escape("$name"); # looks superfluous, but avoids Ace::Object name conversions errors
my $c = CGI::escape($class);
# pictures remain pictures
if ($display eq 'pic') {
return ('pic' => "name=$n&class=$c");
}
# otherwise display it with a tree
else {
return ('tree' => "name=$n&class=$c");
}
}
acelib/freesubs.c view on Meta::CPAN
*in = *cp ;
if (isecho)
putchar (*in) ;
}
else
messout ("Parameter %%%d can not be substituted", kpar) ;
if (++in >= cardEnd)
freeExtend (&in) ;
*in = ch ;
goto lao ; /* mieg */
case '\\': /* escapes next character - interprets \n */
*in = _FREECHAR ;
if (*in == '\n') /* fold continuation lines */
{ if (isInteractive && !streamlevel)
printf (" Continuation >") ;
while ((ch = _FREECHAR) == ' ' || ch == '\t') ;
/* remove whitespace at start of next line */
if (currfil) /* push back ch */
ungetc (ch, currfil) ;
else
--currtext ;
acelib/freesubs.c view on Meta::CPAN
{ while (getc(fil) != '\n' && !feof(fil)) ;
++*line ;
if (in > card) /* // at start of line ignores line */
goto got_line ;
else
--in ; /* in = 0 unprintable, so backstepped */
}
else
ungetc (ch,fil) ;
break ;
case '\\' : /* escape next character */
*in = getc(fil) ;
if (*in == '\n') /* continuation */
{ ++*line ;
while (isspace (*in = getc(fil))) ; /* remove whitespace */
}
else if (*in == '"' || *in == '\\') /* escape for freeword */
{ *(in+1) = *in ;
*in = '\\' ;
++in ;
}
/* NB fall through - in case next char is nonprinting */
default:
if (!isprint (*in) && *in != '\t') /* ignore control chars, e.g. \x0d */
--in ;
}
}
acelib/freesubs.c view on Meta::CPAN
unsigned char *start ;
int nquote = 1 ;
for (fp = fmt ; *fp ; ++fp)
switch (*fp)
{
case 'w' : if (freeword ()) break ; else goto retFALSE ;
case 'i' : if (freeint (&target.i)) break ; else goto retFALSE ;
case 'f' : if (freefloat (&target.r)) break ; else goto retFALSE ;
case 'd' : if (freedouble (&target.d)) break ; else goto retFALSE ;
case 't' : /* must insert '"' and escape any remaining '"'s or '\'s */
for (start = pos ; *pos ; ++pos)
if (*pos == '"' || *pos == '\\')
++nquote ;
*(pos+nquote+1) = '"' ; /* end of line */
for ( ; pos >= start ; --pos)
{ *(pos + nquote) = *pos ;
if (*pos == '"' || *pos == '\\')
*(pos + --nquote) = '\\' ;
}
*start = '"' ;
docs/GFF_Spec.html view on Meta::CPAN
gene structure), or to group multiple regions of match to another
sequence, such as an EST or a protein. See below for examples.<br>
<b>Version 2 change</b>: In version 2, the optional [group] field on the line
must have an tag value structure following the syntax used within
objects in a .ace file, flattened onto one line by semicolon
separators. Tags must be standard identifiers
([A-Za-z][A-Za-z0-9_]*). Free text values must be quoted with double
quotes. <em>Note: all non-printing characters in such free text value strings
(e.g. newlines, tabs, control characters, etc)
must be explicitly represented by their C (UNIX) style backslash-escaped
representation (e.g. newlines as '\n', tabs as '\t').</em>
As in ACEDB, multiple values can follow a specific tag. The
aim is to establish consistent use of particular tags, corresponding
to an underlying implied ACEDB model if you want to think that way
(but acedb is not required). Examples of these would be:
<font size="3"><pre>
seq1 BLASTX similarity 101 235 87.1 + 0 Target "HBA_HUMAN" 11 55 ; E_value 0.0003
dJ102G20 GD_mRNA coding_exon 7105 7201 . - 2 Sequence "dJ102G20.C1.1"
</pre></font>
docs/GFF_Spec.html view on Meta::CPAN
980909 ihh: fixed some small things and put this page on the Sanger
GFF site.<P>
981216 rd: introduced version 2 changes.<P>
990226 rbsk: incorporated amendments to the version 2 specification as follows:<P>
<UL>
<LI>Non-printing characters (e.g. newlines, tabs) in Version 2 double quoted
"free text values" must be explicitly represented by their C (UNIX) style
backslash escaped character (i.e. '\t' for tabs, '\n' for newlines, etc.)<br>
<LI>Removed field (256) and line (32K) character size limitations for Version 2.
<LI>Removed arbitrary whitespace field delimiter permission from specification.
TAB ('\t') field delimiters now enforced again, as in Version 1.<br>
</UL>
990317 rbsk:
<UL>
<LI>End of line comments following Version 2 [group] field tag-value structures must be
tab '\t' or hash '#' delimited.
</UL>
<P>
( run in 0.657 second using v1.01-cache-2.11-cpan-c21f80fb71c )