AcePerl
view release on metacpan or search on metacpan
}
$self->fetch($1 => $2);
}
# perform an AQL query
sub aql {
my $self = shift;
my $query = shift;
my $db = $self->db;
my $r = $self->raw_query("aql -j $query");
if ($r =~ /(AQL error.*)/) {
$self->error($1);
return;
}
my @r;
foreach (split "\n",$r) {
next if m!^//!;
next if m!^\0!;
my ($class,$id) = Ace->split($_);
my @objects = map { $self->class_for($class,$id)->new(Ace->split($_),$self,1)} split "\t";
push @r,\@objects;
}
}
# do a query, and return the result immediately
sub raw_query {
my ($self,$query,$no_alert,$parse) = @_;
$self->_alert_iterators unless $no_alert;
$self->{database}->query($query, $parse ? ACE_PARSE : () );
return $self->read_object;
}
# return the last error
sub error {
my $class = shift;
$Ace::Error = shift() if defined($_[0]);
$Ace::Error=~s/\0//g; # get rid of nulls
return $Ace::Error;
}
# close the database
sub close {
my $self = shift;
$self->raw_query('save') if $self->auto_save;
while ($obj = $ready->next) {
# do something with obj
}
# database cut and paste
$sequence = $db->fetch(Sequence => 'D12345');
$local_db->put($sequence);
@sequences = $db->fetch(Sequence => 'D*');
$local_db->put(@sequences);
# Get errors
print Ace->error;
print $db->error;
=head1 DESCRIPTION
AcePerl provides an interface to the ACEDB object-oriented database.
Both read and write access is provided, and ACE objects are returned
as similarly-structured Perl objects. Multiple databases can be
opened simultaneously.
You will interact with several Perl classes: I<Ace>, I<Ace::Object>,
I<Ace::Iterator>, I<Ace::Model>. I<Ace> is the database accessor, and
-class Ace::Object
-timeout 25
-query_timeout 120
If you prefer to use a more Smalltalk-like message-passing syntax, you
can open a connection this way too:
$db = connect Ace -host=>'beta.crbm.cnrs-mop.fr',-port=>20000100;
The return value is an Ace handle to use to access the database, or
undef if the connection fails. If the connection fails, an error
message can be retrieved by calling Ace->error.
You may check the status of a connection at any time with ping(). It
will return a true value if the database is still connected. Note
that Ace will timeout clients that have been inactive for any length
of time. Long-running clients should attempt to reestablish their
connection if ping() returns false.
$db->ping() || die "not connected";
You may perform low-level calls using the Ace client C API by calling
In the examples below, the first line of code will fetch the Sequence
object whose database ID is I<D12345>. The second line will retrieve
all objects matching the pattern I<D1234*>. The third line will
return the count of objects that match the same pattern.
$object = $db->fetch(Sequence => 'D12345');
@objects = $db->fetch(Sequence => 'D1234*');
$cnt = $db->fetch(Sequence =>'D1234*');
A variety of communications and database errors may occur while
processing the request. When this happens, undef or an empty list
will be returned, and a string describing the error can be retrieved
by calling Ace->error.
When retrieving database objects, it is possible to retrieve a
"filled" or an "unfilled" object. A filled object contains the entire
contents of the object, including all tags and subtags. In the case
of certain Sequence objects, this may be a significant amount of data.
Unfilled objects consist just of the object name. They are filled in
from the database a little bit at a time as tags are requested. By
default, fetch() returns the unfilled object. This is usually a
performance win, but if you know in advance that you will be needing
the full contents of the retrieved object (for example, to display
=head2 aql() method
$count = $db->aql($aql_query);
@objects = $db->aql($aql_query);
Ace::aql() will perform an AQL query on the database. In a scalar
context it returns the number of rows returned. In an array context
it returns a list of rows. Each row is an anonymous array containing
the columns returned by the query as an Ace::Object.
If an AQL error is encountered, will return undef or an empty list and
set Ace->error to the error message.
Note that this routine is not optimized -- there is no iterator
defined. All results are returned synchronously, leading to large
memory consumption for certain queries.
=head2 put() method
$cnt = $db->put($obj1,$obj2,$obj3);
This method will put the list of objects into the database,
overwriting like-named objects if they are already there. This can
be used to copy an object from one database to another, provided that
the models are compatible.
The method returns the count of objects successfully written into the
database. In case of an error, processing will stop at the last
object successfully written and an error message will be placed in
Ace->error();
=head2 parse() method
$object = $db->parse('data to parse');
This will parse the Ace tags contained within the "data to parse"
string, convert it into an object in the databse, and return the
resulting Ace::Object. In case of a parse error, the undefined value
will be returned and a (hopefully informative) description of the
error will be returned by Ace->error().
For example:
$author = $db->parse(<<END);
Author : "Glimitz JR"
Full_name "Jonathan R. Glimitz"
Mail "128 Boylston Street"
Mail "Boston, MA"
Mail "USA"
Laboratory GM
This method can also be used to parse several objects, but only the
last object successfully parsed will be returned.
=head2 parse_longtext() method
$object = $db->parse($title,$text);
This will parse the long text (which may contain carriage returns and
other funny characters) and place it into the database with the given
title. In case of a parse error, the undefined value will be returned
and a (hopefully informative) description of the error will be
returned by Ace->error(); otherwise, a LongText object will be returned.
For example:
$author = $db->parse_longtext('A Novel Inhibitory Domain',<<END);
We have discovered a novel inhibitory domain that inhibits
many classes of proteases, including metallothioproteins.
This inhibitory domain appears in three different gene families studied
to date...
END
=head2 parse_file() method
@objects = $db->parse_file('/path/to/file');
@objects = $db->parse_file('/path/to/file',1);
This will call parse() to parse each of the objects found in the
indicated .ace file, returning the list of objects successfully loaded
into the database.
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
in Ace::Object's object editing methods.
Sets or queries the I<auto_save> variable. If true, the "save"
command will be issued automatically before the connection to the
database is severed. The default is true.
Examples:
$db->auto_save(1);
$flag = $db->auto_save;
=head2 error() method
Ace->error;
This returns the last error message. Like UNIX errno, this variable
is not reset between calls, so its contents are only valid after a
method call has returned a result value indicating a failure.
For your convenience, you can call error() in any of several ways:
print Ace->error();
print $db->error(); # $db is an Ace database handle
print $obj->error(); # $object is an Ace::Object
There's also a global named $Ace::Error that you are free to use.
=head2 datetime() and date()
$datetime = Ace->datetime($time);
$today = Ace->datetime();
$date = Ace->date($time);
$today = Ace->date([$time]);
the query result.
=item read()
Read the result from the last query sent to the server and return it
as a string. ACE may return the result in pieces, breaking between
whole objects. You may need to read repeatedly in order to fetch the
entire result. Canonical example:
$acedb->query("find Sequence D*");
die "Got an error ",$acedb->error() if $acedb->status == STATUS_ERROR;
while ($acedb->status == STATUS_PENDING) {
$result .= $acedb->read;
}
=item status()
Return the status code from the last operation. Status codes are
exported by default when you B<use> Ace.pm. The status codes you may
see are:
STATUS_WAITING The server is waiting for a query.
STATUS_PENDING A query has been sent and Ace is waiting for
you to read() the result.
STATUS_ERROR A communications or syntax error has occurred
=item error()
Returns a more detailed error code supplied by the Ace server. Check
this value when STATUS_ERROR has been returned. These constants are
also exported by default. Possible values:
ACE_INVALID
ACE_OUTOFCONTEXT
ACE_SYNTAXERROR
ACE_UNRECOGNIZED
Please see the ace client library documentation for a full description
of these error codes and their significance.
=item encore()
This method may return true after you have performed one or more
read() operations, and indicates that there is more data to read. You
will not ordinarily have to call this method.
=back
=head1 BUGS
1. The ACE model should be consulted prior to updating the database.
2. There is no automatic recovery from connection errors.
3. Debugging has only one level of verbosity, despite the best
of intentions.
4. Performance is poor when fetching big objects, because of
many object references that must be created. This could be
improved.
5. When called in an array context at("tag[0]") should return the
current tag's entire column. It returns the current subtree instead.
$Ace::Error = '';
foreach my $object (@objects) {
croak "Can't put a non-Ace object into an Ace database"
unless $object->isa('Ace::Object');
croak "Can't put a non-object into a database"
unless $object->isObject;
$object = $object->fetch unless $object->isRoot; # make sure we're putting root object
my $data = $object->asAce;
$data =~ s/\n/; /mg;
my $result = $self->raw_query("parse = $data");
$Ace::Error = $result if $result =~ /sorry|parse error/mi;
return $count if $Ace::Error;
$count++; # bump if succesful
}
return $count;
}
# Parse a single object and return the result as an object
sub parse {
my $self = shift;
my $ace_data = shift;
my @lines = split("\n",$ace_data);
foreach (@lines) { s/;/\\;/; } # protect semicolons
my $query = join("; ",@lines);
my $result = $self->raw_query("parse = $query");
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
return $results[0];
}
# Parse a single object as longtext and return the result
# as an object
sub parse_longtext {
my $self = shift;
my ($title,$body) = @_;
my $mm = "parse =
Longtext $title
$body
***LongTextEnd***
" ;
$mm =~ s/\//\\\//g ;
$mm =~ s/\n/\\n/g ;
$mm .= "\n" ;
my $result = $self->raw_query($mm) ;
$Ace::Error = $result=~/sorry|parse error/mi ? $result : '';
my @results = $self->_list(1,0);
return $results[0];
}
# Parse a file and return all the results
sub parse_file {
my $self = shift;
my ($file,$keepgoing) = @_;
local(*ACE);
local($/) = ''; # paragraph mode
my(@objects,$errors);
open(ACE,$file) || croak "$file: $!";
while (<ACE>) {
chomp;
my $obj = $self->parse($_);
unless ($obj) {
$errors .= $Ace::Error; # keep track of errors
last unless $keepgoing;
}
push(@objects,$obj);
}
close ACE;
$Ace::Error = $errors;
return @objects;
}
# Create a new Ace::Object in the indicated database
# (doesn't actually write into database until you do a commit)
sub new {
my $self = shift;
my ($class,$name) = rearrange([qw/CLASS NAME/],@_);
return if $self->fetch($class,$name);
my $obj = $self->class_for($class,$name)->new($class,$name,$self);
Ace/Browser/AceSubs.pm view on Meta::CPAN
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
sub AceError {
my $msg = shift;
PrintTop(undef,undef,'Error');
print CGI::font({-color=>'red'},$msg);
PrintBottom();
Apache->exit(0) if defined &Apache::exit;
Ace/Browser/AceSubs.pm view on Meta::CPAN
print @COOKIES ? header(-cookie=>\@COOKIES,@_) : header(@_);
@COOKIES = ();
$HEADER++;
}
=item AceInit()
This subroutine initializes the AcePerl connection to the configured
database. If the database cannot be opened, it generates an error
message and exits. This subroutine is not exported by default, but is
called by PrintTop() and Header() internally.
=cut
# Subroutines used by all scripts.
# Will generate an HTTP 'document not found' error if you try to get an
# undefined database name. Check the return code from this function and
# return immediately if not true (actually, not needed because we exit).
sub AceInit {
$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!
exit(0);
}
=item AceMissing([$class,$name])
This subroutine will print out an error message indicating that an
object is present in AceDB, but that the information the user
requested is absent. It will then exit the script. This is
infrequently encountered when following XREFed objects. If the class
and name of the object are not provided as arguments, they are taken
from CGI's param() function.
=cut
sub AceMissing {
my ($class,$name) = @_;
Ace/Browser/AceSubs.pm view on Meta::CPAN
ol(
li([
map {ObjectLink($_,font({-color=>'red'},$_->class).': '.$_)} @$objects
])
);
PrintBottom();
}
=item AceNotFound([$class,$name])
This subroutine will print out an error message indicating that the
requested object is not present in AceDB, even as a name. It will then
exit the script. If the class and name of the object are not provided
as arguments, they are taken from CGI's param() function.
=cut
sub AceNotFound {
my $class = shift || param('class');
my $name = shift || param('name');
PrintTop(undef,undef,"$class: $name not found");
Ace/Browser/SiteDefs.pm view on Meta::CPAN
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);
$data{ucfirst(lc $_)} = \%symbol if defined(%symbol);
Ace/Browser/SiteDefs.pm view on Meta::CPAN
return "$root/$file";
}
sub resolveConf {
my $pack = shift;
my $file = shift;
unless ($SITE_DEFS) {
(my $rpath = __PACKAGE__) =~ s{::}{/}g;
my $path = $INC{"${rpath}.pm"}
|| warn "Unexpected error: can't locate acebrowser SiteDefs.pm file";
$path =~ s![^/]*$!!; # trim to directory
$SITE_DEFS = $path;
}
return "$SITE_DEFS/$file";
}
sub get_config {
my $pack = shift;
return unless exists $ENV{MOD_PERL};
Ace/Graphics/Panel.pm view on Meta::CPAN
key printed at bottom of panel
(if any)
Typically you will pass new() an object that implements the
Bio::RangeI interface, providing a length() method, from which the
panel will derive its scale.
$panel = Ace::Graphics::Panel->new(-segment => $sequence,
-width => 800);
new() will return undef in case of an error. If the specified glyph
name is not a valid one, new() will throw an exception.
=back
=head2 OBJECT METHODS
=over 4
=item $track = $panel->add_track($glyph,$features,@options)
Ace/Local.pm view on Meta::CPAN
sub auto_save {
my $self = shift;
$self->{'auto_save'} = $_[0] if defined $_[0];
return $self->{'auto_save'};
}
sub status {
return $_[0]->{'status'};
}
sub error {
my $self = shift;
return $self->{'error'};
}
sub query {
my $self = shift;
my $query = shift;
warn "query($query)\n" if $self->debug;
if ($self->debug) {
my $msg = $query || '';
warn "\tquery($msg)";
}
Ace/Local.pm view on Meta::CPAN
the query result.
=head2 read()
Read the result from the last query sent to the server and return it
as a string. ACE may return the result in pieces, breaking between
whole objects. You may need to read repeatedly in order to fetch the
entire result. Canonical example:
$accessor->query("find Sequence D*");
die "Got an error ",$accessor->error() if $accessor->status == STATUS_ERROR;
while ($accessor->status == STATUS_PENDING) {
$result .= $accessor->read;
}
=head2 low_read()
Read whatever data's available, or undef if none. This is only used
by the ace.pl replacement for giface/tace.
=head2 status()
Return the status code from the last operation. Status codes are
exported by default when you B<use> Ace.pm. The status codes you may
see are:
STATUS_WAITING The server is waiting for a query.
STATUS_PENDING A query has been sent and Ace is waiting for
you to read() the result.
STATUS_ERROR A communications or syntax error has occurred
=head2 error()
May return a more detailed error code supplied by Ace. Error checking
is not fully implemented.
=head2 encore()
This method will return true after you have performed one or more
read() operations, and indicates that there is more data to read.
B<encore()> is functionally equivalent to:
$encore = $accessor->status == STATUS_PENDING;
Ace/Object.pm view on Meta::CPAN
1;
}
# returns true if the object is a tag.
sub isTag {
my $self = shift;
return 1 if $self->class eq 'tag';
return;
}
# return the most recent error message
sub error {
$Ace::Error=~s/\0//g; # get rid of nulls
return $Ace::Error;
}
### Returns the object's model (as an Ace::Model object)
sub model {
my $self = shift;
return unless $self->db && $self->isObject;
return $self->db->model($self->class);
}
Ace/Object.pm view on Meta::CPAN
# Update object
$sequence->replace('Visible.Overlap_Right',$r,'M55555');
$sequence->add('Visible.Homology','GR91198');
$sequence->delete('Source.Clone','MBR122');
$sequence->commit();
# 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
Ace/Object.pm view on Meta::CPAN
$author->add_row('Full_name','Joseph M. Smith');
$author->add_row('Laboratory',$lab);
$lab->commit();
$author->commit();
The result code indicates whether the addition was syntactically
correct. add_row() will fail if you attempt to add a duplicate entry
(that is, one with exactly the same tag and value). In this case, use
replace() instead. Currently there is no checking for an attempt to
add multiple values to a single-valued (UNIQUE) tag. The error will
be detected and reported at commit() time however.
The add() method is an alias for add_row().
See also the Ace->new() method.
=head2 add_tree()
$result_code = $object->add_tree($tag=>$ace_object);
$result_code = $object->add_tree(-tag=>$tag,-tree=>$ace_object);
Ace/Object.pm view on Meta::CPAN
Here is an example of copying the "Assembly_tags" subtree
from one database object to another:
$remote = Ace->connect(-port=>200005) || die "can't connect";
$ac3 = $remote->fetch(Sequence=>'AC3') || die "can't get AC7";
my $assembly = $ac3->at('Assembly_tags');
$local = Ace->connect(-path=>'~acedb') || die "can't connect";
$AC3copy = Ace::Object->new(Sequence=>'AC3copy',$local);
$AC3copy->add_tree('Assembly_tags'=>$tags);
$AC3copy->commit || warn $AC3copy->error;
Notice that this syntax will not work the way you think it should:
$AC3copy->add_tree('Assembly_tags'=>$ac3->at('Assembly_tags'));
This is because call at() in an array context returns the column to
the right of the tag, not the tag itself.
Here's an example of building up a complex structure from scratch
using a combination of add() and add_tree():
$newObj = Ace::Object->new(Sequence=>'A555',$local);
my $assembly = Ace::Object->new(tag=>'Assembly_tags');
$assembly->add('Finished Left'=>[10,20,'ABC']);
$assembly->add('Clone right end'=>[1000,2000,'DEF']);
$assembly->add('Clone right end'=>[8000,9876,'FRED']);
$assembly->add('Finished Right'=>[1000,3000,'ETHEL']);
$newObj->add_tree('Assembly_tags'=>$assembly);
$newObj->commit || warn $newObj->error;
=head2 delete() method
$result_code = $object->delete($tag_path,$value);
$result_code = $object->delete(-path=>$tag_path,
-value=>$value);
Delete the indicated tag and value from the object. This example
deletes the address line "FRANCE" from the Author's mailing address:
Ace/Object.pm view on Meta::CPAN
delete() result code indicates whether the replace was successful.
Currently is true if the old value was identified.
=head2 commit() method
$result_code = $object->commit;
Commits all add(), replace() and delete() operations to the database.
It can also be used to write a completely new object into the
database. The result code indicates whether the object was
successfully written. If an error occurred, further details can be
found in the Ace->error() error string.
=head2 rollback() method
$object->rollback;
Discard all adds, deletions and replacements, returning the object to
the state it was in prior to the last commit().
rollback() works by deleting the object from Perl memory and fetching
the object anew from AceDB. If someone has changed the object in the
Ace/Object.pm view on Meta::CPAN
$result_code = $object->kill;
This will remove the object from the database immediately and
completely. It does not wait for a commit(), and does not respond to
a rollback(). If successful, you will be left with an empty object
that contains just the class and object names. Use with care!
In the case of failure, which commonly happens when the database is
not open for writing, this method will return undef. A description of
the problem can be found by calling the error() method.
=head2 date_style() method
$object->date_style('ace');
This is a convenience method that can be used to set the date format
for all objects returned by the database. It is exactly equivalent to
$object->db->date_style('ace');
Ace/Object.pm view on Meta::CPAN
This returns the comment attached to an object or object subtree, if
any. Comments are I<Comment> objects and have the interesting
property that a single comment can refer to multiple objects. If
there is no comment attached to the current subtree, this method will
return undef.
Currently you cannot create a new comment in AcePerl or edit an old
one.
=head2 error() method
$error = $object->error;
Returns the error from the previous operation, if any. As in
Ace::error(), this string will only have meaning if the previous
operation returned a result code indicating an error.
=head2 factory() method
WARNING - THIS IS DEFUNCT AND NO LONGER WORKS. USE THE Ace->class() METHOD INSTEAD
$package = $object->factory;
When a root Ace object instantiates its tree of tags and values, it
creates a hierarchical structure of Ace::Object objects. The
factory() method determines what class to bless these subsidiary
Ace/Object.pm view on Meta::CPAN
override this method in a child class in order to create more
specialized Ace::Object classes. The method should return a string
corresponding to the package to bless the object into. It receives
the current Ace::Object as its first argument.
=head2 debug() method
$object->debug(1);
Change the debugging mode. A zero turns off debugging messages.
Integer values produce debug messages on standard error. Higher
integers produce progressively more verbose messages. This actually
is just a front end to Ace->debug(), so the debugging level is global.
=head1 SEE ALSO
L<Ace>, L<Ace::Model>, L<Ace::Object>, L<Ace::Local>,
L<Ace::Sequence>,L<Ace::Sequence::Multi>
=head1 AUTHOR
Ace/Object.pm view on Meta::CPAN
$result = $db->raw_query($cmd,0,'parse'); # sets Ace::Error for us
} else { # old way for RPC server and local
my $cmd = join('; ',"$self->{'class'} : $name",
@{$self->{'.update'}});
warn $cmd if $self->debug;
$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;
}
Ace/Sequence.pm view on Meta::CPAN
# convert start into offset
$offset = $start - 1 if defined($start) and !defined($offset);
# convert stop/end into length
$length = ($end > $start) ? $end - $offset : $end - $offset - 2
if defined($end) && !defined($length);
# if just a string is passed, try to fetch a Sequence object
my $obj = ref($seq) ? $seq : $db->fetch('Sequence'=>$seq);
unless ($obj) {
Ace->error("No Sequence named $obj found in database");
return;
}
# get parent coordinates and length of this sequence
# the parent is an Ace Sequence object in the "+" strand
my ($parent,$p_offset,$p_length,$strand) = find_parent($obj);
return unless $parent;
# handle negative strands
my $r_strand = $strand;
Ace/Sequence.pm view on Meta::CPAN
=item -db
This argument is required if the source sequence is specified by name
rather than by object reference.
=back
If new() is successful, it will create an I<Ace::Sequence> object and
return it. Otherwise it will return undef and return a descriptive
message in Ace->error(). Certain programming errors, such as a
failure to provide required arguments, cause a fatal error.
=head2 Reference Sequences and the Coordinate System
When retrieving information from an I<Ace::Sequence>, the coordinate
system is based on the sequence segment selected at object creation
time. That is, the "+1" strand is the natural direction of the
I<Ace::Sequence> object, and base pair 1 is its first base pair. This
behavior can be overridden by providing a reference sequence to the
new() method, in which case the orientation and position of the
reference sequence establishes the coordinate system for the object.
Ace/Sequence.pm view on Meta::CPAN
=head2 GFF()
$gff_object = $seq->gff;
$gff_object = $seq->gff(-abs => 1,
-features => ['exon','intron:GeneFinder']);
The GFF() method takes the same arguments as gff() described above,
but it returns a I<GFF::GeneFeatureSet> object from the GFF.pm
module. If the GFF module is not installed, this method will generate
a fatal error.
=head2 absolute()
$abs = $seq->absolute;
$abs = $seq->absolute(1);
This method controls whether the coordinates of features are returned
in absolute or relative coordinates. "Absolute" coordinates are
relative to the underlying source or reference sequence. "Relative"
coordinates are relative to the I<Ace::Sequence> object. By default,
Ace/Sequence.pm view on Meta::CPAN
L<Ace>, L<Ace::Object>, L<Ace::Sequence::Feature>,
L<Ace::Sequence::FeatureList>, L<GFF>
=head1 AUTHOR
Lincoln Stein <lstein@cshl.org> with extensive help from Jean
Thierry-Mieg <mieg@kaa.crbm.cnrs-mop.fr>
Many thanks to David Block <dblock@gene.pbi.nrc.ca> for finding and
fixing the nasty off-by-one errors.
Copyright (c) 1999, Lincoln D. Stein
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__
Ace/Sequence/Multi.pm view on Meta::CPAN
This argument points to one or more previously-opened annotation
databases. You may use a scalar if there is only one annotation
database. Otherwise, use an array reference. You may add and delete
annotation databases after the object is created by using the
add_secondary() and delete_secondary() methods.
=back
If new() is successful, it will create an I<Ace::Sequence::Multi>
object and return it. Otherwise it will return undef and return a
descriptive message in Ace->error(). Certain programming errors, such
as a failure to provide required arguments, cause a fatal error.
=head1 OBJECT METHODS
Most methods are inherited from I<Ace::Sequence>. The following
additional methods are supported:
=over 4
=item secondary()
Ace/SocketServer.pm view on Meta::CPAN
use constant ACESERV_CLIENT_HELLO => "bonjour";
use constant ACESERV_SERVER_HELLO => "et bonjour a vous";
sub connect {
my $class = shift;
my ($host,$port,$timeout,$user,$pass) = rearrange(['HOST','PORT','TIMEOUT','USER','PASS'],@_);
$user ||= DEFAULT_USER;
$pass ||= DEFAULT_PASS;
$timeout ||= DEFAULT_TIMEOUT;
my $s = IO::Socket::INET->new("$host:$port") ||
return _error("Couldn't establish connection");
my $self = bless { socket => $s,
client_id => 0, # client ID provided by server
timeout => $timeout,
},$class;
return unless $self->_handshake($user,$pass);
$self->{status} = STATUS_WAITING;
$self->{encoring} = 0;
return $self;
}
Ace/SocketServer.pm view on Meta::CPAN
# Is _recv_msg() bringing things down in flames? Maybe!
my ($msg,$body) = $self->_recv_msg('strip');
warn "Did not get expected ACESERV_MSGKILL message, got $msg instead"
if defined($msg) and $msg ne ACESERV_MSGKILL;
}
sub encore { return shift->{encoring} }
sub status { shift->{status} }
sub error { $Ace::Error; }
sub query {
my $self = shift;
my ($request,$parse) = @_;
warn "query($request)" if Ace->debug;
unless ($self->_send_msg($request,$parse)) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
$self->{encoring} = 0;
return 1;
}
sub read {
my $self = shift;
return _error("No pending query") unless $self->status == STATUS_PENDING;
$self->_do_encore || return if $self->encore;
# call select() here to time out
if ($self->{timeout}) {
my $rdr = '';
vec($rdr,fileno($self->{socket}),1) = 1;
my $result = select($rdr,undef,undef,$self->{timeout});
return _error("Query timed out") unless $result;
}
my ($msg,$body) = $self->_recv_msg;
return unless defined $msg;
$msg =~ s/\0.+$//; # socketserver bug workaround: get rid of junk in message
if ($msg eq ACESERV_MSGOK or $msg eq ACESERV_MSGFAIL) {
$self->{status} = STATUS_WAITING;
$self->{encoring} = 0;
} elsif ($msg eq ACESERV_MSGENCORE) {
$self->{status} = STATUS_PENDING; # not strictly necessary, but helpful to document
$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;
return;
}
# return socket (read only)
sub socket { $_[0]->{socket} }
# ----------------------------- low level -------------------------------
sub _do_encore {
my $self = shift;
unless ($self->_send_msg('encore')) {
$self->{status} = STATUS_ERROR;
return _error("Write to socket server failed: $!");
}
$self->{status} = STATUS_PENDING;
return 1;
}
sub _handshake {
my $self = shift;
my ($user,$pass) = @_;
$self->_send_msg(ACESERV_CLIENT_HELLO);
my ($msg,$nonce) = $self->_recv_msg('strip');
return unless $msg eq ACESERV_MSGOK;
# hash username and password
my $authdigest = md5_hex(md5_hex($user . $pass).$nonce);
$self->_send_msg("$user $authdigest");
my $body;
($msg,$body) = $self->_recv_msg('strip');
return _error("server: $body") unless $body eq ACESERV_SERVER_HELLO;
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) {
Ace/SocketServer.pm view on Meta::CPAN
}
sub _recv_msg {
my $self = shift;
my $strip_null = shift;
return unless my $sock = $self->{socket};
my ($header,$body);
my $bytes = CORE::read($sock,$header,HEADER_LEN);
unless ($bytes > 0) {
$self->{status} = STATUS_ERROR;
return _error("Connection closed by remote server: $!");
}
my ($magic,$length,$junk1,$clientID,$junk2,$msg) = unpack HEADER,$header;
$self->{client_id} ||= $clientID;
$msg =~ s/\0*$//;
$self->{last_msg} = $msg;
if ($length > 0) {
return _error("read of body failed: $!" )
unless CORE::read($sock,$body,$length);
$body =~ s/\0*$// if defined($strip_null) && $strip_null;
return ($msg,$body);
} else {
return $msg;
}
}
1;
1.92 Tue Nov 11 11:43:17 EST 2008
1. Cache ignores objects that do not have a proper name.
1.91 Tue Oct 31 17:42:00 EST 2006
1. Updated AUTOLOAD style so that inheritance works again.
2. Removed dependency on WeakRef
1.90 Thu Mar 17 17:09:10 EST 2005
1. Fixed error in which the -fill argument wasn't being passed down to get() caching code.
2. Added a debug() method to Ace::SocketServer && Ace::Local.
1.89 Wed Mar 9 18:25:45 EST 2005
1. Added caching code.
2. Now requires ace binaries 4_9s or later.
3. Requires CACHE::CACHE and WeakRef for caching.
1.87 10/3/03
1. Fixed unreadable GIF images produced by recent versions of GifAceServer.
2. Fixed Ace::Model to handle #tags properly.
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
Ace::Model class
README.ACEBROWSER view on Meta::CPAN
$PASSWORD = '';
In addition to scalar variables, the configuration file is used to set
arrays, hashes and specially-named functions.
If you are only interested in accessing a single database, it is
easiest to modify the default.pm configuration file. To serve
multiple databases, just make a copy of default.pm and edit the copy.
If, for some reason, Acebrowser cannot find its configuration files,
it will generate an internal server error. The location of the
configuration files directory is stored in the module
Ace::Browser::LocalSiteDefs, typically somewhere inside the
"site_perl" subdirectory of the Perl library directory (use "perl -V"
to see where that is). You can find out where Acebrowser expects to
find its configuration files by running the following command:
perl -MAce::Browser::LocalSiteDefs \
-e 'print $Ace::Browser::LocalSiteDefs::SITE_DEFS,"\n"'
To change this value, either reinstall Aceperl or edit
int
encore(self)
AceDB* self
CODE:
RETVAL = self->encoring;
OUTPUT:
RETVAL
int
error(self)
AceDB* self
CODE:
RETVAL = self->errcode;
OUTPUT:
RETVAL
int
status(self)
AceDB* self
CODE:
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
if (obj != null) obj.title=comment;
window.status=comment;
return true;
}
function c() {
if (window.event) window.event.cancelBubble=true;
}
END
;
# uuencoded GIF for error messages
use constant ERROR_GIF=><<'END';
M1TE&.#=A8`$W`/```+\``/___RP`````8`$W```"_H2/<<'M#Q^(+BF%;%YR
M3PJ&XDB6YCERE8&V[@O'((LQ-"VKW?KAM?W!!!LXG>R(3+I\Q*'R"8U2@D4@
MTFC=_8A-;?<K#8MSSJRI/(:BT\QM;()N7]Q>LUV>SNLA<OQTO?<&*-9VXV0Q
M`W<X2+?"-^3C5P/)L;`!1%7)PJ398\@)]^BIZ,E#*00F%(>H&I+1]&G7BOJ9
MV0G(BE)(FBDK(2OI=EI7-%B:93C9BURZ:Y8\9^.[E:S1PX-*?5SWT[<-O:D"
MKMCMR!QQ`[-[')F(:9[XFGKGX3[7GDV=.OK'I?U\[=$73><`%I0F<%^9*L+>
M=8/D\.%`B`F#V8-7"XL__GHB\/F*1&F-CGITTF&RYHI<(W%^BAG$]C*C-W@K
MJ9PDR$R>MV4D_S"Z"`9:BDOS$J);.*PH+*6@_AD]2NL42)$\ERD+RNXG2)H%
M9Q[D&FXBB;!+D(H="G.:4F"+N'78QO5"TKAOY9H#M>JL1*=[+6YERA+J5X4Q
acebrowser/cgi-bin/generic/pic view on Meta::CPAN
),
end_form;
}
sub display_object {
my ($obj,$click) = @_;
my $class = param('class');
my $name = $obj->name;
if (DISABLED) {
print h1({-class=>'error'},'Sorry, but graphical displays have been disabled temporarily.');
return;
}
# special case for sequences
if (lc($class) eq 'sequence' && $name =~ /SUPERLINK|CHROMOSOME/) {
print h1('This sequence is too large to display. Try a shorter segment.');
return;
}
build_map_navigation_panel($obj,$name,$class) if $class =~ /Map/i;
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
} else {
print start_form;
print_instructions();
print_form( $object_name,$object_class,DB_Name(),$where_from );
print end_form;
}
} else {
print p("No recipients for feedback are defined.");
print start_form(),
hidden(-name=>'referer',-value=>$where_from),br,
submit(-name=>'return',-value=>'Cancel & Return',-class=>'error'),
end_form();
}
PrintBottom;
sub print_top {
my $title = 'Data Submissions and Comments';
print start_html (
'-Title' => $title,
'-style' => Style(),
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
TR(td({-colspan=>2},textarea(-name=>'remark',
-rows=>12,
-cols=>80,
-wrap=>'VIRTUAL'
))),
),
hidden(-name=>'name',-value=>$name),
hidden(-name=>'class',-value=>$class),
hidden(-name=>'db',-value=>$db),
hidden(-name=>'referer',-value=>$where_from),br,
submit(-name=>'return',-value=>'Cancel & Return',-class=>'error'),
submit(-name=>'submit',-value=>'Submit Data');
}
sub send_mail {
my ($obj_name,$obj_class,$where_from) = @_;
$obj_name ||= '(unknown name)';
$obj_class ||= '(unknown class)';
$where_from ||= '(unknown)';
my @addresses = map { $FEEDBACK_RECIPIENTS[$_] ?
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
push @missing,"Your e-mail address"
unless my $from = param('from');
push @missing,"A properly formatted e-mail address"
if $from && $from !~ /.+\@[\w.]+/;
push @missing,"A subject line"
unless my $subject = param('subject');
push @missing,"A comment or correction"
unless my $remark = param('remark');
if (@missing) {
print
p({-class=>'error'},
"Your submission could not be processed because",
"the following information was missing:"),
ol({-class=>'error'},
li(\@missing)),
p({-class=>'error'},
"Please fill in the missing fields and try again.");
return;
}
my $error = <<END;
Unable to send mail. Please try again later.
If the problem persists, contact the site\'s webmaster.
END
;
unless (open (MAIL,"|/usr/lib/sendmail -oi -t")) {
AceError($error);
return;
}
my $to = join(", ",@addresses);
print MAIL <<END;
From: $from ($name via ACEDB feedback page)
To: $to
Subject: $subject
Full name: $name
Institution: $institution
acebrowser/cgi-bin/misc/feedback view on Meta::CPAN
DATABASE RECORD: $obj_class: $obj_name
SUBMITTED FROM PAGE: $where_from
COMMENT TEXT:
$remark
END
;
unless (close MAIL) {
AceError($error);
return;
}
return 1;
}
sub print_confirmation {
print
p("Thank you for taking the time to submit this information.",
"Please use the buttons below to submit more reports or to",
"return to the database.",
acebrowser/cgi-bin/searches/browser view on Meta::CPAN
-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/conf/default.pm view on Meta::CPAN
# ========= &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);
# pictures remain pictures
if ($display eq 'pic') {
return ('pic' => "name=$n&class=$c");
}
# otherwise display it with a tree
else {
return ('tree' => "name=$n&class=$c");
}
acebrowser/conf/simple.pm view on Meta::CPAN
# ========= &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);
# pictures remain pictures
if ($display eq 'pic') {
return ('pic' => "name=$n&class=$c");
}
# otherwise display it with a tree
else {
return ('tree' => "name=$n&class=$c");
}
acebrowser/htdocs/stylesheets/aceperl.css view on Meta::CPAN
align: center;
background-color: blue;
color: yellow;
padding: 3px 200px;
}
.data { font-size: small; }
.databody { background-color: #CCFFFF; }
.databodysmall { background-color: #EEFFFF; }
.datatitle { background-color: #93CBF4; }
.description { font-style: italic; }
.error { color: red; }
.exon { background-color: #00FFFF;
color: #000000;
}
.exonalt { background-color: #EEEE99;
color: #000000;
}
.exonm { /* font-weight: bold; */
background-color: #00FFFF;
color: #000000;
}
acebrowser/htdocs/stylesheets/elegans.css view on Meta::CPAN
background-color: blue;
color: yellow;
padding-top: 3px;
padding-bottom: 3px;
padding-left: 100px;
padding-right: 100px;
}
.gene {
font-style: italic
}
.error {
color: red;
}
.note {
font-size: 10pt;
}
Blockquote.abstract {
font-size: 10pt;
background-color: rgb(255,248,220);
}
.description {
acebrowser/htdocs/stylesheets/moviedb.css view on Meta::CPAN
background-color: blue;
color: yellow;
padding-top: 3px;
padding-bottom: 3px;
padding-left: 100px;
padding-right: 100px;
}
.gene {
font-style: italic
}
.error {
color: red;
}
.note {
font-size: 10pt;
}
Blockquote.abstract {
font-size: 10pt;
background-color: rgb(255,248,220);
}
.description {
acelib/aceclientlib.c view on Meta::CPAN
if (magic1 < 0) magic1 = -magic1 ; /* old system */
if (!nm || !*nm) return 0 ;
freeinit() ;
level = freesettext(nm,0) ;
if (!freecard(level))
goto fin ;
cp = freeword () ;
if (!cp)
{ messerror ("Can't obtain write pass name from server") ;
goto fin ;
}
if (accessDebug)
printf ("// Write pass file: %s\n", cp) ;
if (strcmp(cp, "NON_WRITABLE"))
{ f = magicFileOpen (cp) ;
if (f)
{ if (fscanf(f, "%d", &magic3) != 1)
messerror ("failed to read file") ;
fclose(f) ;
}
}
if ((cp = freeword ()) &&
!magic3) /* must be able to read if can write */
{ if (accessDebug)
printf ("// Read pass file: %s\n", cp) ;
if (strcmp(cp, "PUBLIC") && strcmp(cp,"RESTRICTED"))
{ f = magicFileOpen (cp) ;
if (!f)
{ messout ("// Access to this database is restricted, sorry (can't open pass file)\n") ;
goto fin ;
}
if (fscanf(f, "%d", &magic2) != 1)
messerror ("failed to read file") ;
fclose(f) ;
}
}
magic = magic1 ;
if (magic2)
magic = magic1 * magic2 % 73256171 ;
if (magic3)
magic = magic1 * magic3 % 43532334 ;
acelib/aceclientlib.c view on Meta::CPAN
int chunkSize desired size (in kBytes) of returned data-block
This is only a hint. The server can return more.
The server splits on ace boundaries
a chunkSize of 0 indicates a request for unbuffered answers
OUTPUT
unsigned char ** answer ptr to char ptr. Pointing to allocated memory containing
answer string. This memory will be filled with the
unmodified data handled as binary bytes.
return value:
int error condition
ESUCCESS (0) no error.
EIO (5) no response received from server.
ENOMEM (12) no memory available to store answer.
or a server generated error
JC if the server can return both an encore and an aceError at the same time
I'm in trouble. I use only one int return value for both
*/
int askServerBinary(ace_handle *handle, char *request, unsigned char **answerPtr,
int *answerLength, int *encorep, int chunkSize)
{
ace_data question ;
ace_reponse *reponse = 0 ;
acelib/aceclientlib.c view on Meta::CPAN
else
{ question.encore = 0;
question.question = request;
}
if (*encorep == 3)
question.encore = -3 ;
reponse = ace_server_1(&question, handle->clnt);
/* validity checking of reponse */
/* no data was received, return error */
if (!reponse)
return EIO ;
/* store server returned error status. Give this to the client */
/* JC answer could contain more info on error, so
continue normal handling of the answer */
aceError = reponse->ace_reponse_u.res_data.aceError;
/* no answer was received, return NULL answer
leave checking for NULL reponse to upper layer
if (reponse->ace_reponse_u.res_data.reponse.reponse_len == 0) {
xdr_free((xdrproc_t )xdr_ace_reponse, (char *)reponse);
memset (reponse,0, sizeof(ace_reponse)) ;
*answerLength = 0;
*answerPtr = NULL;
acelib/aceclientlib.c view on Meta::CPAN
and client identification information
int chunkSize desired size (in kBytes) of returned data-block
This is only a hint. The server can return more.
The server splits on ace boundaries
a chunkSize of 0 indicates a request for unbuffered answers
OUTPUT
char ** answer ptr to char ptr. Pointing to allocated memory containing
answer string.
return value:
int error condition
ESUCCESS (0) no error.
EIO (5) no response received from server.
ENOMEM (12) no memory available to store answer.
or a server generated error
*/
int askServer(ace_handle *handle, char *request, char **answerPtr, int chunkSize)
{ int length, i, encore ;
int returnValue;
unsigned char *binaryAnswer;
char *answer;
char *loop;
returnValue = askServerBinary(handle, request, &binaryAnswer, &length, &encore, chunkSize) ;
acelib/arraysub.c view on Meta::CPAN
BOOL uAssNext (Associator a, void* *pin, void* *pout)
{ int size ;
void *test ;
if (!assExists(a))
messcrash("uAssNext received a non existing associator") ;
size = 1 << a->m ;
if (!*pin)
a->i = -1 ;
else if (*pin != a->in[a->i])
{ messerror ("Non-consecutive call to assNext()") ;
return FALSE ;
}
while (++a->i < size)
{ test = a->in[a->i] ;
if (test && test != moins_un) /* not empty or deleted */
{ *pin = a->in[a->i] ;
if (pout)
*pout = a->out[a->i] ;
return TRUE ;
acelib/filsubs.c view on Meta::CPAN
return;
} /* filAddPath */
/*****************************************************************************/
/* This function returns the filename part of a given path, */
/* */
/* Given "/some/load/of/directories/filename" returns "filename" */
/* */
/* The function returns NULL for the following errors: */
/* */
/* 1) supplying a NULL ptr as the path */
/* 2) supplying "" as the path */
/* 3) supplying a path that ends in "/" */
/* */
/* NOTE, this function is _NOT_ the same as the UNIX basename command or the */
/* XPG4_UNIX basename() function which do different things. */
/* */
/* The function makes a copy of the supplied path on which to work, this */
/* copy is thrown away each time the function is called. */
acelib/filsubs.c view on Meta::CPAN
return(result) ;
} /* filGetFilename */
/*****************************************************************************/
/* This function returns the file-extension part of a given path/filename, */
/* */
/* Given "/some/load/of/directories/filename.ext" returns "ext" */
/* */
/* The function returns NULL for the following errors: */
/* */
/* 1) supplying a NULL ptr as the path */
/* 2) supplying a path with no filename */
/* */
/* The function returns "" for a filename that has no extension */
/* */
/* The function makes a copy of the supplied path on which to work, this */
/* copy is thrown away each time the function is called. */
/* */
/*****************************************************************************/
acelib/filsubs.c view on Meta::CPAN
path_copy = (char*) messalloc (strlen(pwd) + strlen(dir) + 2) ;
strcpy (path_copy, pwd) ;
strcat (path_copy, SUBDIR_DELIMITER_STR) ;
strcat (path_copy, dir) ;
return path_copy ;
}
else
return 0 ; /* signals error that the path was not found */
} /* filGetFullPath */
/*******************************/
static BOOL filCheck (char *name, char *spec)
/* allow 'd' as second value of spec for a directory */
{
char *cp ;
BOOL result ;
struct stat status ;
if (!spec) /* so filName returns full file name (for error messages) */
return TRUE ;
/* directory check */
if (spec[1] == 'd' &&
(stat (name, &status) || !(status.st_mode & S_IFDIR)))
return 0 ;
switch (*spec)
{
case 'r':
return !(access (name, R_OK)) ;
acelib/filsubs.c view on Meta::CPAN
/************************************************************/
UTIL_FUNC_DEF FILE *filopen (char *name, char *ending, char *spec)
{
char *s = filName (name, ending, spec) ;
FILE *result = 0 ;
if (!s)
{
if (spec[0] == 'r')
messerror ("Failed to open for reading: %s (%s)",
filName (name, ending,0),
messSysErrorText()) ;
else if (spec[0] == 'w')
messerror ("Failed to open for writing: %s (%s)",
filName (name, ending,0),
messSysErrorText()) ;
else if (spec[0] == 'a')
messerror ("Failed to open for appending: %s (%s)",
filName (name, ending,0),
messSysErrorText()) ;
else
messcrash ("filopen() received invalid filespec %s",
spec ? spec : "(null)");
}
else if (!(result = fopen (s, spec)))
{
messerror ("Failed to open %s (%s)",
s, messSysErrorText()) ;
}
return result ;
} /* filopen */
/********************* temporary file stuff *****************/
static Associator tmpFiles = 0 ;
UTIL_FUNC_DEF FILE *filtmpopen (char **nameptr, char *spec)
acelib/filsubs.c view on Meta::CPAN
if (!strcmp (spec, "r"))
return filopen (*nameptr, 0, spec) ;
#if defined(SUN) || defined(SOLARIS)
if (!(*nameptr = tempnam ("/var/tmp", "ACEDB")))
#else
if (!(*nameptr = tempnam ("/tmp", "ACEDB")))
#endif
{
messerror ("failed to create temporary file (%s)",
messSysErrorText()) ;
return 0 ;
}
if (!tmpFiles)
tmpFiles = assCreate () ;
assInsert (tmpFiles, *nameptr, *nameptr) ;
return filopen (*nameptr, 0, spec) ;
} /* filtmpopen */
acelib/filsubs.c view on Meta::CPAN
char *address ;
char *filename ;
if (!fil || fil == stdin || fil == stdout || fil == stderr)
return ;
fclose (fil) ;
if (mailFile && assFind (mailFile, fil, &filename))
{ if (assFind (mailAddress, fil, &address))
callScript ("mail", messprintf ("%s %s", address, filename)) ;
else
messerror ("Have lost the address for mailfile %s", filename) ;
assRemove (mailFile, fil) ;
assRemove (mailAddress, fil) ;
unlink (filename) ;
free (filename) ;
}
} /* filclose */
/***********************************/
UTIL_FUNC_DEF FILE *filmail (char *address) /* requires filclose() */
acelib/freesubs.c view on Meta::CPAN
}
#endif
else /* keep the \ till freeword is called */
{ *(in+1) = *in ;
*in = '\\' ;
if (++in >= cardEnd)
freeExtend (&in) ;
}
break ;
default:
messerror ("freesubs got unrecognised special character 0x%x = %c\n",
*in, *in) ;
}
else
{ if (!isprint(*in) && *in != '\t' && *in != '\n') /* mieg dec 15 94 */
--in ;
else if (isecho) /* write it out */
putchar (*in) ;
}
} /* while TRUE loop */
acelib/freesubs.c view on Meta::CPAN
{ line = (int*) messalloc (sizeof (int)) ;
assInsert (filAss, fil, line) ;
}
--in ;
while (TRUE)
{ ++in ;
if (in >= cardEnd)
freeExtend (&in) ;
chint = getc(fil) ;
if (ferror(fil))
messerror ("chint was bad");
*in = chint ;
switch (*in)
{
case '\n' :
++*line ;
case (unsigned char) EOF :
goto got_line ;
case '/' : /* // means start of comment */
if ((ch = getc (fil)) == '/')
{ while (getc(fil) != '\n' && !feof(fil)) ;
acelib/freesubs.c view on Meta::CPAN
}
*start = '"' ;
goto retTRUE ;
case 'z' : if (freeword ()) goto retFALSE ; else goto retTRUE ;
case 'o' :
if (!*++fp) messcrash ("'o' can not end free format %s",fmt) ;
freestep (*fp) ; break ;
case 'b' : break; /* special for graphToggleEditor no check needed il */
default :
if (!isdigit((int)*fp) && !isspace((int)*fp))
messerror ("unrecognised char %d = %c in free format %s",
*fp, *fp, fmt) ;
}
retTRUE :
pos = keep ; return TRUE ;
retFALSE :
pos = keep ; return FALSE ;
}
/************************ little routines ************************/
acelib/helpsubs.c view on Meta::CPAN
page = messalloc (sizeof(HtmlPage));
page->handle = handleCreate();
page->htmlText = makeHtmlIndex(page->handle);
if (!(page->root = parseHtmlText(page->htmlText, page->handle)))
htmlPageDestroy(page);
return page;
}
if (!(filName(helpFilename, "", "r")))
return 0; /* prevent error caused
by unsucsessful filopen */
/* create a page inlining the image */
if (strcasecmp (helpFilename + (strlen(helpFilename)-4), ".gif") == 0)
{
page = messalloc (sizeof(HtmlPage));
page->handle = handleCreate();
page->htmlText = makeHtmlImagePage(helpFilename, page->handle);
if (!(page->root = parseHtmlText(page->htmlText, page->handle)))
acelib/memsubs.c view on Meta::CPAN
handleFinalise ((void *)&handle0) ;
}
#endif
/************** checking functions, require MALLOC_CHECK *****/
#ifdef MALLOC_CHECK
static void checkUnit (STORE_HANDLE unit)
{
if (unit->check1 == 0x87654321)
messerror ("Block at %x freed twice - bad things will happen.",
toMemPtr(unit));
else
if (unit->check1 != 0x12345678)
messerror ("Malloc error at %x length %d: "
"start overwritten with %x",
toMemPtr(unit), unit->size, unit->check1) ;
if (check2(unit) != 0x12345678)
messerror ("Malloc error at %x length %d: "
"end overwritten with %x",
toMemPtr(unit), unit->size, check2(unit)) ;
}
void messalloccheck (void)
{
int i ;
STORE_HANDLE unit ;
if (!handles) return ;
acelib/messubs.c view on Meta::CPAN
* Richard Durbin (MRC LMB, UK) rd@mrc-lmb.cam.ac.uk, and
* Jean Thierry-Mieg (CRBM du CNRS, France) mieg@kaa.cnrs-mop.fr
*
* Description: low level: encapsulates vararg messages, *printf,
* crash handler,
*
* Exported functions: see regular.h
*
* HISTORY:
* Last edited: Nov 27 15:36 1998 (fw)
* * Nov 19 13:26 1998 (edgrif): Removed the test for errorCount and messQuery
* in messerror, really the wrong place.
* * Oct 22 15:26 1998 (edgrif): Replaced strdup's with strnew.
* * Oct 21 15:07 1998 (edgrif): Removed messErrorCount stuff from graphcon.c
* and added to messerror (still not perfect), this was a new.
* bug in the message system.
* * Sep 24 16:47 1998 (edgrif): Remove references to ACEDB in messages,
* change messExit prefix to "EXIT: "
* * Sep 22 14:35 1998 (edgrif): Correct errors in buffer usage by message
* outputting routines and message formatting routines.
* * Sep 11 09:22 1998 (edgrif): Add messExit routine.
* * Sep 9 16:52 1998 (edgrif): Add a messErrorInit function to allow an
* application to register its name for use in crash messages.
* * Sep 3 11:32 1998 (edgrif): Rationalise strings used as prefixes for
* messages. Add support for new messcrash macro to replace
* messcrash routine, this includes file/line info. for
* debugging (see regular.h for macro def.) and a new
* uMessCrash routine.
* * Aug 25 14:51 1998 (edgrif): Made BUFSIZE enum (shows up in debugger).
* Rationalise the use of va_xx calls into a single macro/
* function and improve error checking on vsprintf.
* messdump was writing into messbuf half way up, I've stopped
* this and made two buffers of half the original size, one for
* messages and one for messdump.
* * Aug 21 13:43 1998 (rd): major changes to make clean from NON_GRAPHICS
* and ACEDB. Callbacks can be registered for essentially
* all functions. mess*() versions continue to centralise
* handling of ... via stdarg.
* * Aug 20 17:10 1998 (rd): moved memory handling to memsubs.c
* * Jul 9 11:54 1998 (edgrif):
* Fixed problem with SunOS not having strerror function, system
* is too old to have standard C libraries, have reverted to
* referencing sys_errlist for SunOS only.
* Also fixed problem with getpwuid in getLogin function, code
* did not check return value from getpwuid function.
* * Jul 7 10:36 1998 (edgrif):
* - Replaced reference to sys_errlist with strerror function.
* * DON'T KNOW WHO MADE THESE CHANGES...NO RECORD IN HEADER....(edgrif)
* - newformat added for the log file on mess dump.
* - Time, host and pid are now always the first things written.
* - This is for easier checking og the log.wrm with scripts etc.
* - Messquery added for > 50 minor errors to ask if user wants to crash.
* - Made user,pid and host static in messdump.
* * Dec 3 15:52 1997 (rd)
* - messout(): defined(_WINDOW) =>!defined(NON_GRAPHIC)
* * Dec 16 17:26 1996 (srk)
* * Aug 15 13:29 1996 (srk)
* - WIN32 and MACINTOSH: seteuid() etc. are stub functions
* * Jun 6 10:50 1996 (rbrusk): compile error fixes
* * Jun 4 23:31 1996 (rd)
* Created: Mon Jun 29 14:15:56 1992 (rd)
*-------------------------------------------------------------------
*/
/* $Id: messubs.c,v 1.1 2002/11/14 20:00:06 lstein Exp $ */
#include <assert.h>
#include <errno.h>
#include "regular.h"
#include "freeout.h" /* messbeep uses freeOutF */
/* This is horrible...a hack for sunos which is not standard C compliant. */
/* to allow accessing system library error messages, will disappear.... */
#ifdef SUN
extern const char *sys_errlist[] ;
#endif
/* Mac has its own routine for crashing, see messcrash for usage. */
#if !defined(MACINTOSH)
extern void crashOut (char* text) ;
#endif
acelib/messubs.c view on Meta::CPAN
/* have their own buffers. Note that there is a problem here in that this */
/* buffer can be overflowed, unfortunately because we use vsprintf to do */
/* our formatting, this can only be detected after the event. */
/* */
/* Constraints on message buffer size - applicable to ALL routines that */
/* format externally supplied strings. */
/* */
/* BUFSIZE: size of message buffers (messbuf, a global buffer for general */
/* message stuff and a private ones in messdump & messprintf). */
/* PREFIX: length of message prefix (used to report details such as the */
/* file/line info. for where the error occurred. */
/* MAINTEXT: space left in buffer is the rest after the prefix and string */
/* terminator (NULL) are subtracted. */
/* Is there an argument for putting this buffer size in regular.h ?? */
/* */
enum {BUFSIZE = 32768, PREFIXSIZE = 1024, MAINTEXTSIZE = BUFSIZE - PREFIXSIZE - 1} ;
static char messbuf[BUFSIZE] ;
acelib/messubs.c view on Meta::CPAN
char *buffer, unsigned int buflen) ;
/* Some standard defines for titles/text for messages: */
/* */
#define ERROR_PREFIX "ERROR: "
#define EXIT_PREFIX "EXIT: "
#define CRASH_PREFIX_FORMAT "FATAL ERROR reported by %s at line %d: "
#define FULL_CRASH_PREFIX_FORMAT "FATAL ERROR reported by program %s, in file %s, at line %d: "
#if defined(MACINTOSH)
#define SYSERR_FORMAT "system error %d"
#else
#define SYSERR_FORMAT "system error %d - %s"
#endif
#define PROGNAME "The program"
/* messcrash now reports the file/line no. where the messcrash was issued */
/* as an aid to debugging. We do this using a static structure which holds */
/* the information and a macro version of messcrash (see regular.h), the */
/* structure elements are retrieved using access functions. */
typedef struct _MessErrorInfo
{
char *progname ; /* Name of executable reporting error. */
char *filename ; /* Filename where error reported */
int line_num ; /* Line number of file where error
reported. */
} MessErrorInfo ;
static MessErrorInfo messageG = {NULL, NULL, 0} ;
static int messGetErrorLine() ;
static char *messGetErrorFile() ;
/* Keeps a running total of errors so far (incremented whenever messerror is */
/* called). */
static int errorCount_G = 0 ;
/* Function pointers for application supplied routines that are called when */
/* ever messerror or messcrash are called, enables application to take */
/* action on all such errors. */
static jmp_buf *errorJmpBuf = 0 ;
static jmp_buf *crashJmpBuf = 0 ;
/***************************************************************/
/********* call backs and functions to register them ***********/
static VoidRoutine beepRoutine = 0 ;
static OutRoutine outRoutine = 0 ;
static OutRoutine dumpRoutine = 0 ;
static OutRoutine errorRoutine = 0 ;
static OutRoutine exitRoutine = 0 ;
static OutRoutine crashRoutine = 0 ;
static QueryRoutine queryRoutine = 0 ;
static PromptRoutine promptRoutine = 0 ;
static IsInterruptRoutine isInterruptRoutine = 0 ;
UTIL_FUNC_DEF VoidRoutine messBeepRegister (VoidRoutine func)
{ VoidRoutine old = beepRoutine ; beepRoutine = func ; return old ; }
UTIL_FUNC_DEF OutRoutine messOutRegister (OutRoutine func)
{ OutRoutine old = outRoutine ; outRoutine = func ; return old ; }
UTIL_FUNC_DEF OutRoutine messDumpRegister (OutRoutine func)
{ OutRoutine old = dumpRoutine ; dumpRoutine = func ; return old ; }
UTIL_FUNC_DEF OutRoutine messErrorRegister (OutRoutine func)
{ OutRoutine old = errorRoutine ; errorRoutine = func ; return old ; }
UTIL_FUNC_DEF OutRoutine messExitRegister (OutRoutine func)
{ OutRoutine old = exitRoutine ; exitRoutine = func ; return old ; }
UTIL_FUNC_DEF OutRoutine messCrashRegister (OutRoutine func)
{ OutRoutine old = crashRoutine ; crashRoutine = func ; return old ; }
UTIL_FUNC_DEF QueryRoutine messQueryRegister (QueryRoutine func)
{ QueryRoutine old = queryRoutine ; queryRoutine = func ; return old ; }
acelib/messubs.c view on Meta::CPAN
strcat (mesg_buf, "\n") ; /* assume we are writing to a file */
if (dumpRoutine)
(*dumpRoutine)(mesg_buf) ;
}
/*****************************************/
/* Access function for returning running error total. */
UTIL_FUNC_DEF int messErrorCount (void) { return errorCount_G ; }
/* Output a non-fatal error message, for all messages a call to messdump is */
/* made which may result in the message being logged. The single error count */
/* is also incremented so that functions can use this to check how many */
/* errors have been recorded so far. */
UTIL_FUNC_DEF void messerror (char *format, ...)
{
char *prefix = ERROR_PREFIX ;
char *mesg_buf = NULL ;
va_list args ;
/* always increment the error count. */
++errorCount_G ;
/* Format the message string. */
ACEFORMATSTRING(args, format, mesg_buf, prefix, NULL, 0) ;
/* If application registered an error handler routine, call it. */
if (errorJmpBuf)
longjmp (*errorJmpBuf, 1) ;
/* Log the message. */
messdump(mesg_buf) ;
/* Now report the error to the user. */
if (errorRoutine)
(*errorRoutine)(mesg_buf) ;
else
fprintf (stderr, "%s\n", mesg_buf) ;
invokeDebugger () ;
}
/*******************************/
/* Use this function for errors that while being unrecoverable are not a */
/* problem with the acedb code, e.g. if the user starts xace without */
/* specifying a database. */
/* Note that there errors are logged but that this routine will exit without */
/* any chance to interrupt it (e.g. the crash routine in uMessCrash), this */
/* could be changed to allow the application to register an exit handler. */
/* */
UTIL_FUNC_DEF void messExit(char *format, ...)
{
char *prefix = EXIT_PREFIX ;
char *mesg_buf = NULL ;
va_list args ;
/* Format the message string. */
acelib/messubs.c view on Meta::CPAN
#endif
return ; /* Should never get here. */
}
/*******************************/
/* This is the routine called by the messcrash macro (see regular.h) which */
/* actually does the message/handling and exit. */
/* This routine may encounter errors itself, in which case it will attempt */
/* to call itself to report the error. To avoid infinite recursion we limit */
/* this to just one reporting of an internal error and then we abort. */
/* */
UTIL_FUNC_DEF void uMessCrash(char *format, ...)
{
enum {MAXERRORS = 1} ;
static int internalErrors = 0 ;
static char prefix[1024] ;
int rc ;
char *mesg_buf = NULL ;
va_list args ;
/* Check for recursive calls and abort if necessary. */
if (internalErrors > MAXERRORS)
{
fprintf (stderr, "%s : fatal internal error, abort",
messageG.progname);
abort() ;
}
else internalErrors++ ;
/* Construct the message prefix, adding the program name if possible. */
if (messGetErrorProgram() == NULL)
rc = sprintf(prefix, CRASH_PREFIX_FORMAT, messGetErrorFile(), messGetErrorLine()) ;
else
rc = sprintf(prefix, FULL_CRASH_PREFIX_FORMAT,
acelib/messubs.c view on Meta::CPAN
exit(EXIT_FAILURE) ;
#endif
return ; /* Should never get here. */
}
/******* interface to crash/error trapping *******/
UTIL_FUNC_DEF jmp_buf* messCatchError (jmp_buf* new)
{
jmp_buf* old = errorJmpBuf ;
errorJmpBuf = new ;
return old ;
}
UTIL_FUNC_DEF jmp_buf* messCatchCrash (jmp_buf* new)
{
jmp_buf* old = crashJmpBuf ;
crashJmpBuf = new ;
return old ;
}
acelib/messubs.c view on Meta::CPAN
enum {ERRBUFSIZE = 2000} ; /* Should be enough. */
static char errmess[ERRBUFSIZE] ;
char *mess ;
#ifdef SUN
/* horrible hack for Sunos/Macs(?) which are not standard C compliant */
mess = printToBuf(&errmess[0], ERRBUFSIZE, SYSERR_FORMAT, errno, sys_errlist[errno]) ;
#elif defined(MACINTOSH)
mess = printToBuf(&errmess[0], ERRBUFSIZE, SYSERR_FORMAT, errno) ;
#else
mess = printToBuf(&errmess[0], ERRBUFSIZE, SYSERR_FORMAT, errno, strerror(errno)) ;
#endif
return mess ;
}
/************************* message formatting ********************************/
/* This routine does the formatting of the message string using vsprintf, */
/* it copes with the format string accidentally being our internal buffer. */
/* */
/* This routine does its best to check that the vsprintf is successful, if */
/* not the routine bombs out with an error message. Note that num_bytes is */
/* the return value from vsprintf. */
/* Failures trapped: */
/* num_bytes < 0 => vsprintf failed, reason is reported. */
/* num_bytes + 1 > BUFSIZE => our internal buffer size was exceeded. */
/* (vsprintf returns number of bytes written */
/* _minus_ terminating NULL) */
/* */
static char *uMessFormat(va_list args, char *format, char *prefix,
char *buffer, unsigned int buflen)
{
acelib/messubs.c view on Meta::CPAN
}
}
#endif /* !SUN */
return(buf_ptr) ;
}
/********************** crash file/line info routines ************************/
/* When the acedb needs to crash because there has been an unrecoverable */
/* error we want to output the file and line number of the code that */
/* detected the error. Here are the functions to do it. */
/* */
/* Applications can optionally initialise the error handling section of the */
/* message package, currently the program name can be set (argv[0] in the */
/* main routine) as there is no easy way to get at this at run time except */
/* from the main. */
/* */
UTIL_FUNC_DEF void messErrorInit(char *progname)
{
if (progname != NULL) messageG.progname = strnew(filGetFilename(progname), 0) ;
return ;
acelib/messubs.c view on Meta::CPAN
assert(filename != NULL && line_num != 0) ;
/* We take the basename here because __FILE__ can be a path rather than */
/* just a filename, depending on how a module was compiled. */
messageG.filename = strnew(filGetFilename(filename), 0) ;
messageG.line_num = line_num ;
}
/* mieg: protected these func against bad return, was crashing solaris server */
/* Access functions for message error data. */
UTIL_FUNC_DEF char *messGetErrorProgram()
{
return messageG.progname ? messageG.progname : "programme_name_unknown" ;
}
static char *messGetErrorFile()
{
return messageG.filename ? messageG.filename : "file_name_unknown" ;
}
acelib/rpcace.x view on Meta::CPAN
set by client: a buffer containing the request
reponse:
set by server: a buffer containing the answer
encore:
set by server to: -1 if more data remains to be transmitted
set by client to: -1 to get the the remainder
-2 to abort the running query
** JC I prefer negative values to avoid clashes with error values in
askServer return values
clientId:
set by server on first connection,
must be retransmitted by client each time.
magic:
negotiated between the client and the server,
must be retransmitted by client each time.
cardinal:
set by server to: number of objects in the active list.
aceError:
set by server to: 100 Unrecognised command
200 Out of context command
300 Invalid command (bad nb of parms etc)
400 Syntax error in body of command
kBytes:
set by client to: Desired max size of answer,
NOT strict, server is allowed to return more
Server only splits on ace boundaries.
*/
#define HAVE_ENCORE -1
#define WANT_ENCORE -1
#define DROP_ENCORE -2
/* encore == -3 is used in aceclient && aceserver */
acelib/wh/mystdlib.h view on Meta::CPAN
/* _MAX_PATH is 260 in WIN32 but each path component can be max. 256 in size */
#undef DIR_BUFFER_SIZE
#define DIR_BUFFER_SIZE FIL_BUFFER_SIZE
#define MAXPATHLEN _MAX_PATH
#define popen _popen
#define pclose _pclose
/* rename to actual WIN32 built-in functions
* (rbrusk): this little code generated a "trigraph" error message
* when built in unix with the gcc compiler; however, I don't understand
* why gcc even sees this code, which is #if defined(WIN32)..#endif protected.
* Changing these to macros is problematic in lex4subs.c et al, which expects
* the names as function names (without parentheses. So, I change them back..
* If the trigraph error message returns, look for another explanation,
* like MSDOS carriage returns, or something? */
#define strcasecmp _stricmp
#define strncasecmp _strnicmp
#endif /* WIN32 */
#else /* not POSIX etc. e.g. SUNOS */
/* local versions of general types */
#if defined(ALLIANT) || defined (DEC) || defined(MAC_AUX) || defined(MACINTOSH)
acelib/wh/mystdlib.h view on Meta::CPAN
char * fgets (char *s, int n, FILE *stream);
FILE * fopen (const char *path, const char *mode);
int fputc (int c, FILE *stream);
int fputs (const char *s, FILE *stream);
int fseek (FILE *stream, long offset, int whence);
int fsetpos (FILE *stream, const fpos_t *pos);
long ftell (FILE *stream);
mysize_t fread (void *ptr, mysize_t size, mysize_t n, FILE *stream);
mysize_t fwrite (const void *ptr, mysize_t size, mysize_t n,
FILE *stream);
void perror (const char *s);
FILE *popen (const char *command, const char *type);
int pclose (FILE *stream);
void rewind (FILE *stream);
void setbuf (FILE *stream, char *buf);
/*int isalpha (int c); - fails for some reason with "parse error before `+'" */
char getopt (int c, char **s1, char *s2);
#endif /* defined SUN */
/************************************************************/
#ifdef SUN
/* memmove is not included in SunOS libc, bcopy is */
#define memmove(d,s,l) bcopy(s,d,l)
void bcopy(char *b1, char *b2, int length);
acelib/wh/regular.h view on Meta::CPAN
/* in C. This means that the messcrash macro will only produce a single C */
/* statement and hence can be used within brackets etc. and will not break */
/* existing code, e.g. */
/* funcblah(messcrash("hello")) ; */
/* will become: */
/* funcblah(uMessSetErrorOrigin(__FILE__, __LINE__), uMessCrash("hello")) ; */
/* */
UTIL_FUNC_DEF void messErrorInit (char *progname) ; /* Record the
applications name for use
in error messages, etc */
UTIL_FUNC_DEF char *messGetErrorProgram (void) ; /* Returns the
application name */
UTIL_FUNC_DCL char *messprintf (char *format, ...) ;
/* sprintf into (static!) string */
/* !!!! beware finite buffer size !!!! */
UTIL_FUNC_DCL void messbeep (void) ; /* make a beep */
UTIL_FUNC_DCL void messout (char *format, ...) ; /* simple message */
UTIL_FUNC_DCL void messdump (char *format, ...) ; /* write to log file */
UTIL_FUNC_DCL void messerror (char *format, ...) ; /* error message and write to log file */
UTIL_FUNC_DCL void messExit(char *format, ...) ; /* error message, write to log file & exit */
#define messcrash uMessSetErrorOrigin(__FILE__, __LINE__), uMessCrash
/* abort - but see below */
UTIL_FUNC_DCL BOOL messQuery (char *text,...) ; /* ask yes/no question */
UTIL_FUNC_DCL BOOL messPrompt (char *prompt, char *dfault, char *fmt) ;
/* ask for data satisfying format get results via freecard() */
UTIL_FUNC_DCL char* messSysErrorText (void) ;
/* wrapped system error message for use in messerror/crash() */
UTIL_FUNC_DCL int messErrorCount (void);
/* return numbers of error so far */
UTIL_FUNC_DCL BOOL messIsInterruptCalled (void);
/* return TRUE if an interrupt key has been pressed */
/**** registration of callbacks for messubs ****/
typedef void (*OutRoutine)(char*) ;
typedef BOOL (*QueryRoutine)(char*) ;
typedef BOOL (*PromptRoutine)(char*, char*, char*) ;
typedef BOOL (*IsInterruptRoutine)(void) ;
acelib/wh/regular.h view on Meta::CPAN
/**** routines to catch crashes if necessary, e.g. when acedb dumping ****/
#include <setjmp.h>
UTIL_FUNC_DCL jmp_buf* messCatchCrash (jmp_buf* ) ;
UTIL_FUNC_DCL jmp_buf* messCatchError (jmp_buf* ) ;
UTIL_FUNC_DCL char* messCaughtMessage (void) ;
/* if a setjmp() stack context is set using messCatch*() then rather than
exiting or giving an error message, messCrash() and messError() will
longjmp() back to the context.
messCatch*() return the previous value. Use argument = 0 to reset.
messCaughtMessage() can be called from the jumped-to routine to get
the error message that would have been printed.
*/
/********************************************************************/
/************** memory management - memsubs.c ***********************/
/********************************************************************/
typedef struct _STORE_HANDLE_STRUCT *STORE_HANDLE ; /* opaque outside memsubs.c */
UTIL_FUNC_DCL STORE_HANDLE handleHandleCreate (STORE_HANDLE handle) ;
#define handleCreate() handleHandleCreate(0)
acelib/wh/regular.h view on Meta::CPAN
UTIL_FUNC_DCL double randfloat (void) ;
UTIL_FUNC_DCL double randgauss (void) ;
UTIL_FUNC_DCL int randint (void) ;
UTIL_FUNC_DCL void randsave (int *arr) ;
UTIL_FUNC_DCL void randrestore (int *arr) ;
/* Unix debugging. */
/* put "break invokeDebugger" in your favourite debugger init file */
/* this function is empty, it is defined in messubs.c used in
messerror, messcrash and when ever you need it.
*/
UTIL_FUNC_DCL void invokeDebugger(void) ;
/*******************************************************************/
/************* some WIN32 debugging utilities **********************/
#if defined (WIN32)
( run in 0.624 second using v1.01-cache-2.11-cpan-65fba6d93b7 )