Permalink
Browse files

added Client code and test

svn path=/bioperl-corba-client/trunk/; revision=26
  • Loading branch information...
1 parent 57902d2 commit 88db82b24d848558149c026d57da00a0635e67b4 @hyphaltip hyphaltip committed Jul 24, 2000
Showing with 220 additions and 0 deletions.
  1. +159 −0 Bio/CorbaClient/Client.pm
  2. +61 −0 t/Client.t
@@ -0,0 +1,159 @@
+
+#
+# BioPerl module for Bio::CorbaClient::Client
+#
+# Jason Stajich <jason@chg.mc.due.edu>
+#
+# Copyright Jason Stajich
+#
+# You may distribute this module under the same terms as perl itself
+
+# POD documentation - main docs before the code
+
+=head1 NAME
+
+Bio::CorbaClient::Client - BioCorba basic server object used for allocating other BioCorba objects
+
+=head1 SYNOPSIS
+
+ use Bio::CorbaClient::Client;
+ # in this example we build a SeqDB
+ # have a SeqDB object already called $seqdbref
+ my $server = new Bio::CorbaClient::Client( -idl => 'biocorba.idl',
+ -ior => 'obj.ior',
+ -orbname=> 'orbit-local-orb');
+ my $seqdb = $server->new_object( -object=> 'Bio::DB::Biocorba',
+ -args => [ 'dbname-here', $seqdbref ] );
+
+ $server->start();
+
+=head1 DESCRIPTION
+
+This object provides BioCorba object creation support.
+
+=head1 FEEDBACK
+
+=head2 Mailing Lists
+
+User feedback is an integral part of the evolution of this
+and other Bioperl modules. Send your comments and suggestions preferably
+ to one of the Bioperl mailing lists.
+Your participation is much appreciated.
+
+ bioperl-l@bio.perl.org - General discussion
+ bioperl-guts-l@bio.perl.org - Technically-oriented discussion
+ http://bio.perl.org/MailList.html - About the mailing lists
+
+=head2 Reporting Bugs
+
+Report bugs to the Bioperl bug tracking system to help us keep track
+ the bugs and their resolution.
+ Bug reports can be submitted via email or the web:
+
+ bioperl-bugs@bio.perl.org
+ http://bio.perl.org/bioperl-bugs/
+
+=head1 AUTHOR - Jason Stajich
+
+Email jason@chg.mc.duke.edu
+
+
+=head1 APPENDIX
+
+The rest of the documentation details each of the object methods. Internal methods are usually preceded with a _
+
+=cut
+
+# object code begins
+
+package Bio::CorbaClient::Client;
+
+use vars qw($AUTOLOAD @ISA);
+use strict;
+
+use CORBA::ORBit idl => [ 'biocorba.idl' ];
+
+use Bio::Root::Object;
+use Bio::CorbaServer::Base;
+
+
+@ISA = qw ( Bio::Root::Object );
+
+sub _initialize {
+
+ my ( $self, @args ) = @_;
+
+ my ( $idl, $ior, $orbname ) = $self->_rearrange( [ qw(IDL IOR ORBNAME)],
+ @args);
+
+ $self->{_ior} = $ior || $self->throw("must provide an ior file to open");
+ $self->{_idl} = $idl || 'biocorba.idl';
+ $self->{_orbname} = $orbname || 'orbit-local-orb';
+
+ my $orb = CORBA::ORB_init($orbname);
+ open( IOR, $self->{_ior}) || $self->throw("cannot open ior file " . $self->{_ior});
+
+ my $iorfile = <IOR>;
+ chomp($iorfile);
+ $self->{_orb} = $orb;
+ $self->{_iorfile} = $iorfile;
+ return $self;
+}
+
+sub new_object {
+ my ($self, @args) = @_;
+
+ my ( $objectname, $args) = $self->_rearrange( [qw(OBJECT ARGS)],
+ @args);
+
+ $self->throw("must have an object name before server can allocate a new object\n")
+ if( !defined $objectname );
+
+ my $obj;
+ if ( &_load_module($objectname) == 0 ) { # normalize capitalization
+ return undef;
+ }
+ $args = [ () ] if( !defined $args );
+ $obj = $objectname->new( $self->{_orb}->string_to_object($self->{_iorfile}), @$args );
+ if( @$ || !defined $obj ) {
+ $self->throw("Cannot instantiate object of type $objectname");
+ }
+ push @{$self->{_clientobjs}}, $obj;
+ return $obj;
+}
+
+=head2 _load_module
+
+ Title : _load_module
+ Usage : *INTERNAL BioCorba Server stuff*
+ Function: Loads up (like use) a module at run time on demand
+ Example :
+ Returns :
+ Args :
+
+=cut
+
+sub _load_module {
+ my ($format) = @_;
+ my ($module, $load, $m);
+ $format =~ s/::/\//g;
+ $load = "$format.pm";
+ $module = "_<$format.pm";
+
+ return 1 if $main::{$module};
+ eval {
+ require $load;
+ };
+ if ( $@ ) {
+ print STDERR <<END;
+$load: $format cannot be found
+Exception $@
+For more information about the Bio::CorbaClient::Client system
+please see the Bio::CorbaClient::Client docs.
+This includes ways of checking for formats at compile time, not run time
+END
+ ;
+ return;
+ }
+ return 1;
+}
View
@@ -0,0 +1,61 @@
+## Bioperl Test Harness Script for Modules
+##
+
+
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.t'
+
+#-----------------------------------------------------------------------
+## perl test harness expects the following output syntax only!
+## 1..3
+## ok 1 [not ok 1 (if test fails)]
+## 2..3
+## ok 2 [not ok 2 (if test fails)]
+##
+## etc. etc. etc. (continue on for each tested function in the .t file)
+#-----------------------------------------------------------------------
+
+
+## We start with some black magic to print on failure.
+BEGIN { $| = 1; print "1..2\n";
+ use vars qw($loaded); }
+
+END {print "not ok 1\n" unless $loaded;}
+
+
+use Bio::CorbaClient::Client;
+
+$loaded = 1;
+print "ok 1\n"; # 1st test passes.
+
+## End of black magic.
+##
+## Insert additional test code below but remember to change
+## the print "1..x\n" in the BEGIN block to reflect the
+## total number of tests that will be run.
+
+eval {
+ my $client = new Bio::CorbaClient::Client( -idl => 'biocorba.idl',
+ -ior => 'seqdbsrv.ior',
+ -orbname => 'orbit-local-orb');
+
+ my $db = $client->new_object('Bio::DB::Biocorba');
+
+ my @ids = $db->get_all_primary_ids();
+ print "ids are ", join("\n", @ids), "\n";
+
+ my $iter = $db->get_PrimarySeq_stream;
+ my $seq;
+ while( defined($seq = $iter->next_primary_seq()) ) {
+ print "display id is ", $seq->display_id, " seq is ", $seq->seq, "\n";
+ }
+};
+
+if ($@) {
+ print STDERR "test Failed: Make sure a the file $ior_file exists and was created by a running SeqDB server\n";
+ print "not ok 2\n";
+} else {
+ print "ok 2\n";
+}
+
+

0 comments on commit 88db82b

Please sign in to comment.