AcePerl
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
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',
);
Ace/Browser/TreeSubs.pm view on Meta::CPAN
# colors
use constant OPENCOLOR => '#FF0000'; # color when a tree is expanded
use constant CLOSEDCOLOR => '#909090'; # color when a tree is collapsed
# auto-expand subtrees when the number of subobjects is
# less than or equal to this number
use constant MAXEXPAND => 4;
# A hack to allow access to external images.
# 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/Graphics/Panel.pm view on Meta::CPAN
$panel->add_track(segments => [[$abc_5,$abc_3],
[$xxx_5,$xxx_3],
[$yyy_5,$yyy_3]],
-connect_groups => 1);
=item $gd = $panel->gd
The gd() method lays out the image and returns a GD::Image object
containing it. You may then call the GD::Image object's png() or
jpeg() methods to get the image data.
=item $png = $panel->png
The png() method returns the image as a PNG-format drawing, without
the intermediate step of returning a GD::Image object.
=item $boxes = $panel->boxes
=item @boxes = $panel->boxes
Ace/Iterator.pm view on Meta::CPAN
$i = $db->fetch_many(Sequence=>'*'); # fetch a cursor
while ($obj = $i->next) {
print $obj->asTable;
}
=head1 DESCRIPTION
The Ace::Iterator class implements a persistent query on an Ace
database. You can create multiple simultaneous queries and retrieve
objects from each one independently of the others. This is useful
when a query is expected to return more objects than can easily fit
into memory. The iterator is essentially a database "cursor."
=head2 new() Method
$iterator = Ace::Iterator->new(-db => $db,
-query => $query,
-filled => $filled,
-chunksize => $chunksize);
An Ace::Iterator is returned by the Ace accessor's object's
fetch_many() method. You usually will not have cause to call the new()
method directly. If you do so, the parameters are as follows:
=over 4
=item -db
The Ace database accessor object to use.
=item -query
A query, written in Ace query language, to pass to the database. This
query should return a list of objects.
=item -filled
If true, then retrieve complete objects from the database, rather than
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()
inside a loop like this:
while (my $object = $iterator->next) {
# do something with $object
}
Because of the way that object caching works, next() will be most
efficient if you are only looping over one iterator at a time.
Although parallel access will work correctly, it will be less
Ace/Local.pm view on Meta::CPAN
my($pid) = open2($rdr,$wtr,"$program $args");
unless ($pid) {
$Ace::Error = <$rdr>;
return undef;
}
# Figure out the prompt by reading until we get zero length,
# then take whatever's at the end.
unless ($nosync) {
local($/) = "> ";
my $data = <$rdr>;
($prompt) = $data=~/^(.+> )/m;
unless ($prompt) {
$Ace::Error = "$program didn't open correctly";
return undef;
}
}
return bless {
'read' => $rdr,
'write' => $wtr,
'prompt' => $prompt,
Ace/Model.pm view on Meta::CPAN
$VERSION = '1.51';
my $TAG = '\b\w+\b';
my $KEYWORD = q[^(XREF|UNIQUE|ANY|FREE|REPEAT|Int|Text|Float|DateType)$];
my $METAWORD = q[^(XREF|UNIQUE|ANY|FREE|REPEAT|Int|Text|Float|DateType)$];
# construct a new Ace::Model
sub new {
my $class = shift;
my ($data,$db,$break_cycle) = @_;
$break_cycle ||= {};
$data=~s!\s+//.*$!!gm; # remove all comments
$data=~s!\0!!g;
my ($name) = $data =~ /\A[\?\#](\w+)/;
my $self = bless {
name => $name,
raw => $data,
submodels => [],
},$class;
if (!$break_cycle->{$name} && $db && (my @hashes = grep {$_ ne $name} $data =~ /\#(\S+)/g)) {
$break_cycle->{$name}++;
my %seen;
my @submodels = map {$db->model($_,$break_cycle)} grep {!$seen{$_}++} @hashes;
$self->{submodels} = \@submodels;
}
return $self;
}
sub name {
Ace/Object.pm view on Meta::CPAN
: $self->{'class'};
}
################### name and class together #################
sub id {
my $self = shift;
return "$self->{class}:$self->{name}";
}
############## return true if two objects are equivalent ##################
# to be equivalent, they must have identical names, classes and databases #
# We handle comparisons between objects and numbers ourselves, and let #
# Perl handle comparisons between objects and strings #
sub eq {
my ($a,$b,$rev) = @_;
unless (UNIVERSAL::isa($b,'Ace::Object')) {
$a = $a->name + 0; # convert to numeric
return $a == $b; # do a numeric comparison
}
return 1 if ($a->name eq $b->name)
&& ($a->class eq $b->class)
Ace/Sequence/Feature.pm view on Meta::CPAN
sub method { shift->_field('method',@_) } # ... I prefer "method"
sub subtype { shift->_field('method',@_) } # ... or even "subtype"
sub type { shift->_field('type',@_) } # ... I prefer "type"
sub score { shift->_field('score',@_) } # float indicating some sort of score
sub frame { shift->_field('frame',@_) } # one of 1, 2, 3 or undef
sub info { # returns Ace::Object(s) with info about the feature
my $self = shift;
unless ($self->{group}) {
my $info = $self->{info}{group} || 'Method "'.$self->method.'"';
$info =~ s/(\"[^\"]*);([^\"]*\")/$1$;$2/g;
my @data = split(/\s*;\s*/,$info);
foreach (@data) { s/$;/;/g }
$self->{group} = [map {$self->toAce($_)} @data];
}
return wantarray ? @{$self->{group}} : $self->{group}->[0];
}
# bioperl compatibility
sub primary_tag { shift->type(@_) }
sub source_tag { shift->subtype(@_) }
sub db { # database identifier (from Ace::Sequence::Multi)
my $self = shift;
my $db = $self->_field('db',@_);
return $db || $self->SUPER::db;
}
sub group { $_[0]->info; }
sub target { $_[0]->info; }
sub asString {
my $self = shift;
Ace/Sequence/GappedAlignment.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Sequence::GappedAlignment - Gapped alignment object
=head1 SYNOPSIS
# open database connection and get an Ace::Sequence object
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the gapped alignments
@alignments = $seq->alignments('EST_GENOME');
Ace/Sequence/Gene.pm view on Meta::CPAN
1;
__END__
=head1 NAME
Ace::Sequence::Gene - Simple "Gene" Object
=head1 SYNOPSIS
# open database connection and get an Ace::Object sequence
use Ace::Sequence;
# get a megabase from the middle of chromosome I
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the genes
@genes = $seq->genes;
Ace/Sequence/Multi.pm view on Meta::CPAN
my $opt = $self->_feature_filter($features);
for my $db ($self->secondary) {
my $supplement = $self->_gff($opt,$db);
$self->transformGFF(\$supplement) unless $abs;
my $string = $db->asString;
foreach (grep !$seen{$_}++,split("\n",$supplement)) { #ignore duplicates
next if m!^(//|\#)!; # ignore comments
push(@lines, join "\t",$_,$string); # add database as an eighth field
}
}
return join("\n",@lines,'');
}
# turn a GFF file and a filter into a list of Ace::Sequence::Feature objects
sub _make_features {
my $self = shift;
my ($gff,$filter) = @_;
Ace/SocketServer.pm view on Meta::CPAN
$self->{encoring} = 1;
} else {
$self->{status} = STATUS_ERROR;
return _error($body);
}
return $body;
}
sub write {
my $self = shift;
my $data = shift;
unless ($self->_send_msg($data,1)) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
$self->{encoring} = 0;
return 1;
}
sub _error {
$Ace::Error = shift;
to return fewer than the correct number of objects (approximately 0.2% loss).
1.54 2/10/99
1. Fixed spin-loop (polling) bug in Ace::Local. Should no longer
consume 99% of CPU time while waiting for tace to answer a long query.
2. Fixed bug in get() and at() in which tags got duplicated because
of capitalization variations.
1.53 1/23/99
1. Bug fix in Ace::find function. Was causing a crash.
1.52 1/21/99
1. Fixed bad bug in the kill method which caused objects
to be removed from the database seemingly randomly.
2. Optimized tag searching to improve performance when
navigating objects.
3. Better error message reporting when objects do not contain
a desired tag.
1.51 12/14/98
1. Comparison between objects now is more sensible:
"eq" performs a string comparison on object names
"==" performs an object comparison. Two objects are
identical iff their names, classes and databases are identical
2. Fixed bugs involving names containing "*" and "?" characters.
3. Added the -long option to grep.
4. Added the -display option to asGIF()
5. The follow() method now follows a tag into the database.
1.50 10/28.98
1. THE SEMANTICS OF AUTOGENERATED FUNCTIONS HAS CHANGED. THEY NOW
ALWAYS DEREFERENCE THE TAG AND FETCH AN OBJECT FROM THE DATABASE.
2. Added the Ace::put() function to the Ace object, allowing you to move
objects from one database to another.
3. Added Ace::Object::add_row() and add_tree() functions, making it easier to build
up objects from scratch, or to mix and match objects from different databases.
4. Added Ace::parse() and parse_file() methods, for creating objects from .ace files.
5. Removed nulls from error strings.
1.47-49 Internal releases
1.46 1. Fixed nasty bug in which newlines appeared as "n" in text
fields.
1.45. 1. Fixed problems with autogeneration
2. Added the format() routine 3. Added the model() methods and
examples/upstream2.pl
install.PLS
make_docs.PLS
t/basic.t
t/object.t
t/sequence.t
t/update.t
typemap
util/install.PLS
util/ace.PLS
META.yml Module meta-data (added by MakeMaker)
Makefile.PL view on Meta::CPAN
use Config;
use ExtUtils::MakeMaker qw(prompt WriteMakefile);
use File::Path;
require 5.8.0;
my $choice;
while (!$choice) {
$reply = prompt(
"\nWhat do you want to build?\n\n" .
" 1) Interface to Ace socket server and local databases (pure Perl)\n" .
" 2) The above plus XS optimizations (requires C compiler)\n" .
" 3) The above plus RPC server interface (requires C compiler)\n\n" .
"Enter your choice: ", "1");
if ($reply =~ /(\d+)/) {
$choice = $1;
die "invalid choice: $choice!" if $choice < 1 || $choice > 3;
}
}
$choice ||= 1; # safe default
#ifndef ACEPERL_H
#define ACEPERL_H
#define STATUS_WAITING 0
#define STATUS_PENDING 1
#define STATUS_ERROR -1
#define ACE_PARSE 3
typedef struct AceDB {
ace_handle* database;
unsigned char* answer;
int length;
int encoring;
int status;
int errcode;
} AceDB;
#endif
if (RETVAL == NULL) XSRETURN_UNDEF;
RETVAL->encoring = FALSE;
RETVAL->status = STATUS_WAITING;
RETVAL->answer = NULL;
RETVAL->errcode = 0;
ace = openServer(host,rpc_port,timeOut);
if (ace == NULL) {
safefree(RETVAL);
XSRETURN_UNDEF;
} else {
RETVAL->database = ace;
}
OUTPUT:
RETVAL
void
DESTROY(self)
AceDB* self
CODE:
if (self->answer != NULL)
free((void*) self->answer);
if (self->database != NULL)
closeServer(self->database);
safefree((char*)self);
ace_handle*
handle(self)
AceDB* self
CODE:
RETVAL = self->database;
OUTPUT:
RETVAL
int
encore(self)
AceDB* self
CODE:
RETVAL = self->encoring;
OUTPUT:
RETVAL
acebrowser/cgi-bin/generic/acetable view on Meta::CPAN
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.");
AceHeader();
AceError(<<END) unless $NAME ;
Call this script with URL parameters of
<VAR>name</VAR> and <VAR>parms,</VAR> where
"name" is the name of a table definition in acedb
END
display_table($NAME," ");
exit 0;
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
my $b2 = $map_stop + $half;
$b2 = $max if $b2 > $max;
my $b1 = $b2 - ($map_stop - $map_start);
my $m1 = $map_start + $half/2;
my $m2 = $map_stop - $half/2;
print start_table({-border=>1});
print TR(td({-align=>'CENTER',-class=>'datatitle',-colspan=>2},'Map Control'));
print start_TR();
print td(
table({-border=>0},
TR(td(' '),
td(
$map_start > $min ?
a({-href=>"$self?name=$name;class=$class;map_start=$a1;map_stop=$a2"},
img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
:
font({-color=>'#A0A0A0'},img({-src=>UP_ICON,-align=>'MIDDLE',-border=>0}),' Up')
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;
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
#!/usr/bin/perl
# -*- Mode: perl -*-
# file: feedback
# Provide feedback to data curator(s)
use strict;
use CGI 2.42 qw(:standard);
use Ace::Browser::AceSubs qw(:DEFAULT Header DB_Name);
use vars '@FEEDBACK_RECIPIENTS';
# This page called with the parameters:
# recipients- numeric index(es) for recipients of message
# name - name of object to update
view release on metacpan - search on metacpan
( run in 1.232 second using v1.00-cache-2.02-grep-82fe00e-cpan-4673cadbf75 )