AcePerl
view release on metacpan or search on metacpan
I<Ace::Iterator> is a utility class that acts as a database cursor for
long-running ACEDB queries. I<Ace::Model> provides object-oriented
access to ACEDB's schema.
Internally, I<Ace> uses the I<Ace::Local> class for access to local
databases and I<Ace::AceDB> for access to remote databases.
Ordinarily you will not need to interact directly with either of these
classes.
=head1 CREATING NEW DATABASE CONNECTIONS
=head2 connect() -- multiple argument form
# remote database
$db = Ace->connect(-host => 'beta.crbm.cnrs-mop.fr',
-port => 20000100);
# local (non-server) database
$db = Ace->connect(-path => '/usr/local/acedb);
Ace/Browser/AceSubs.pm view on Meta::CPAN
######################### This is the list of exported subroutines #######################
@EXPORT = qw(
GetAceObject AceError AceNotFound AceMissing DoRedirect
OpenDatabase Object2URL Url
ObjectLink Configuration PrintTop PrintBottom);
@EXPORT_OK = qw(AceRedirect Toggle ResolveUrl AceInit AceAddCookie
AceHeader TypeSelector Style AcePicRoot
Header Footer DB_Name AceMultipleChoices);
%EXPORT_TAGS = ( );
use constant DEFAULT_DATABASE => 'default';
use constant PRIVACY => 'misc/privacy'; # privacy/cookie statement
use constant SEARCH_BROWSE => 'search'; # a fallback search script
my %VALID; # cache for get_symbolic() lookups
=item AceError($message)
This subroutine will print out an error message and exit the script.
The text of the message is taken from $message.
=cut
Ace/Browser/AceSubs.pm view on Meta::CPAN
# keeps track of what sections should be open
%OPEN = param('open') ? map {$_ => 1} split(' ',param('open')) : () ;
return 1 if Configuration();
# if we get here, it is a big NOT FOUND error
print header(-status=>'404 Not Found',-type=>'text/html');
$HEADER++;
print start_html(-title => 'Database Not Found',
-style => Ace::Browser::SiteDefs->getConfig(DEFAULT_DATABASE)->Style,
),
h1('Database not found'),
p('The requested database',i(get_symbolic()),'is not recognized',
'by this server.');
print p('Please return to the',a({-href=>referer()},'referring page.')) if referer();
print end_html;
Apache::exit(0) if defined &Apache::exit; # bug out of here!
exit(0);
}
Ace/Browser/AceSubs.pm view on Meta::CPAN
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/[?\#].*$//;
Ace/Graphics/Panel.pm view on Meta::CPAN
for my $track (@{$self->{tracks}}) {
my $boxes = $track->boxes($pl,$offset+$pt);
push @boxes,@$boxes;
$offset += $track->height + $self->spacing;
}
return wantarray ? @boxes : \@boxes;
}
sub read_colors {
my $class = shift;
while (<DATA>) {
chomp;
last if /^__END__/;
my ($name,$r,$g,$b) = split /\s+/;
$COLORS{$name} = [hex $r,hex $g,hex $b];
}
}
sub color_names {
my $class = shift;
$class->read_colors unless %COLORS;
return wantarray ? keys %COLORS : [keys %COLORS];
}
1;
__DATA__
white FF FF FF
black 00 00 00
aliceblue F0 F8 FF
antiquewhite FA EB D7
aqua 00 FF FF
aquamarine 7F FF D4
azure F0 FF FF
beige F5 F5 DC
bisque FF E4 C4
blanchedalmond FF EB CD
Ace/Object.pm view on Meta::CPAN
# $db->memory_cache_delete($self);
}
###################### object constructor #################
# IMPORTANT: The _clone subroutine will copy all instance variables that
# do NOT begin with a dot (.). If you do not want an instance variable
# shared with cloned copies, proceed them with a dot!!!
#
sub new {
my $pack = shift;
my($class,$name,$db,$isRoot) = rearrange([qw/CLASS NAME/,[qw/DATABASE DB/],'ROOT'],@_);
$pack = ref($pack) if ref($pack);
my $self = bless { 'name' => $name,
'class' => $class
},$pack;
$self->db($db) if $self->isObject;
$self->{'.root'}++ if defined $isRoot && $isRoot;
# $self->_dirty(1) if $isRoot;
return $self
}
Ace/Sequence.pm view on Meta::CPAN
sub new {
my $pack = shift;
my ($seq,$start,$end,$offset,$length,$refseq,$db) =
rearrange([
['SEQ','SEQUENCE','SOURCE'],
'START',
['END','STOP'],
['OFFSET','OFF'],
['LENGTH','LEN'],
'REFSEQ',
['DATABASE','DB'],
],@_);
# Object must have a parent sequence and/or a reference
# sequence. In some cases, the parent sequence will be the
# object itself. The reference sequence is used to set up
# the frame of reference for the coordinate system.
# fetch the sequence object if we don't have it already
croak "Please provide either a Sequence object or a database and name"
unless ref($seq) || ($seq && $db);
Ace/SocketServer.pm view on Meta::CPAN
$VERSION = '1.01';
use constant DEFAULT_USER => 'anonymous'; # anonymous user
use constant DEFAULT_PASS => 'guest'; # anonymous password
use constant DEFAULT_TIMEOUT => 120; # two minute timeout on queries
# header information
use constant HEADER => 'L5a30';
use constant HEADER_LEN => 5*4+30;
use constant ACESERV_MSGREQ => "ACESERV_MSGREQ";
use constant ACESERV_MSGDATA => "ACESERV_MSGDATA";
use constant WORDORDER_MAGIC => 0x12345678;
# Server only, it may just be sending or a reply or it may be sending an
# instruction, such as "operation refused".
use constant ACESERV_MSGOK => "ACESERV_MSGOK";
use constant ACESERV_MSGENCORE => "ACESERV_MSGENCORE";
use constant ACESERV_MSGFAIL => "ACESERV_MSGFAIL";
use constant ACESERV_MSGKILL => "ACESERV_MSGKILL";
use constant ACESERV_CLIENT_HELLO => "bonjour";
Ace/SocketServer.pm view on Meta::CPAN
return 1;
}
sub _send_msg {
my ($self,$msg,$parse) = @_;
return unless my $sock = $self->{socket};
local $SIG{'PIPE'} = 'IGNORE';
$msg .= "\0"; # add terminating null
my $request;
if ($parse) {
$request = ACESERV_MSGDATA;
} else {
$request = $msg eq "encore\0" ? ACESERV_MSGENCORE : ACESERV_MSGREQ;
}
my $header = pack HEADER,WORDORDER_MAGIC,length($msg),0,$self->{client_id},0,$request;
print $sock $header,$msg;
}
sub _recv_msg {
my $self = shift;
my $strip_null = shift;
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
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
my $to = join(", ",@addresses);
print MAIL <<END;
From: $from ($name via ACEDB feedback page)
To: $to
Subject: $subject
Full name: $name
Institution: $institution
Address: $from
DATABASE RECORD: $obj_class: $obj_name
SUBMITTED FROM PAGE: $where_from
COMMENT TEXT:
$remark
END
;
unless (close MAIL) {
AceError($error);
acebrowser/conf/elegans.pm view on Meta::CPAN
$PAGEWIDTH = 660;
# position of the "cross"
$CROSS_ICON = "$WB/images/cross1.gif";
$ARROWR_ICON = "$WB/images/arrow_right.gif";
$ARROWL_ICON = "$WB/images/arrow_left.gif";
# position of neuron diagrams
$NEURON_DIAGRAMS = "$WB/cell/diagrams";
# ======== BLAST DATABASES ===========
# location of BLAST databases
$BLAST_ROOT = '/usr/local/wublast';;
$BLAST_BIN = "$BLAST_ROOT/bin/";
$BLAST_MATRIX = "$BLAST_ROOT/matrix";
$BLAST_FILTER = "$BLAST_ROOT/filter";
$BLAST_DB = "/usr/local/acedb/elegans/blast";
$BLAST_CUTOFF = 0.001;
$BLAST_MAXHITS = 20;
@BLAST_default = ('blastp' => 'WormPep');
%BLAST_labels = ('EST_Elegans' => 'elegans ESTs',
docs/ACEDB.HOWTO view on Meta::CPAN
2) mkdir bin
3) cd ~/acedb (where the source code was compiled)
4) cd bin.LINUX_4 (or whatever)
5) cp xace tace giface saceserver sgifaceserver makeUserPasswd ~acedb/bin/
Now put ~acedb/bin on your path so that the Ace::Local module can find
the giface and tace programs. This usually involves editing .cshrc or
.bashrc to change the PATH variable. (See your system administrator
if you don't know how to do this).
CREATING DATABASES
Each ACeDB database lives in a separate subdirectory, which I
conventionally place under ~acedb/. You will often be installing a
compressed database archive, such as the C. elegans database (see the
NCBI FTP site). In this case, simply unpack the database into the
~acedb/ directory. Programs like xace, tace, and the servers will
refer to the database by its path. Within the database directory
should be the subdirectories databases/, wspec/, wdoc/, wgf/, wquery/,
and possibly others. If not, make sure that you unpacked the database
package correctly.
docs/NEW_DB.HOWTO view on Meta::CPAN
HOW TO START A NEW DATABASE
ACeDB stores its data in a fast-access binary form. Data is
ordinarily loaded and dumped from a human-readable flat-file format
known as .ace. To start a new database, you must:
1) create a database directory containing the following
subdirectories:
wspec/ schema and other files
database/ binary files
######################### End of black magic.
sub test {
local($^W) = 0;
my($num, $true,$msg) = @_;
print($true ? "ok $num\n" : "not ok $num $msg\n");
}
# Test code:
my ($db,$obj,@obj,$lab);
my $DATA = q{Address Mail The Sanger Centre
Hinxton Hall
Hinxton
Cambridge CB10 1SA
U.K.
E_mail jes@sanger.ac.uk
Phone 1223-834244
1223-494958
Fax 1223-494919
};
my @args = (-host=>HOST,-port=>PORT,-timeout=>50);
test(4,defined($obj) && $obj eq 'Sulston JE',"string overload failure");
test(5,@obj = $db->fetch('Author','Sulston*'),"wildcard failure");
test(6,@obj==2,"failed to recover two authors from Sulston*");
test(7,defined($obj) && $obj->right eq 'Also_known_as',"auto fill failure");
test(8,defined($obj) && $obj->Also_known_as eq 'John Sulston',"automatic method generation failure");
test(9,defined($obj) && $obj->Also_known_as->pick eq 'John Sulston',"pick failure");
test(10,defined($obj) && (@obj = $obj->Address(2)) == 9,"col failure");
test(11,defined($obj) && ($lab = $obj->Laboratory),"fetch failure");
test(12,defined($lab) && join(' ',sort($lab->tags)) =~ /^Address CGC Staff$/,"tags failure");
test(13,defined($lab) && $lab->at('CGC.Allele_designation')->at eq 'e',"compound path failure");
test(14,defined($obj) && $obj->Address(0)->asString eq $DATA,"asString() method");
test(15,$db->ping,"can't ping");
test(16,$db->classes,"can't count classes");
test(17,defined($obj) && join(' ',sort $obj->fetch('Laboratory')->tags) =~ /^Address CGC Staff/,"fetch failure");
test(18,defined($obj) && join(' ',$obj->Address(0)->row) eq "Address Mail The Sanger Centre","row() failure");
test(19,defined($obj) && join(' ',$obj->Address(0)->row(1)) eq "Mail The Sanger Centre","row() failure");
test(20,defined($obj) && (@h=$obj->Address(2)),"tag[2] failure");
test(21,defined($obj) && (@h==9),"tag[2] failure");
test(22,$iterator1 = $db->fetch_many('Author','S*'),"fetch_many() failure (1)");
test(23,$iterator2 = $db->fetch_many('Clone','*'),"fetch_many() failure (2)");
test(24,$obj1 = $iterator1->next,"iterator failure (1)");
( run in 0.770 second using v1.01-cache-2.11-cpan-140bd7fdf52 )