AcePerl
view release on metacpan or search on metacpan
*Ace::ERR = *Error;
# now completely deprecated and gone
# *find_many = \&fetch_many;
# *models = \&classes;
sub connect {
my $class = shift;
my ($host,$port,$user,$pass,$path,$program,
$objclass,$timeout,$query_timeout,$database,
$server_type,$url,$u,$p,$cache,$other);
# one-argument single "URL" form
if (@_ == 1) {
return $class->connect(-url=>shift);
}
# multi-argument (traditional) form
($host,$port,$user,$pass,
$path,$objclass,$timeout,$query_timeout,$url,$cache,$other) =
rearrange(['HOST','PORT','USER','PASS',
'PATH',['CLASS','CLASSMAPPER'],'TIMEOUT',
'QUERY_TIMEOUT','URL','CACHE'],@_);
($host,$port,$u,$pass,$p,$server_type) = $class->process_url($url)
or croak "Usage: Ace->connect(-host=>\$host,-port=>\$port [,-path=>\$path]\n"
if defined $url;
if ($path) { # local database
$server_type = 'Ace::Local';
} else { # either RPC or socket server
$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;
}
my $contents = {
'database'=> $database,
'host' => $host,
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) = ('','','','','','');
if ($url) { # look for host:port
local $_ = $url;
if (m!^rpcace://([^:]+):(\d+)$!) { # rpcace://localhost:200005
($host,$port) = ($1,$2);
$server_type = 'Ace::RPC';
} elsif (m!^sace://([\w:]+)\@([^:]+):(\d+)$!) { # sace://user@localhost:2005
($user,$host,$port) = ($1,$2,$3);
$server_type = 'Ace::SocketServer';
} elsif (m!^sace://([^:]+):(\d+)$!) { # sace://localhost:2005
($host,$port) = ($1,$2);
$server_type = 'Ace::SocketServer';
} elsif (m!^tace:(/.+)$!) { # tace:/path/to/database
$path = $1;
$server_type = 'Ace::Local';
} elsif (m!^(/.+)$!) { # /path/to/database
$path = $1;
$server_type = 'Ace::Local';
} else {
return;
}
}
if ($user =~ /:/) {
($user,$pass) = split /:/,$user;
}
return ($host,$port,$user,$pass,$path,$server_type);
}
# Return the low-level Ace::AceDB object
sub db {
return $_[0]->{'database'};
}
# Fetch a model from the database.
# Since there are limited numbers of models, we cache
Name of user to log in as (when using socket server B<only>). If not
provided, will attempt an anonymous login.
=item B<-pass>
Password to log in with (when using socket server).
=item B<-url>
An Acedb URL that combines the server type, host, port, user and
password in a single string. See the connect() method's "single
argument form" description.
=item B<-cache>
AcePerl can use the Cache::SizeAwareFileCache module to cache objects
to disk. This can result in dramatically increased performance in
environments such as web servers in which the same Acedb objects are
frequently reused. To activate this mechanism, the
Cache::SizeAwareFileCache module must be installed, and you must pass
You may perform low-level calls using the Ace client C API by calling
db(). This fetches an Ace::AceDB object. See THE LOW LEVEL C API for
details on using this object.
$low_level = $db->db();
=head2 connect() -- single argument form
$db = Ace->connect('sace://stein.cshl.org:1880')
Ace->connect() also accepts a single argument form using a URL-type
syntax. The general syntax is:
protocol://hostname:port/path
The I<:port> and I</path> parts are protocol-dependent as described
above.
Protocols:
=over 4
By default, parsing will stop at the first object that causes a parse
error. If you wish to forge on after an error, pass a true value as
the second argument to this method.
Any parse error messages are accumulated in Ace->error().
=head2 new() method
$object = $db->new($class => $name);
This method creates a new object in the database of type $class and
name $name. If successful, it returns the newly-created object.
Otherwise it returns undef and sets $db->error().
$name may contain sprintf()-style patterns. If one of the patterns is
%d (or a variant), Acedb uses a class-specific unique numbering to return
a unique name. For example:
$paper = $db->new(Paper => 'wgb%06d');
The object is created in the database atomically. There is no chance to rollback as there is
Ace/Browser/AceSubs.pm view on Meta::CPAN
To bring in a set of optionally routines, load the module with:
use Ace::Browser::AceSubs qw(AceInit AceRedirect);
To bring in all the default subroutines, plus some of the optional
ones:
use Ace::Browser::AceSubs qw(:DEFAULT AceInit AceRedirect);
There are two main types of AceBrowser scripts:
=over 4
=item display scripts
These are called with the CGI parameters b<name> and b<class>,
corresponding to the name and class of an AceDB object to display.
The subroutine GetAceObject() will return the requested object, or
undef if the object does not exist.
Ace/Browser/AceSubs.pm view on Meta::CPAN
$HEADER = 0;
$TOP = 0;
@COOKIES = ();
# 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!
Ace/Browser/AceSubs.pm view on Meta::CPAN
) if $cache_root;
$DB{$name} = Ace->connect(-host=>$host,-port=>$port,-timeout=>50,@auth,@cache);
return $DB{$name};
}
=item PrintTop($object,$class,$title,@html_headers)
The PrintTop() function generates all the boilerplate at the top of a
typical AceBrowser page, including the HTTP header information, the
page title, the navigation bar for searches, the web site banner, the
type selector for choosing alternative displays, and a level-one
header.
Call it with one or more arguments. The arguments are:
$object An AceDB object. The navigation bar and title will be
customized for the object.
$class If no AceDB object is available, then you can pass
a string containing the AceDB class that this page is
designed to display.
Ace/Browser/AceSubs.pm view on Meta::CPAN
if (wantarray ){
return ($link,$OPEN{$section})
} else {
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');
Ace/Browser/SiteDefs.pm view on Meta::CPAN
return $d->{$_[0]} unless defined $_[1];
return $d->{$_[0]}{$_[1]};
}
sub displays {
my $self = shift;
return unless my $d = $self->Classes;
return keys %$d unless @_;
my ($class,$name) = @_;
my $type = ucfirst(lc($class));
return unless exists $d->{$type};
my $value = $d->{$type};
if (ref $value eq 'CODE') { # oh, wow, a subroutine
my @v = $value->($type,$name); # invoke to get list of displays
return wantarray ? @v : \@v;
} else {
return wantarray ? @{$value} : $value;
}
}
sub class2displays {
my $self = shift;
my ($class,$name) = @_;
Ace/Graphics/Glyph.pm view on Meta::CPAN
=item $right = $glyph->right
These methods return the top, left, bottom and right of the glyph in
pixel coordinates.
=item $height = $glyph->height
Returns the height of the glyph. This may be somewhat larger or
smaller than the height suggested by the GlyphFactory, depending on
the type of the glyph.
=item $scale = $glyph->scale
Get the scale for the glyph in pixels/bp.
=item $height = $glyph->labelheight
Return the height of the label, if any.
=item $label = $glyph->label
Ace/Graphics/Glyph/group.pm view on Meta::CPAN
=head1 NAME
Ace::Graphics::Glyph::group - The group glyph
=head1 SYNOPSIS
none
=head1 DESCRIPTION
This is an internal glyph type, used by Ace::Graphics::Track for
moving sets of glyphs around as a group. This glyph is created
automatically when processing a set of features passed to
Ace::Graphics::Panel->new as an array ref.
=head2 OPTIONS
In addition to the common options, the following glyph-specific
options are recognized:
Option Description Default
Ace/Graphics/GlyphFactory.pm view on Meta::CPAN
use strict;
use Carp qw(carp croak confess);
use Ace::Graphics::Glyph;
use GD;
sub DESTROY { }
sub new {
my $class = shift;
my $type = shift;
my @options = @_;
# normalize options
my %options;
while (my($key,$value) = splice (@options,0,2)) {
$key =~ s/^-//;
$options{lc $key} = $value;
}
$options{bgcolor} ||= 'white';
$options{fgcolor} ||= 'black';
$options{fillcolor} ||= 'turquoise';
$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 {
Ace/Graphics/GlyphFactory.pm view on Meta::CPAN
=head2 CONSTRUCTORS
There is only one constructor, the new() method. It is ordinarily
called by Ace::Graphics::Track, in the make_factory() subroutine.
=over 4
=item $factory = Ace::Graphics::GlyphFactory->new($glyph_name,@options)
The new() method creates a new factory object. The object will create
glyphs of type $glyph_name, and using the options specified in
@options. Generic options are described in L<Ace::Graphics::Panel>,
and specific options are described in each of the
Ace::Graphics::Glyph::* manual pages.
=back
=head2 OBJECT METHODS
Once a track is created, the following methods can be invoked:
=over 4
Ace/Graphics/Panel.pm view on Meta::CPAN
my $self = shift;
my $d = $self->{pad_right};
$self->{pad_right} = shift if @_;
$d || 0;
}
sub add_track {
my $self = shift;
# due to indecision, we accept features
# and/or glyph types in the first two arguments
my ($features,$glyph_name) = ([],'generic');
while ( $_[0] !~ /^-/) {
my $arg = shift;
$features = $arg and next if ref($arg);
$glyph_name = $arg and next unless ref($arg);
}
$self->_add_track($glyph_name,$features,+1,@_);
}
sub unshift_track {
my $self = shift;
# due to indecision, we accept features
# and/or glyph types in the first two arguments
my ($features,$glyph_name) = ([],'generic');
while ( (my $arg = shift) !~ /^-/) {
$features = $arg and next if ref($arg);
$glyph_name = $arg and next unless ref($arg);
}
$self->_add_track($glyph_name,$features,-1,@_);
}
sub _add_track {
my $self = shift;
my ($glyph_type,$features,$direction,@options) = @_;
unshift @options,'-offset' => $self->{offset} if defined $self->{offset};
unshift @options,'-length' => $self->{length} if defined $self->{length};
$features = [$features] unless ref $features eq 'ARRAY';
my $track = Ace::Graphics::Track->new($glyph_type,$features,@options);
$track->set_scale(abs($self->length),$self->{width});
$track->panel($self);
if ($direction >= 0) {
push @{$self->{tracks}},$track;
} else {
unshift @{$self->{tracks}},$track;
}
return $track;
}
Ace/Graphics/Panel.pm view on Meta::CPAN
=over 4
=item $track = $panel->add_track($glyph,$features,@options)
The add_track() method adds a new track to the image.
Tracks are horizontal bands which span the entire width of the panel.
Each track contains a number of graphical elements called "glyphs",
each corresponding to a sequence feature. There are different glyph
types, but each track can only contain a single type of glyph.
Options passed to the track control the color and size of the glyphs,
whether they are allowed to overlap, and other formatting attributes.
The height of a track is determined from its contents and cannot be
directly influenced.
The first two arguments are the glyph name and an array reference
containing the list of features to display. The order of the
arguments is irrelevant, allowing either of these idioms:
$panel->add_track(arrow => \@features);
Ace/Graphics/Panel.pm view on Meta::CPAN
spacing() Get/set spacing between tracks
length() Get/set length of segment (bp)
pad_top() Get/set top padding
pad_left() Get/set left padding
pad_bottom() Get/set bottom padding
pad_right() Get/set right padding
=head2 INTERNAL METHODS
The following methods are used internally, but may be useful for those
implementing new glyph types.
=over 4
=item @names = Ace::Graphics::Panel->color_names
Return the symbolic names of the colors recognized by the panel
object. In a scalar context, returns an array reference.
=item @rgb = $panel->rgb($index)
Ace/Graphics/Track.pm view on Meta::CPAN
my $glyphs = $self->{glyphs} or croak "Can't lay out";
return 0 unless @$glyphs;
my ($topmost) = sort { $a->top <=> $b->top } @$glyphs;
my ($bottommost) = sort { $b->bottom <=> $a->bottom } @$glyphs;
return $self->{cache_height} = $bottommost->bottom - $topmost->top;
}
sub make_factory {
my ($class,$type,@options) = @_;
Ace::Graphics::GlyphFactory->new($type,@options);
}
1;
__END__
=head1 NAME
Ace::Graphics::Track - PNG graphics of Ace::Sequence::Feature objects
Ace/Graphics/Track.pm view on Meta::CPAN
$track->add_feature($_);
}
my $boxes = $panel->boxes;
print $panel->png;
=head1 DESCRIPTION
The Ace::Graphics::Track class is used by Ace::Graphics::Panel to lay
out a set of sequence features using a uniform glyph type. You will
ordinarily work with panels rather than directly with tracks.
=head1 METHODS
This section describes the class and object methods for
Ace::Graphics::Panel.
=head2 CONSTRUCTORS
There is only one constructor, the new() method. It is ordinarily
Ace/Graphics/Track.pm view on Meta::CPAN
------------- -----------
scale() Get/set the track scale, measured in pixels/bp
lineheight() Get/set the height of each glyph, pixels
width() Get/set the width of the track
bump() Get/set the bump direction
=head2 INTERNAL METHODS
The following methods are used internally, but may be useful for those
implementing new glyph types.
=over 4
=item $glyphs = $track->layout
Layout the features, and return an anonymous array of
Ace::Graphics::Glyph objects that have been created and correctly
positioned.
Because layout is an expensive operation, calling this method several
Ace/Iterator.pm view on Meta::CPAN
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
efficient than serial access. If possible, avoid this type of code:
my $iterator1 = $db->fetch_many(-query=>$query1);
my $iterator2 = $db->fetch_many(-query=>$query2);
do {
my $object1 = $iterator1->next;
my $object2 = $iterator2->next;
} while $object1 && $object2;
=head1 SEE ALSO
Ace/Object.pm view on Meta::CPAN
my $o = $self->right;
while ($o) {
return ($o->right($pos),$p,$self) if (lc($o) eq lc($tag));
$p = $o;
$o = $o->down;
}
return;
}
# Used to munge special data types. Right now dates are the
# only examples.
sub _ace_format {
my $self = shift;
my ($class,$name) = @_;
return undef unless defined $class && defined $name;
return $class eq 'date' ? $self->_to_ace_date($name) : $name;
}
# It's an object unless it is one of these things
sub _isObject {
Ace/Object.pm view on Meta::CPAN
# Rollback changes
$sequence->rollback()
# Get errors
print $sequence->error;
=head1 DESCRIPTION
I<Ace::Object> is the base class for objects returned from ACEDB
databases. Currently there is only one type of I<Ace::Object>, but
this may change in the future to support more interesting
object-specific behaviors.
Using the I<Ace::Object> interface, you can explore the internal
structure of an I<Ace::Object>, retrieve its content, and convert it
into various types of text representation. You can also fetch a
representation of any object as a GIF image.
If you have write access to the databases, add new data to an object,
replace existing data, or kill it entirely. You can also create a new
object de novo and write it into the database.
For information on connecting to ACEDB databases and querying them,
see L<Ace>.
=head1 ACEDB::OBJECT METHODS
Ace/Object.pm view on Meta::CPAN
How to get ACEDB for your Sun
|
ACEDB is Hungry
Each object in the tree has two pointers, a "right" pointer to the
node on its right, and a "down" pointer to the node beneath it. Right
pointers are used to store hierarchical relationships, such as
Address->Mail->E_mail, while down pointers are used to store lists,
such as the multiple papers written by the Author.
Each node in the tree has a type and a name. Types include integers,
strings, text, floating point numbers, as well as specialized
biological types, such as "dna" and "peptide." Another fundamental
type is "tag," which is a text identifier used to label portions of
the tree. Examples of tags include "Paper" and "Laboratory" in the
example above.
In addition to these built-in types, there are constructed types known
as classes. These types are specified by the data model. In the
above example, "Thierry-Mieg J" is an object of the "Author" class,
and "Genome Project Database" is an object of the "Paper" class. An
interesting feature of objects is that you can follow them into the
database, retrieving further information. For example, after
retrieving the "Genome Project Database" Paper from the Author object,
you could fetch more information about it, either by following B<its>
right pointer, or by using one of the specialized navigation routines
described below.
=head2 new() method
Ace/Object.pm view on Meta::CPAN
print "$object did not write 'Pride and Prejudice.'\n";
=head2 class() method
$class = $object->class();
Return the class of the object. The return value may be one of
"float," "int," "date," "tag," "txt," "dna," "peptide," and "scalar."
(The last is used internally by Perl to represent objects created
programatically prior to committing them to the database.) The class
may also be a user-constructed type such as Sequence, Clone or
Author. These user-constructed types usually have an initial capital
letter.
=head2 db() method
$db = $object->db();
Return the database that the object is associated with.
=head2 isClass() method
Ace/Object.pm view on Meta::CPAN
asXML() returns a well-formed XML representation of the object. The
particular representation is still under discussion, so this feature
is primarily for demonstration.
=head2 asGIF() method
($gif,$boxes) = $object->asGIF();
($gif,$boxes) = $object->asGIF(-clicks=>[[$x1,$y1],[$x2,$y2]...]
-dimensions=> [$width,$height],
-coords => [$top,$bottom],
-display => $display_type,
-view => $view_type,
-getcoords => $true_or_false
);
asGIF() returns the object as a GIF image. The contents of the GIF
will be whatever xace would ordinarily display in graphics mode, and
will vary for different object classes.
You can optionally provide asGIF with a B<-clicks> argument to
simulate the action of a user clicking on the image. The click
coordinates should be formatted as an array reference that contains a
Ace/Object.pm view on Meta::CPAN
You may provide a list of values to add an entire row of data. For
example:
$sequence->add_row('Assembly_tags'=>['Finished Left',38949,38952,'AC3']);
Actually, the array reference is not entirely necessary, and if you
prefer you can use this more concise notation:
$sequence->add_row('Assembly_tags','Finished Left',38949,38952,'AC3');
No check is done against the database model for the correct data type
or tag path. The update isn't actually performed until you call
commit(), at which time a result code indicates whether the database
update was successful.
You may create objects that reference other objects this way:
$lab = new Ace::Object('Laboratory','LM',$db);
$lab->add_row('Full_name','The Laboratory of Medicine');
$lab->add_row('City','Cincinatti');
$lab->add_row('Country','USA');
Ace/Sequence.pm view on Meta::CPAN
use overload
'""' => 'asString',
cmp => 'cmp',
;
# synonym: stop = end
*stop = \&end;
*abs = \&absolute;
*source_seq = \&source;
*source_tag = \&subtype;
*primary_tag = \&type;
my %plusminus = ( '+' => '-',
'-' => '+',
'.' => '.');
# internal keys
# parent => reference Sequence in "+" strand
# p_offset => our start in the parent
# length => our length
# strand => our strand (+ or -)
Ace/Sequence.pm view on Meta::CPAN
return $r_strand;
} else {
return $self->{strand}
}
}
sub offset { $_[0]->{offset} }
sub p_offset { $_[0]->{p_offset} }
sub smapped { 1; }
sub type { 'Sequence' }
sub subtype { }
sub debug {
my $self = shift;
my $d = $self->{_debug};
$self->{_debug} = shift if @_;
$d;
}
# return the database this sequence is associated with
sub db {
Ace/Sequence.pm view on Meta::CPAN
my @lines = grep !/^\/\//,split "\n",$self->gff(@_);
local *IN;
local ($^W) = 0; # prevent complaint by GFF module
tie *IN,'GFF::Filehandle',\@lines;
my $gff = GFF::GeneFeatureSet->new;
$gff->read(\*IN,$filter,$converter) if $gff;
return $gff;
}
# Get the features table. Can filter by type/subtype this way:
# features('similarity:EST','annotation:assembly_tag')
sub features {
my $self = shift;
my ($filter,$opt) = $self->_make_filter(@_);
# get raw gff file
my $gff = $self->gff(-features=>$opt);
# turn it into a list of features
my @features = $self->_make_features($gff,$filter);
if ($self->automerge) { # automatic merging
# fetch out constructed transcripts and clones
my %types = map {lc($_)=>1} (@$opt,@_);
if ($types{'transcript'}) {
push @features,$self->_make_transcripts(\@features);
@features = grep {$_->type !~ /^(intron|exon)$/ } @features;
}
push @features,$self->_make_clones(\@features) if $types{'clone'};
if ($types{'similarity'}) {
my @f = $self->_make_alignments(\@features);
@features = grep {$_->type ne 'similarity'} @features;
push @features,@f;
}
}
return wantarray ? @features : \@features;
}
# A little bit more complex - assemble a list of "transcripts"
# consisting of Ace::Sequence::Transcript objects. These objects
# contain a list of exons and introns.
Ace/Sequence.pm view on Meta::CPAN
sub _make_transcripts {
my $self = shift;
my $features = shift;
require Ace::Sequence::Transcript;
my %transcripts;
for my $feature (@$features) {
my $transcript = $feature->info;
next unless $transcript;
if ($feature->type =~ /^(exon|intron|cds)$/) {
my $type = $1;
push @{$transcripts{$transcript}{$type}},$feature;
} elsif ($feature->type eq 'Sequence') {
$transcripts{$transcript}{base} ||= $feature;
}
}
# get rid of transcripts without exons
foreach (keys %transcripts) {
delete $transcripts{$_} unless exists $transcripts{$_}{exon}
}
# map the rest onto Ace::Sequence::Transcript objects
Ace/Sequence.pm view on Meta::CPAN
}
sub _make_clones {
my $self = shift;
my $features = shift;
my (%clones,@canonical_clones);
my $start_label = $self->strand < 0 ? 'end' : 'start';
my $end_label = $self->strand < 0 ? 'start' : 'end';
for my $feature (@$features) {
$clones{$feature->info}{$start_label} = $feature->start if $feature->type eq 'Clone_left_end';
$clones{$feature->info}{$end_label} = $feature->start if $feature->type eq 'Clone_right_end';
if ($feature->type eq 'Sequence') {
my $info = $feature->info;
next if $info =~ /LINK|CHROMOSOME|\.\w+$/;
if ($info->Genomic_canonical(0)) {
push (@canonical_clones,$info->Clone) if $info->Clone;
}
}
}
foreach (@canonical_clones) {
$clones{$_} ||= {};
Ace/Sequence.pm view on Meta::CPAN
my $phony_gff = join "\t",($parent,'Clone','structural',$start,$end,'.','.','.',qq(Clone "$clone"));
push @features,Ace::Sequence::Feature->new($parent,$r,$r_offset,$r_strand,$abs,$phony_gff);
}
return @features;
}
# Assemble a list of "GappedAlignment" objects. These objects
# contain a list of aligned segments.
sub alignments {
my $self = shift;
my @subtypes = @_;
my @types = map { "similarity:\^$_\$" } @subtypes;
push @types,'similarity' unless @types;
return $self->features(@types);
}
sub segments {
my $self = shift;
return;
}
sub _make_alignments {
my $self = shift;
my $features = shift;
require Ace::Sequence::GappedAlignment;
my %homol;
for my $feature (@$features) {
next unless $feature->type eq 'similarity';
my $target = $feature->info;
my $subtype = $feature->subtype;
push @{$homol{$target,$subtype}},$feature;
}
# map onto Ace::Sequence::GappedAlignment objects
return map {Ace::Sequence::GappedAlignment->new($homol{$_})} keys %homol;
}
# return list of features quickly
sub feature_list {
my $self = shift;
return $self->{'feature_list'} if $self->{'feature_list'};
Ace/Sequence.pm view on Meta::CPAN
return ($tl,$offset,$strand < 0 ? ($length,'-1') : ($length,'+1') ) if $length;
}
sub _get_toplevel {
my $obj = shift;
my $class = $obj->class;
my $name = $obj->name;
my $smap = $obj->db->raw_query("gif smap -from $class:$name");
my ($parent,$pstart,$pstop,$tstart,$tstop,$map_type) =
$smap =~ /^SMAP\s+(\S+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(.+)/;
$parent ||= '';
$parent =~ s/^Sequence://; # remove this in next version of Acedb
return ($parent,$pstart,$pstop);
}
# create subroutine that filters GFF files for certain feature types
sub _make_filter {
my $self = shift;
my $automerge = $self->automerge;
# parse out the filter
my %filter;
foreach (@_) {
my ($type,$filter) = split(':',$_,2);
if ($automerge && lc($type) eq 'transcript') {
@filter{'exon','intron','Sequence','cds'} = ([undef],[undef],[undef],[undef]);
} elsif ($automerge && lc($type) eq 'clone') {
@filter{'Clone_left_end','Clone_right_end','Sequence'} = ([undef],[undef],[undef]);
} else {
push @{$filter{$type}},$filter;
}
}
# create pattern-match sub
my $sub;
my $promiscuous; # indicates that there is a subtype without a type
if (%filter) {
my $s = "sub { my \@d = split(\"\\t\",\$_[0]);\n";
for my $type (keys %filter) {
my $expr;
my $subtypes = $filter{$type};
if ($type ne '') {
for my $st (@$subtypes) {
$expr .= defined $st ? "return 1 if \$d[2]=~/$type/i && \$d[1]=~/$st/i;\n"
: "return 1 if \$d[2]=~/$type/i;\n"
}
} else { # no type, only subtypes
$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 $@;
Ace/Sequence.pm view on Meta::CPAN
=head2 features()
@features = $seq->features;
@features = $seq->features('exon','intron','Predicted_gene');
@features = $seq->features('exon:GeneFinder','Predicted_gene:hand.*');
features() returns an array of I<Sequence::Feature> objects. If
called without arguments, features() returns all features that cross
the sequence region. You may also provide a filter list to select a
set of features by type and subtype. The format of the filter list
is:
type:subtype
Where I<type> is the class of the feature (the "feature" field of the
GFF format), and I<subtype> is a description of how the feature was
derived (the "source" field of the GFF format). Either of these
fields can be absent, and either can be a regular expression. More
advanced filtering is not supported, but is provided by the Sanger
Centre's GFF module.
The order of the features in the returned list is not specified. To
obtain features sorted by position, use this idiom:
@features = sort { $a->start <=> $b->start } $seq->features;
=head2 feature_list()
my $list = $seq->feature_list();
This method returns a summary list of the features that cross the
sequence in the form of a L<Ace::Feature::List> object. From the
L<Ace::Feature::List> object you can obtain the list of feature names
and the number of each type. The feature list is obtained from the
ACeDB server with a single short transaction, and therefore has much
less overhead than features().
See L<Ace::Feature::List> for more details.
=head2 transcripts()
This returns a list of Ace::Sequence::Transcript objects, which are
specializations of Ace::Sequence::Feature. See L<Ace::Sequence::Transcript>
for details.
Ace/Sequence.pm view on Meta::CPAN
Relative coordinates can be reenabled by providing a false value to
B<-abs>.
Ordinarily the coordinate system manipulations automatically "do what
you want" and you will not need to adjust them. See also the abs()
method described below.
=item -features
The B<-features> argument filters the features according to a list of
types and subtypes. The format is identical to the one described for
the features() method. A single filter may be provided as a scalar
string. Multiple filters may be passed as an array reference.
=back
See also the GFF() method described next.
=head2 GFF()
$gff_object = $seq->gff;
Ace/Sequence/Feature.pm view on Meta::CPAN
'-1' => '+1'); # war is peace, &c.
use overload
'""' => 'asString',
;
# parse a line from a sequence list
sub new {
my $pack = shift;
my ($parent,$ref,$r_offset,$r_strand,$abs,$gff_line,$db) = @_;
my ($sourceseq,$method,$type,$start,$end,$score,$strand,$frame,$group) = split "\t",$gff_line;
if (defined($strand)) {
$strand = $strand eq '-' ? '-1' : '+1';
} else {
$strand = 0;
}
# for efficiency/performance, we don't use superclass new() method, but modify directly
# handling coordinates. See SCRAPS below for what should be in here
$strand = '+1' if $strand < 0 && $r_strand < 0; # two wrongs do make a right
($start,$end) = ($end,$start) if $strand < 0;
Ace/Sequence/Feature.pm view on Meta::CPAN
length => $length,
parent => $parent,
p_offset => $r_offset,
refseq => [$ref,$r_offset,$r_strand],
strand => $r_strand,
fstrand => $strand,
absolute => $abs,
info => {
seqname=> $sourceseq,
method => $method,
type => $type,
score => $score,
frame => $frame,
group => $group,
db => $db,
}
},$pack;
return $self;
}
sub smapped { 1; }
Ace/Sequence/Feature.pm view on Meta::CPAN
sub strand { return $_[0]->{fstrand} }
sub seqname {
my $self = shift;
my $seq = $self->_field('seqname');
$self->db->fetch(Sequence=>$seq);
}
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;
my $name = $self->SUPER::asString;
my $type = $self->type;
return "$type:$name";
}
# unique ID
sub id {
my $self = shift;
my $source = $self->source->name;
my $start = $self->start;
my $end = $self->end;
return "$source/$start,$end";
}
Ace/Sequence/Feature.pm view on Meta::CPAN
$seq = Ace::Sequence->new(-name => 'CHROMOSOME_I,
-db => $db,
-offset => 3_000_000,
-length => 1_000_000);
# get all the homologies (a list of Ace::Sequence::Feature objs)
@homol = $seq->features('Similarity');
# Get information about the first one
$feature = $homol[0];
$type = $feature->type;
$subtype = $feature->subtype;
$start = $feature->start;
$end = $feature->end;
$score = $feature->score;
# Follow the target
$target = $feature->info;
# print the target's start and end positions
print $target->start,'-',$target->end, "\n";
Ace/Sequence/Feature.pm view on Meta::CPAN
Return the ACeDB Sequence object that this feature is attached to.
The return value is an I<Ace::Object> of the Sequence class. This
corresponds to the first field of the GFF format and does not
necessarily correspond to the I<Ace::Sequence> object from which the
feature was obtained (use source_seq() for that).
=item source()
=item method()
=item subtype()
$source = $feature->source;
These three methods are all synonyms for the same thing. They return
the second field of the GFF format, called "source" in the
documentation. This is usually the method or algorithm used to
predict the feature, such as "GeneFinder" or "tRNA" scan. To avoid
ambiguity and enhance readability, the method() and subtype() synonyms
are also recognized.
=item feature()
=item type()
$type = $feature->type;
These two methods are also synonyms. They return the type of the
feature, such as "exon", "similarity" or "Predicted_gene". In the GFF
documentation this is called the "feature" field. For readability,
you can also use type() to fetch the field.
=item abs_start()
$start = $feature->abs_start;
This method returns the absolute start of the feature within the
sequence segment indicated by seqname(). As in the I<Ace::Sequence>
method, use start() to obtain the start of the feature relative to its
source.
Ace/Sequence/Feature.pm view on Meta::CPAN
=item group()
=item info()
=item target()
$info = $feature->info;
These methods (synonyms for one another) return an Ace::Object
containing other information about the feature derived from the 8th
field of the GFF format, the so-called "group" field. The type of the
Ace::Object is dependent on the nature of the feature. The
possibilities are shown in the table below:
Feature Type Value of Group Field
------------ --------------------
note A Text object containing the note.
similarity An Ace::Sequence::Homology object containing
the target and its start/stop positions.
Ace/Sequence/Feature.pm view on Meta::CPAN
other A Text object containing the group data.
=item asString()
$label = $feature->asString;
Returns a human-readable identifier describing the nature of the
feature. The format is:
$type:$name/$start-$end
for example:
exon:ZK154.3/1-67
This method is also called automatically when the object is treated in
a string context.
=back
Ace/Sequence/Feature.pm view on Meta::CPAN
=cut
__END__
# SCRAPS
# the new() code done "right"
# sub new {
# my $pack = shift;
# my ($ref,$r_offset,$r_strand,$gff_line) = @_;
# my ($sourceseq,$method,$type,$start,$end,$score,$strand,$frame,$group) = split "\t";
# ($start,$end) = ($end,$start) if $strand < 0;
# my $self = $pack->SUPER::new($source,$start,$end);
# $self->{info} = {
# seqname=> $sourceseq,
# method => $method,
# type => $type,
# score => $score,
# frame => $frame,
# group => $group,
# };
# $self->{fstrand} = $strand;
# return $self;
# }
Ace/Sequence/FeatureList.pm view on Meta::CPAN
next if m!^//!;
my ($minor,$major,$count) = split "\t";
next unless $count > 0;
$parsed{$major}{$minor} += $count;
$parsed{_TOTAL} += $count;
}
return bless \%parsed,$package;
}
# no arguments, scalar context -- count all features
# no arguments, array context -- list of major types
# 1 argument, scalar context -- count of major type
# 1 argument, array context -- list of minor types
# 2 arguments -- count of subtype
sub types {
my $self = shift;
my ($type,$subtype) = @_;
my $count = 0;
unless ($type) {
return wantarray ? grep !/^_/,keys %$self : $self->{_TOTAL};
}
unless ($subtype) {
return keys %{$self->{$type}} if wantarray;
foreach (keys %{$self->{$type}}) {
$count += $self->{$type}{$_};
}
return $count;
}
return $self->{$type}{$subtype};
}
# human-readable summary table
sub asString {
my $self = shift;
my ($type,$subtype);
for my $type ( sort $self->types() ) {
for my $subtype (sort $self->types($type) ) {
print join("\t",$type,$subtype,$self->{$type}{$subtype}),"\n";
}
}
}
1;
=head1 NAME
Ace::Sequence::FeatureList - Lightweight Access to Features
Ace/Sequence/FeatureList.pm view on Meta::CPAN
# 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);
# find out what's there
$list = $seq->feature_list;
# Scalar context: count all the features
$feature_count = $list->types;
# Array context: list all the feature types
@feature_types = $list->types;
# Scalar context, 1 argument. Count this type
$gene_cnt = $list->types('Predicted_gene');
print "There are $gene_cnt genes here.\n";
# Array context, 1 argument. Get list of subtypes
@subtypes = $list->types('Predicted_gene');
# Two arguments. Count type & subtype
$genefinder_cnt = $list->types('Predicted_gene','genefinder');
=head1 DESCRIPTION
I<Ace::Sequence::FeatureList> is a small class that provides
statistical information about sequence features. From it you can
obtain summary counts of the features and their types within a
selected region.
=head1 OBJECT CREATION
You will not ordinarily create an I<Ace::Sequence::FeatureList> object
directly. Instead, objects will be created by calling a
I<Ace::Sequence> object's feature_list() method. If you wish to
create an I<Ace::Sequence::FeatureList> object directly, please consult
the source code for the I<new()> method.
=head1 OBJECT METHODS
There are only two methods in I<Ace::Sequence::FeatureList>.
=over 4
=item type()
This method has five distinct behaviors, depending on its context and
the number of parameters. Usage should be intuitive
Context Arguments Behavior
------- --------- --------
scalar -none- total count of features in list
array -none- list feature types (e.g. "exon")
scalar type count features of this type
array type list subtypes of this type
-any- type,subtype count features of this type & subtype
For example, this code fragment will count the number of exons present
on the list:
$exon_count = $list->type('exon');
This code fragment will count the number of exons found by "genefinder":
$predicted_exon_count = $list->type('exon','genefinder');
This code fragment will print out all subtypes of "exon" and their
counts:
for my $subtype ($list->type('exon')) {
print $subtype,"\t",$list->type('exon',$subtype),"\n";
}
=item asString()
print $list->asString;
This dumps the list out in tab-delimited format. The order of columns
is type, subtype, count.
=back
=head1 SEE ALSO
L<Ace>, L<Ace::Object>, L<Ace::Sequence>,
L<Ace::Sequence::Feature>, L<GFF>
=head1 AUTHOR
Ace/Sequence/GappedAlignment.pm view on Meta::CPAN
segments => $segments,
},$class;
}
sub smapped { 1; }
sub asString {
shift->{base}->info;
}
sub type { return 'similarity'; }
sub relative {
my $self = shift;
my $d = $self->{relative};
$self->{relative} = shift if @_;
$d;
}
sub segments {
my $self = shift;
Ace/Sequence/Multi.pm view on Meta::CPAN
-length => 1_000_000);
# add the secondary databases
$seq->add_secondary($db1,$db2);
# get all the homologies (a list of Ace::Sequence::Feature objs)
@homol = $seq->features('Similarity');
# Get information about the first one -- goes to the correct db
$feature = $homol[0];
$type = $feature->type;
$subtype = $feature->subtype;
$start = $feature->start;
$end = $feature->end;
$score = $feature->score;
# Follow the target
$target = $feature->info;
# print the target's start and end positions
print $target->start,'-',$target->end, "\n";
Ace/Sequence/Transcript.pm view on Meta::CPAN
# cds => $cds,},$class;
}
sub smapped { 1; }
sub asString {
shift->{base}->info;
}
sub type {
return 'Transcript';
}
sub relative {
my $self = shift;
my $d = $self->{relative};
$self->{relative} = shift if @_;
$d;
}
Freesubs/Makefile.PL view on Meta::CPAN
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'Ace::Freesubs',
'VERSION_FROM' => 'Freesubs.pm', # finds $VERSION
'LIBS' => ['-lc'],
'DEFINE' => '',
'OBJECT' => '$(O_FILES)',
'XS' => { 'Freesubs.xs' => 'Freesubs.c' },
'XSPROTOARG' => '-noprototypes',
);
examples/gif.pl
examples/sequence.pl
examples/upstream.pl
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)
--- #YAML:1.0
name: AcePerl
version: 1.92
abstract: ~
license: ~
author: ~
generated_by: ExtUtils::MakeMaker version 6.44
distribution_type: module
requires:
Cache::Cache: 1.03
Digest::MD5: 2
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
Makefile.PL view on Meta::CPAN
setup_sitedefs() if prompt("Do you want to install Ace::Browser? ","n") =~ /[yY]/;
my $headers = "./acelib/wh";
WriteMakefile(
'DISTNAME' => 'AcePerl',
'NAME' => 'Ace',
'VERSION_FROM' => 'Ace.pm', # finds $VERSION
'PMLIBDIRS' => ['GFF','Ace'],
'DIR' => \@extlib,
'DEFINE' => '',
'XSPROTOARG' => '-noprototypes',
'INC' => "-I$headers",
PREREQ_PM => {
'Digest::MD5' => 2.0,
'Cache::Cache' => 1.03,
},
'dist' => {'COMPRESS'=>'gzip -9f',
'SUFFIX' => 'gz',
'ZIP'=>'/usr/bin/zip','ZIPFLAGS'=>'-rl'
},
PL_FILES => {'make_docs.PLS' => '.docs',
The script will also ask you whether you wish to install support for the
AceBrowser Web server extensions. Only answer yes if you are installing
on a machine that already runs a web server and you wish to have AceBrowser
installed. If you answer in the affirmative, then you will be asked a number
of directory configuration questions. See README.ACEBROWSER for more details
on installation.
At this point, Makefile.PL will create the make files necessary to build
AcePerl. Among other things, the Makefile.PL script will attempt
to guess the type of your machine and its operating system. This information
is needed to select the correct makefile in the ACEDB library
directory, AcePerl-X.XX/ace/.
If AcePerl fails to make correctly later in the process, it may be
because the script guessed wrong. You can override this guess by
setting the machine type using the ACEDB_MACHINE environment
variable. On a C-shell or TC-shell machine, use a command like
this one:
setenv ACEDB_MACHINE ALPHA_4_GCC; perl Makefile.PL
On a Bourne-shell or Korn-shell system, use:
ACEDB_MACHINE=ALPHA_4_GCC; export ACEDB_MACHINE
perl Makefile.PL
README.ACEBROWSER view on Meta::CPAN
'label' => 'Tree Display',
'icon' => '/ico/text.gif' },
pic => {
'url' => "generic/pic",
'label' => 'Graphic Display',
'icon' => '/ico/image2.gif' },
);
As described in EXTENDING ACEBROWSER, the %DISPLAYS hash declares a
set of pages, or "displays", to be used for displaying certain Ace
object types.
%CLASSES = (
Default => [ qw/tree pic/ ],
);
As described in EXTENDING ACEBROWSER, the %CLASSES hash describes how
Acedb classes correspond to displays.
sub URL_MAPPER {
my ($display,$name,$class) = @_;
README.ACEBROWSER view on Meta::CPAN
each object has a class, such as "Sequence". Acebrowser takes
advantage of this object structure by allowing you to assign one or
more displays to a class. Each display is a CGI script that fetches
the desired object from the database, formats it, and displays it as
HTML or an image.
Whenever Acebrowser is called upon to display an object, it consults
the configuration file to determine what displays are registered for
the object, and then presents a row of display names across the top of
the window. In Acebrowser jargon, this line of displays is called the
"type selector." The user can change the display to use by selecting
the corresponding link.
Three generic displays, which will work with all databases, come with
Acebrowser:
tree an HTML representation of the Acedb object which
presents the object in the form of a collapsible outline.
xml an XML representation of the Acedb object
README.ACEBROWSER view on Meta::CPAN
url => "/cgi-bin/ace/newscript",
label => 'New Display',
icon => '/ico/layout.gif',
},
The hash key, in this case "newdisplay", is a symbolic name for the
display. It can correspond to the acual name of the CGI script, or
not. The hash value is itself an anonymous hash containing the
required keys "url" and "label", and the optional key "icon". "url"
gives the path to the script that will display, and "label" gives a
human readable label for the link that Acebrowser puts in the type
selector. The "icon" key, if present, will display the indicated icon
in the type selector.
3. Bind this display to the class (or classes) for which this display
is valid, by adding an entry to the %CLASSES array. For example:
NewObject => ['newdisplay'],
This indicates that whenever Acebrowser is called upon to display an
object of type "NewObject", it will display the object using the CGI
script designated by the "newdisplay" display. If you have several
displays that are appropriate for a class, you can bind them all to
the class in the following fashion:
NewObject => ['newdisplay','newerdisplay','newestdisplay'],
When creating a link for an Acedb object, Acebrowser will choose the
first display in the array. When the object is displayed, all three
of the alternative displays will appear in the type selector.
More information on writing display scripts can be found in the
documentation for Ace::Browser::AceSubs. From the command line, run:
perldoc Ace::Browser::AceSubs
Writing New Searches
--------------------
To create a new search,
RPC/Makefile.PL view on Meta::CPAN
$headers = "../acelib/wh";
WriteMakefile(
'NAME' => 'Ace::RPC',
'VERSION_FROM' => 'RPC.pm', # finds $VERSION
'DEFINE' => '',
'MYEXTLIB' => '../acelib/libaceperl.a',
'LIBS' => ['-lc'],
'OBJECT' => '$(O_FILES)',
'XSPROTOARG' => '-noprototypes',
'XS' => { 'RPC.xs' => 'RPC.c' },
'INC' => "-I$headers",
);
sub MY::postamble {
my $definition = guess_definition();
warn "Using $definition definitions to build ace library.\n";
"
\$(MYEXTLIB): ../acelib/Makefile
cd ../acelib && \$(MAKE) ACEDB_MACHINE=$definition all
#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
int
status(self)
AceDB* self
CODE:
RETVAL = self->status;
OUTPUT:
RETVAL
int
query(self,request, type=0)
AceDB* self
char* request
int type
PREINIT:
unsigned char* answer = NULL;
int retval,length,isWrite=0,isEncore=0;
CODE:
if (type == ACE_PARSE)
isWrite = 1;
else if (type > 0)
isEncore = 1;
retval = askServerBinary(self->database,request,
&answer,&length,&isEncore,CHUNKSIZE);
if (self->answer) {
free((void*) self->answer);
self->answer = NULL;
}
self->errcode = retval;
self->status = STATUS_WAITING;
if ((retval > 0) || (answer == NULL) ) {
acebrowser/cgi-bin/generic/model view on Meta::CPAN
# 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;
my ($model) = $db->fetch(Model=>"?$class");
unless ($model) {
AceError("No model of type ?$class found");
PrintBottom();
exit 0;
}
print_tree($model);
PrintBottom();
exit 0;
sub print_tree {
acebrowser/cgi-bin/searches/basic view on Meta::CPAN
} else {
($objs,$count) = do_search($search_class,$search_pattern || '*',$offset);
}
param('query' => param('query') . '*') if !$count && param('query') !~ /\*$/; #autoadd
}
DoRedirect(@$objs) if $count==1;
PrintTop(undef,undef,img({-src=>SEARCH_ICON,-align=>CENTER}).'Simple Search');
print p({-class=>'small'},
"Select the type of object you are looking for and optionally",
"type in a name or a wildcard pattern",
"(? for any one character. * for zero or more characters).",
"If no name is entered, the search displays all objects of the selected type.",
i('Anything'),'searches for the entered text across the entire database.');
display_search_form();
display_search($objs,$count,$offset,$search_class) if $search_class;
PrintBottom();
sub display_search_form {
acebrowser/cgi-bin/searches/browser view on Meta::CPAN
my (@objs) = $DB->fetch(-class=>$class,-pattern=>$pattern,
-count=>MAXOBJECTS,-offset=>$offset,
-total=>\$count);
return unless @objs;
return (\@objs,$count);
}
sub display_search {
my ($objs,$count,$offset,$class,$pattern) = @_;
my $title;
$title = $count > 0 ? p(strong($count),"objects of type",strong($class),"contain pattern",strong($pattern))
:p({-class=>'error'},'No matching objects found');
my @objects = map { ObjectLink($_) } @$objs;
AceResultsTable(\@objects,$count,$offset,$title);
}
acebrowser/cgi-bin/searches/text view on Meta::CPAN
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();
$URL=~s!^http://[^/]+!!;
# fetch database handle
$DB = OpenDatabase() || AceError("Couldn't open database.");
my ($objs,$count);
($objs,$count) = do_search($pattern,$offset,$search_type) if $pattern;
DoRedirect(@$objs) if $count==1;
PrintTop(undef,undef,'AceDB Text Search');
display_search_form();
display_search($objs,$count,$offset,$pattern) if $pattern;
PrintBottom();
exit 0;
sub display_search_form {
acebrowser/cgi-bin/searches/text view on Meta::CPAN
print
start_form,
table(
TR(
td("Search text: "),
td(textfield(-name=>'query',-size=>40)),
td(submit(-label=>'Search'))),
TR(
td(),
td({-colspan=>2},
radio_group(-name=>'type',
-value=>[qw/short long/],
-labels=>{'short'=>'Fast search',
'long' =>'In-depth search'}
)
)
)
),
end_form;
}
sub do_search {
my ($pattern,$offset,$type) = @_;
my $count;
my (@objs) = $DB->grep(-pattern=> $pattern,
-count => MAXOBJECTS,
-offset => $offset,
-total => \$count,
-long => $type eq 'long',
);
return unless @objs;
return (\@objs,$count);
}
sub display_search {
my ($objs,$count,$offset,$pattern) = @_;
my $title = p(strong($count),"objects contain the keywords \"$pattern\"");
if(!$objs) {
print "<b>No matches were found.</b><p>\n";
acebrowser/conf/default.pm view on Meta::CPAN
# ========= %CLASSES =========
# displays to show
%CLASSES = (
# default is a special "dummy" class to fall back on
Default => [ qw/tree pic model xml/ ],
);
# ========= &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);
( run in 2.740 seconds using v1.01-cache-2.11-cpan-df04353d9ac )