AcePerl
view release on metacpan or search on metacpan
$result;
}
# Return a hash of all the classes and the number of objects in each
sub class_count {
my $self = shift;
return $self->raw_query('classes') =~ /^\s+(\S+) (\d+)/gm;
}
# Return a hash of miscellaneous status information from the server
# (to be expanded later)
sub status {
my $self = shift;
my $data = $self->raw_query('status');
study $data;
my %status;
# -Code section
my ($program) = $data=~/Program:\s+(.+)/m;
my ($aceversion) = $data=~/Version:\s+(.+)/m;
Ace/Browser/AceSubs.pm view on Meta::CPAN
$object_count The number of objects that opening the section will reveal
$add_plural If true, the label will be pluralized when
appropriate
$add_count If true, the label will have the object count added
when appropriate
In a scalar context, Toggle() prints the link HTML and returns a
boolean flag. A true result indicates that the section is expanded
and should be generated. A false result indicates that the section is
collapsed.
In a list context, Toggle() returns a two-element list. The first
element is the HTML link that expands and contracts the section. The
second element is a boolean that indicates whether the section is
currently open or closed.
This example indicates typical usage:
my $sequence = GetAceObject();
print "sequence name = ",$sequence,"\n";
print "sequence clone = ",$sequence->Clone,"\n";
if (Toggle('dna','Sequence DNA')) {
print $sequence->asDNA;
Ace/Browser/TreeSubs.pm view on Meta::CPAN
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(OPENCOLOR CLOSEDCOLOR MAXEXPAND
AceImageHackURL);
@EXPORT_OK = ();
%EXPORT_TAGS = ();
# 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.
Ace/Local.pm view on Meta::CPAN
$prompt = "acedb\@$host> ";
} else {
$program ||= 'giface';
}
if ($program =~ /aceclient/) {
$host ||= DEFAULT_HOST;
$port ||= DEFAULT_PORT;
$args = "$host -port $port";
} else {
$path ||= DEFAULT_DB;
$path = _expand_twiddles($path);
$args = $path;
}
my($rdr,$wtr) = (gensym,gensym);
my($pid) = open2($rdr,$wtr,"$program $args");
unless ($pid) {
$Ace::Error = <$rdr>;
return undef;
}
Ace/Local.pm view on Meta::CPAN
# never get here
}
# just throw away everything
sub synch {
my $self = shift;
$self->read() while $self->status == STATUS_PENDING;
}
# expand ~foo syntax
sub _expand_twiddles {
my $path = shift;
my ($to_expand,$homedir);
return $path unless $path =~ m!^~([^/]*)!;
if ($to_expand = $1) {
$homedir = (getpwnam($to_expand))[7];
} else {
$homedir = (getpwuid($<))[7];
}
return $path unless $homedir;
$path =~ s!^~[^/]*!$homedir!;
return $path;
}
__END__
Ace/Model.pm view on Meta::CPAN
package Ace::Model;
# file: Ace/Model.pm
# This is really just a placeholder class. It doesn't do anything interesting.
use strict;
use vars '$VERSION';
use Text::Tabs 'expand';
use overload
'""' => 'asString',
fallback => 'TRUE';
$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)$];
Ace/Model.pm view on Meta::CPAN
# at this point, @paths contains a list of paths to each terminal tag
foreach (@paths) {
my $tag = pop @{$_};
$self->{path}{lc($tag)} = $_;
}
}
sub _untabulate {
my $self = shift;
my @lines = split "\n",$self->{raw};
return expand(@lines);
}
# return true if the tag is a valid one
sub valid_tag {
my $self = shift;
my $tag = lc shift;
return $self->tags->{$tag};
}
# just return the model as a string
Ace/Object.pm view on Meta::CPAN
# for insertion. Also need to link them together into a row.
my $previous;
foreach (@values) {
if (ref($_) && $_->isa('Ace::Object')) {
$_ = $_->_clone;
} else {
$_ = $self->new('scalar',$_);
}
$previous->{'.right'} = $_ if defined $previous;
$previous = $_;
$_->{'.right'} = undef; # make sure it doesn't automatically expand!
}
# position at the indicated tag (creating it if necessary)
my (@tags) = $self->_split_tags($tag);
my $p = $self;
foreach (@tags) {
$p = $p->_insert($_);
}
if ($p->{'.right'}) {
$p = $p->{'.right'};
Makefile.PL view on Meta::CPAN
chmod go+rwx $html_path/images
';
}
END
print qq(\n*** After "make install", run "make install-browser" to install acebrowser files. ***\n\n);
}
sub get_path {
my ($description,$pathref) = @_;
$$pathref = expand_twiddles(prompt("Directory for the $description (~username ok):",$$pathref));
return if -d $$pathref;
return if prompt("$$pathref does not exist. Shall I create it for you?",'y') !~ /[yY]/;
mkpath($$pathref) or warn "Couldn't create $$pathref. Please create it before installing.\n";
}
sub expand_twiddles {
my $path = shift;
my ($to_expand,$homedir);
return $path unless $path =~ m!^~([^/]*)!;
if ($to_expand = $1) {
$homedir = (getpwnam($to_expand))[7];
} else {
$homedir = (getpwuid($<))[7];
}
return $path unless $homedir;
$path =~ s!^~[^/]*!$homedir!;
return $path;
}
acebrowser/cgi-bin/generic/model view on Meta::CPAN
return ($obj,0);
}
# if we get here, we're dealing with an object or tag
my $name = $obj->name;
# modperl screws up with subroutine references for some reason
my $page_name = param('name');
my $page_class = param('class');
my %squash = map { $_ => 1; } grep($_ ne '',param('squash'));
my %expand = map { $_ => 1; } grep($_ ne '',param('expand'));
my ($n,$c) = (escape($name),escape($obj->class));
my ($pn,$pc) = (escape($page_name),escape($page_class));
my $cnt = $obj->col;
my $title = $name;
if ($cnt > 1) {
if ($squash{$name} || ($cnt > MAXEXPAND && !$expand{$name})) {
my $to_squash = join('&squash=',map { escape($_) } grep $name ne $_,keys %squash);
my $to_expand = join('&expand=',map { escape($_) } (keys %expand,$name));
return (a({-href=>url(-relative=>1,-path_info=>1)
. "?name=$pn&class=$pc"
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>CLOSEDCOLOR},"$title ($cnt)"))),
1);
} else {
my $to_squash = join('&squash=',map { escape($_) } (keys %squash,$name));
my $to_expand = join('&expand=',map { escape($_) } grep $name ne $_,keys %expand);
return (a({-href=>url(-relative=>1,-path_info=>1)
. "?name=$pn&class=$pc"
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>OPENCOLOR},"$title"))),
0);
}
}
return i($title) if $obj->isComment;
acebrowser/cgi-bin/generic/tree view on Meta::CPAN
return ($obj,0);
}
# if we get here, we're dealing with an object or tag
my $name = $obj->name;
# modperl screws up with subroutine references for some reason
my $page_name = param('name');
my $page_class = param('class');
my %squash = map { $_ => 1; } grep($_ ne '',param('squash'));
my %expand = map { $_ => 1; } grep($_ ne '',param('expand'));
my ($n,$c) = (escape($name),escape($obj->class));
my ($pn,$pc) = (escape($page_name),escape($page_class));
my $cnt = $obj->col;
# here's a hack case for external images
if ($obj->isTag && $name eq 'Pick_me_to_call' && $obj->right(2)=~/\.(jpg|jpeg|gif)$/i) {
return (td({-colspan=>2},img({-src=>AceImageHackURL($obj->right(2))})),1,1);
}
my $title = $name;
if ($cnt > 1) {
if ($squash{$name} || ($cnt > MAXEXPAND && !$expand{$name})) {
my $to_squash = join('&squash=',map { escape($_) } grep $name ne $_,keys %squash);
my $to_expand = join('&expand=',map { escape($_) } (keys %expand,$name));
return (a({-href=>Url(url(-relative=>1),"name=$pn&class=$pc")
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>CLOSEDCOLOR},"$title ($cnt)"))),
1);
} else {
my $to_squash = join('&squash=',map { escape($_) } (keys %squash,$name));
my $to_expand = join('&expand=',map { escape($_) } grep $name ne $_,keys %expand);
return (a({-href=>Url(url(-relative=>1), "name=$pn&class=$pc")
. ($to_squash ? "&squash=$to_squash" : '')
. ($to_expand ? "&expand=$to_expand" : '')
. "#$name",
-name=>"$name",
-target=>"_self"},
b(font({-color=>OPENCOLOR},"$title"))),
0);
}
}
return i($title) if $obj->isComment;
acelib/helpsubs.c view on Meta::CPAN
}
return NULL; /* failure - no file found */
} /* helpSubjectGetFilename */
/************************************************************/
/* helpPackage utility to find out the filename of a given
link reference. Absolute filenames are returned unchanged,
but relative filenames are expanded to be the full path
of the helpfile. Can be used for html/gif files referred to
by the HREF of anchor tags or the SRC or IMG tags */
/* NOTE: the pointer returned is a static copy, which is
re-used everytime it is called. If the calling function
wants to mess about with the returned string, a copy
has to be made.
NULL is returned if the resulting file can't be opened.
the calling function can inspect the result of
messSysErrorText(), the report the resaon for failure */
install.PLS view on Meta::CPAN
$file .= $^O eq 'VMS' ? '.com' : '.pls';
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl} -w
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
use strict;
use File::Copy 'cp';
use IO::Dir;
my $source = shift;
my $dest = shift;
util/ace.PLS view on Meta::CPAN
$file .= $^O eq 'VMS' ? '.com' : '.pl';
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl} -w
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
# Simple interface to acedb.
# Uses readline for command-line editing if available.
use Ace;
use Getopt::Long;
use Text::ParseWords;
use strict vars;
use vars qw/@CLASSES @HELP_TOPICS/;
use constant DEBUG => 0;
util/install.PLS view on Meta::CPAN
$file .= $^O eq 'VMS' ? '.com' : '.pl';
open OUT,">$file" or die "Can't create $file: $!";
print "Extracting $file (with variable substitutions)\n";
print OUT <<"!GROK!THIS!";
$Config{startperl} -w
!GROK!THIS!
# In the following, perl variables are not expanded during extraction.
print OUT <<'!NO!SUBS!';
use strict;
use File::Copy 'copy';
use IO::Dir;
my $source = shift or exit 0;
my $dest = shift or exit 0;
( run in 1.312 second using v1.01-cache-2.11-cpan-97f6503c9c8 )