AcePerl
view release on metacpan or search on metacpan
use constant STATUS_WAITING => 0;
use constant STATUS_PENDING => 1;
use constant STATUS_ERROR => -1;
use constant ACE_PARSE => 3;
use constant DEFAULT_PORT => 200005; # rpc server
use constant DEFAULT_SOCKET => 2005; # socket server
require Ace::Iterator;
require Ace::Object;
eval qq{use Ace::Freesubs}; # XS file, may not be available
# Map database names to objects (to fix file-caching issue)
my %NAME2DB;
# internal cache of objects
my %MEMORY_CACHE;
my %DEFAULT_CACHE_PARAMETERS = (
default_expires_in => '1 day',
auto_purge_interval => '12 hours',
$host ||= 'localhost';
$user ||= $u || '';
$path ||= $p || '';
$port ||= $server_type eq 'Ace::SocketServer' ? DEFAULT_SOCKET : DEFAULT_PORT;
$query_timeout = 120 unless defined $query_timeout;
$server_type ||= 'Ace::SocketServer' if $port < 100000;
$server_type ||= 'Ace::RPC' if $port >= 100000;
}
# we've normalized parameters, so do the actual connect
eval "require $server_type" || croak "Module $server_type not loaded: $@";
if ($path) {
$database = $server_type->connect(-path=>$path,%$other);
} else {
$database = $server_type->connect($host,$port,$query_timeout,$user,$pass,%$other);
}
unless ($database) {
$Ace::Error ||= "Couldn't open database";
return;
}
elsif (!ref $selector) {
$selected_class = $selector;
}
else {
croak "$selector is neither a scalar, nor a HASH, nor an object that supports the class_for() method";
}
}
$selected_class ||= 'Ace::Object';
eval "require $selected_class; 1;" || croak $@
unless $selected_class->can('new');
$selected_class;
}
sub process_url {
my $class = shift;
my $url = shift;
my ($host,$port,$user,$pass,$path,$server_type) = ('','','','','','');
# Fetch a model from the database.
# Since there are limited numbers of models, we cache
# the results internally.
sub model {
my $self = shift;
require Ace::Model;
my $model = shift;
my $break_cycle = shift; # for breaking cycles when following #includes
my $key = join(':',$self,'MODEL',$model);
$self->{'models'}{$model} ||= eval{$self->cache->get($key)};
unless ($self->{models}{$model}) {
$self->{models}{$model} =
Ace::Model->new($self->raw_query("model \"$model\""),$self,$break_cycle);
eval {$self->cache->set($key=>$self->{models}{$model})};
}
return $self->{'models'}{$model};
}
# cached get
# pass "1" for fill to get a full fill
# pass any other true value to get a tag fill
sub get {
my $self = shift;
my ($class,$name,$fill) = @_;
my $d = $self->{filecache};
$self->{filecache} = shift if @_;
$d;
}
sub _create_cache {
my $self = shift;
my $params = shift;
$params = {} if $params and !ref $params;
return unless eval {require Cache::SizeAwareFileCache}; # not installed
(my $namespace = "$self") =~ s!/!_!g;
my %cache_params = (
namespace => $namespace,
%DEFAULT_CACHE_PARAMETERS,
%$params,
);
my $cache_obj = Cache::SizeAwareFileCache->new(\%cache_params);
$self->cache($cache_obj);
}
one of "ace" or "java." Called with an argument, it will set the
style to one or the other.
=head2 timestamps() method
$timestamps_on = $db->timestamps();
$db->timestamps(1);
Whenever a data object is updated, AceDB records the time and date of
the update, and the user ID it was running under. Ordinarily, the
retrieval of timestamp information is suppressed to conserve memory
and bandwidth. To turn on timestamps, call the B<timestamps()> method
with a true value. You can retrieve the current value of the setting
by calling the method with no arguments.
Note that activating timestamps disables some of the speed
optimizations in AcePerl. Thus they should only be activated if you
really need the information.
=head2 auto_save()
Ace/Browser/AceSubs.pm view on Meta::CPAN
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/;
Ace/Browser/AceSubs.pm view on Meta::CPAN
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;
Ace/Browser/SiteDefs.pm view on Meta::CPAN
my $configuration = Configuration;
my $docroot = $configuration->Docroot;
my @pictures = @{$configuration->Pictures};
my %displays = %{$configuration->Displays};
my $coderef = $configuration->Url_mapper;
$coderef->($param1,$param2);
=head1 DESCRIPTION
Ace::Browser::SiteDefs evaluates an AceBrowser configuration file and
returns a configuration object ("config object" for short). A config
object is a bag of dynamically-generated methods, derived from the
scalar variables, arrays, hashes and subroutines in the configuration
file.
The config object methods are a canonicalized form of the
configuration file variables, in which the first character of the
method is uppercase, and subsequent characters are lower case. For
example, if the configuration variable was $ROOT, the method will be
$config_object->Root.
Ace/Browser/SiteDefs.pm view on Meta::CPAN
my $package = shift;
my $file = shift;
no strict 'vars';
no strict 'refs';
$file =~ m!([/a-zA-Z0-9._-]+)!;
my $safe = $1;
(my $ns = $safe) =~ s/\W/_/g;
my $namespace = __PACKAGE__ . '::Config::' . $ns;
unless (eval "package $namespace; require '$safe';") {
die "compile error while parsing config file '$safe': $@\n";
}
# build the object up from the values compiled into the $namespace area
my %data;
# get the scalars
local *symbol;
foreach (keys %{"${namespace}::"}) {
*symbol = ${"${namespace}::"}{$_};
$data{ucfirst(lc $_)} = $symbol if defined($symbol);
Ace/Graphics/Glyph.pm view on Meta::CPAN
sub labelheight {
my $self = shift;
return $self->{labelheight} ||= $self->font->height;
}
sub label {
my $f = (my $self = shift)->feature;
if (ref (my $code = $self->option('label')) eq 'CODE') {
return $code->($f);
}
my $info = eval {$f->info};
return $info if $info;
return $f->seqname if $f->can('seqname');
return $f->primary_tag;
}
# return array containing the left,top,right,bottom
sub box {
my $self = shift;
return ($self->left,$self->top,$self->right,$self->bottom);
}
Ace/Graphics/Glyph/graded_segments.pm view on Meta::CPAN
} else {
return $self->SUPER::draw(@_);
}
# figure out the colors
my $max_score = $self->option('max_score');
unless ($max_score) {
$max_score = 0;
foreach (@segments) {
my $s = eval { $_->score };
$max_score = $s if $s > $max_score;
}
}
# allocate colors
my $fill = $self->fillcolor;
my %segcolors;
my ($red,$green,$blue) = $self->factory->rgb($fill);
foreach (sort {$a->start <=> $b->start} @segments) {
my $s = eval { $_->score };
unless (defined $s) {
$segcolors{$_} = $fill;
next;
}
my($r,$g,$b) = map {(255 - (255-$_) * ($s/$max_score))} ($red,$green,$blue);
my $idx = $self->factory->translate($r,$g,$b);
$segcolors{$_} = $idx;
}
# get parameters
Ace/Graphics/GlyphFactory.pm view on Meta::CPAN
$options{height} ||= 10;
$options{font} ||= gdSmallFont;
$options{fontcolor} ||= 'black';
$type = $options{glyph} if defined $options{glyph};
my $glyphclass = 'Ace::Graphics::Glyph';
$glyphclass .= "\:\:$type" if $type && $type ne 'generic';
confess("the requested glyph class, ``$type'' is not available: $@")
unless (eval "require $glyphclass");
return bless {
glyphclass => $glyphclass,
scale => 1, # 1 pixel per kb
options => \%options,
},$class;
}
sub clone {
my $self = shift;
Ace/Iterator.pm view on Meta::CPAN
empty object stubs. Retrieving filled objects uses more memory and
network bandwidth than retrieving unfilled objects, but it's
recommended if you know in advance that you will be accessing most or
all of the objects' fields, for example, for the purposes of
displaying the objects.
=item -chunksize
The iterator will fetch objects from the database in chunks controlled
by this argument. The default is 40. You may want to tune the
chunksize to optimize the retrieval for your application.
=back
=head2 next() method
$object = $iterator->next;
This method retrieves the next object from the query, performing
whatever database accesses it needs. After the last object has been
fetched, the next() will return undef. Usually you will call next()
Ace/Object.pm view on Meta::CPAN
$result = $db->raw_query("parse = $cmd");
}
if (defined($result) and $result=~/write( or admin)? access/im) { # this keeps changing
$Ace::Error = "Write access denied";
} elsif (defined($result) and $result =~ /sorry|parse error/mi) {
$Ace::Error = $result;
}
return if $Ace::Error;
undef $self->{'.update'};
# this will force a fresh retrieval of the object
# and synchronize our in-memory copy with the db
delete $self->{'.right'};
delete $self->{'.PATHS'};
return 1;
}
# undo changes
sub rollback {
my $self = shift;
undef $self->{'.update'};
Ace/Sequence.pm view on Meta::CPAN
length => $length || $p_length,
parent => $parent,
p_offset => $p_offset,
refseq => [$source,$r_offset,$r_strand],
strand => $strand,
absolute => 0,
automerge => 1,
},$pack;
# set the reference sequence
eval { $self->refseq($refseq) } or return if defined $refseq;
# wheww!
return $self;
}
# return the "source" object that the user offset from
sub source {
$_[0]->{obj};
}
Ace/Sequence.pm view on Meta::CPAN
$promiscuous++;
for my $st (@$subtypes) {
next unless defined $st;
$expr .= "return 1 if \$d[1]=~/$st/i;\n";
}
}
$s .= $expr;
}
$s .= "return;\n }";
$sub = eval $s;
croak $@ if $@;
} else {
$sub = sub { 1; }
}
return ($sub,$promiscuous ? [] : [keys %filter]);
}
# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
my $self = shift;
Makefile.PL view on Meta::CPAN
'util/ace.PLS'=>'util/ace.pl',
},
EXE_FILES => ['util/ace.pl'],
'clean' => {'FILES' => 'acelib/lib* acelib/*.o acelib/rpcace*.[ch]'},
);
exit 0;
sub setup_sitedefs {
my ($conf_path,$cgi_path,$html_path);
eval 'use Ace::Browser::LocalSiteDefs qw($SITE_DEFS $CGI_PATH $HTML_PATH)';
if ($SITE_DEFS) {
print "\n";
print "You have installed Ace::Browser before, using old settings for defaults.\n";
$conf_path = $SITE_DEFS;
$cgi_path = $CGI_PATH;
$html_path = $HTML_PATH;
}
$conf_path ||= '/usr/local/apache/conf/ace';
$cgi_path ||= '/usr/local/apache/cgi-bin/ace';
$html_path ||= '/usr/local/apache/htdocs/ace';
Makefile.PL view on Meta::CPAN
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. See DISCLAIMER.txt for
disclaimers of warranty.
=cut
END
close F;
eval <<END;
sub MY::postamble {
'
install-browser :
util/install.pl acebrowser/htdocs $html_path
util/install.pl acebrowser/cgi-bin $cgi_path
util/install.pl acebrowser/conf $conf_path
mkdir $html_path/images
chmod go+rwx $html_path/images
';
}
my $val = constant($constname, 0);
if ($! != 0) {
if ($! =~ /Invalid/) {
$AutoLoader::AUTOLOAD = $AUTOLOAD;
goto &AutoLoader::AUTOLOAD;
}
else {
croak "Your vendor has not defined constant $constname";
}
}
eval "sub $AUTOLOAD { $val }";
goto &$AUTOLOAD;
}
bootstrap Ace::RPC $VERSION;
1;
__END__
acelib/aceclientlib.c view on Meta::CPAN
char *host hostname running server
int timeOut maximum peroid to wait for answer
OUTPUT
return value:
ace_handle * pointer to structure containing open connection
and client identification information
*/
ace_handle *openServer(char *host, u_long rpc_port, int timeOut)
{
struct timeval tv;
char *answer;
int length,
clientId = 0, n,
magic1, magic3 = 0 ;
ace_reponse *reponse = 0;
ace_data question ;
ace_handle *handle;
CLIENT *clnt;
/* open rpc connection */
acelib/timesubs.c view on Meta::CPAN
1998-06-07 = 1998-06-12 -> FALSE
Complications occur, if the level of detail given varies in both dates :-
1998-06 < 1998-07-09_09:51:23 -> TRUE
the "lessthan" fact is decided on the months
1990 = 1990-05-02 -> TRUE
in case of equality the comparison asks if the lesser detailed date
is completely contained within the other, and the above
comparison evaluates TRUE, because May 2nd 1990 is in the year 1990
1998-07 < 1998-07-09 -> FALSE
because one date gives a specific day in July 1998, but as the
first date misses the day, we can't decide whether it is earlier.
Example: the movie City Hall was released on 1996-02-16.
select m->Title, m->Released from m in class Movie where m->Released < `1996-02
select m->Title, m->Released from m in class Movie where m->Released > `1996-02
acelib/wh/aceversion.h view on Meta::CPAN
/* File: version.h
* Author: Ed Griffiths (edgrif@mrc-lmba.cam.ac.uk)
* Copyright (C) J Thierry-Mieg and R Durbin, 1998
*-------------------------------------------------------------------
* This file is part of the ACEDB genome database package, written by
* Richard Durbin (MRC LMB, UK) rd@mrc-lmba.cam.ac.uk, and
* Jean Thierry-Mieg (CRBM du CNRS, France) mieg@crbm1.cnusc.fr
*
* Description: Declares functions in the new acedb_version module.
* These functions allow the retrieval of various parts
* of the current acedb version number or string.
* Exported functions: See descriptions below.
* HISTORY:
* Last edited: Dec 3 14:58 1998 (edgrif)
* * Dec 3 14:39 1998 (edgrif): Changed the interface to fit in with
* libace.
* Created: Wed Apr 29 13:46:41 1998 (edgrif)
*-------------------------------------------------------------------
*/
docs/GFF_Spec.html view on Meta::CPAN
<P>
<HR>
<A NAME="GFF_use"><h2> Ways to use GFF </h2>
Here are a few suggestions on how the GFF format might be used.
<ol>
<li> Simple sharing of sensors. In this case, researcher A has a sensor,
such as a 3' splice site sensor, and researcher B wants to test that
sensor. They agree on a set of sequences, researcher A runs the
sensor on these sequences and sends the resulting GFF file to
researher B, who then evaluates the result.<P>
<li> Representing experimental results. GFF feature records can also
be created for experimentally confirmed exons and other features. In
these cases there will presumably be no score. Such "confirmed" GFF
files will be useful for evaluating predictions, using the same
software as you would to compare predictions.<P>
<li> Integrated gene parsing. Several GFF files from different
researchers can be combined to provide the features used by an
integrated genefinder. As mentioned above, this has the advantage
that different combinations of sensors and dynamic programming methods
for assembling sensor scores into consistent gene parses can be easily
explored.<P>
<li> Reporting final predictions. GFF format can also be used to
docs/GFF_Spec.html view on Meta::CPAN
entire sequence from position 1 up to position i. Then for any
positions i < j, the sum of the scores of all codons from i to j can
be obtained as A[j] - A[i]. Using these arrays, along with the
candidate splice site scores, a very large number of scores for
overlapping exons are implicitly defined in a data structure that
takes only linear space with respect to the number of positions in the
sequence, and such that the score for each exon can be retrieved in
constant time. <P>
When the GFF format is used to transmit scores that can be summed for
efficient retrieval as in the case of the codon scores above, we ask
that the provider of the scores indicate that these scores are
summable in this manner, and provide a recipe for calculating the
scores that are to be derived from these summable scores, such as the
exon scores described above. We place no limit on the complexity of
this recipe, nor do we provide a standard protocol for such assembly,
other than providing examples. It behooves the sensor score provider
to keep the recipe simple enough that others can easily implement it.
<P>
Back to <A HREF="#TOC">Table of Contents</A>
<P>
examples/ace.pl view on Meta::CPAN
my $DB = $URL ? Ace->connect(-url=>$URL,-user=>$USER,-pass=>$PASS)
: $PATH ? Ace->connect(-path=>$PATH)
: Ace->connect(-host=>$HOST,-port=>$PORT,-user=>$USER,-pass=>$PASS);
$DB || die "Connection failure: ",Ace->error,"\n";
$DB->auto_save($AUTOSAVE);
if (@EXEC) {
foreach (@EXEC) {
foreach (split (';'))
{ evaluate($_); }
}
exit 0;
}
# read_top_material() if $PATH;
if (@ARGV || !-t STDIN) {
while (<>) {
chomp;
evaluate($_);
}
} elsif (eval "require Term::ReadLine") {
my $term = setup_readline();
while (defined($_ = $term->readline($PROMPT)) ) {
evaluate($_);
}
} else {
$| = 1;
print $PROMPT;
while (<>) {
chomp;
evaluate($_);
} continue {
print $PROMPT;
}
}
quit();
sub quit {
undef $DB;
print "\n// A bientot!\n";
exit 0;
}
sub evaluate {
my $query = shift;
my @commands;
if ($query=~/^(quit|exit)/i) {
quit();
exit 0;
}
if ($query =~ /^(p?parse) (?!=)(.*)/i) {
push (@commands,setup_parse($1,$2));
} else {
push (@commands,$query);
examples/ace.pl view on Meta::CPAN
}
}
sub setup_readline {
my $term = new Term::ReadLine 'aceperl';
my (@commands) = qw/quit help classes model find follow grep longgrep list
show is remove query where table-maker biblio dna peptide keyset-read
spush spop swap sand sor sxor sminus parse pparse write edit
eedit shutdown who data_version kill status date time_stamps
count clear save undo wspec/;
eval {
readline::rl_basic_commands(@commands);
readline::rl_set('TcshCompleteMode', 'On') if $TCSH;
$readline::rl_special_prefixes='"';
$readline::rl_completion_function=\&complete;
};
$term;
}
# This is a big function for command completion/guessing.
sub complete {
t/sequence.t view on Meta::CPAN
@features = sort { $a->start <=> $b->start; } $zk154->features('exon');
test(17,@features,'features() error');
test(18,$features[0]->start > 0,'features()->start error');
test(19,$features[0]->end-$features[0]->start +1 == $features[0]->length,'features()->end error');
test(20,$gff = $zk154->gff,'gff() error');
if (eval q{local($^W)=0; require GFF;}) {
# print STDERR "Expect a seek() on unopened file error from GFF module...\n";
test(21,$gff = $zk154->GFF,'GFF() error');
} else {
print "ok 21 # Skip no GFF module installed\n";
}
# Test that we can do the same thing on forward and reverse predicted genes
test(22,$gene = $db->fetch(Predicted_gene=>'ZK154.1'),"fetch failure");
test(23,$zk154_1 = Ace::Sequence->new($gene),"new() failure");
test(24,$zk154_1->start > 0,"start() failure");
util/ace.PLS view on Meta::CPAN
my $DB = $URL ? Ace->connect(-url=>$URL,-user=>$USER,-pass=>$PASS)
: $PATH ? Ace->connect(-path=>$PATH)
: Ace->connect(-host=>$HOST,-port=>$PORT,-user=>$USER,-pass=>$PASS);
$DB || die "Connection failure: ",Ace->error,"\n";
$DB->auto_save($AUTOSAVE);
if (@EXEC) {
foreach (@EXEC) {
foreach (split (';'))
{ evaluate($_); }
}
exit 0;
}
# read_top_material() if $PATH;
if (@ARGV || !-t STDIN) {
while (<>) {
chomp;
evaluate($_);
}
} elsif (eval "require Term::ReadLine") {
my $term = setup_readline();
while (defined($_ = $term->readline($PROMPT)) ) {
evaluate($_);
}
} else {
$| = 1;
print $PROMPT;
while (<>) {
chomp;
evaluate($_);
} continue {
print $PROMPT;
}
}
quit();
sub quit {
undef $DB;
print "\n// A bientot!\n";
exit 0;
}
sub evaluate {
my $query = shift;
my @commands;
if ($query=~/^(quit|exit)/i) {
quit();
exit 0;
}
if ($query =~ /^(p?parse) (?!=)(.*)/i) {
push (@commands,setup_parse($1,$2));
} else {
push (@commands,$query);
util/ace.PLS view on Meta::CPAN
}
}
sub setup_readline {
my $term = new Term::ReadLine 'aceperl';
my (@commands) = qw/quit help classes model find follow grep longgrep list
show is remove query where table-maker biblio dna peptide keyset-read
spush spop swap sand sor sxor sminus parse pparse write edit
eedit shutdown who data_version kill status date time_stamps
count clear save undo wspec/;
eval {
readline::rl_basic_commands(@commands);
readline::rl_set('TcshCompleteMode', 'On') if $TCSH;
$readline::rl_special_prefixes='"';
$readline::rl_completion_function=\&complete;
};
$term;
}
# This is a big function for command completion/guessing.
sub complete {
( run in 2.360 seconds using v1.01-cache-2.11-cpan-98e64b0badf )