[MOBY-guts] biomoby commit

[Eddie Kawas]

kawas
Tue Apr 29 15:58:37 EDT 2008
Update of /home/repository/moby/moby-live/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators
In directory dev.open-bio.org:/tmp/cvs-serv10354/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators

Modified Files:
	GenServices.pm 
Log Message:
added support for biomoby services of category cgi 
moby-live/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators GenServices.pm,1.4,1.5
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators/GenServices.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- /home/repository/moby/moby-live/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators/GenServices.pm	2008/03/31 18:04:47	1.4
+++ /home/repository/moby/moby-live/Perl/MOSES-MOBY/lib/MOSES/MOBY/Generators/GenServices.pm	2008/04/29 19:58:37	1.5
@@ -21,6 +21,10 @@
 use MOSES::MOBY::Def::Relationship;
 use strict;
 
+# add versioning to this module
+use vars qw /$VERSION/;
+$VERSION = sprintf "%d.%02d", q$Revision$ =~ /: (\d+)\.(\d+)/;
+
 #-----------------------------------------------------------------
 # A list of allowed attribute names. See MOSES::MOBY::Base for details.
 #-----------------------------------------------------------------
@@ -268,6 +272,83 @@
 }
 
 #-----------------------------------------------------------------
+# generate_cgi
+#-----------------------------------------------------------------
+sub generate_cgi {
+    my ($self, @args) = @_;
+    my %args =
+	( # some default values
+	  outdir        => $self->outdir . "/../cgi",
+	  cachedir      => $self->cachedir,
+	  registry      => $self->registry,
+	  service_names => [],
+
+	  # other args, with no default values
+	  # authority     => 'authority'
+	  # outcode       => ref SCALAR
+
+	  # and the real parameters
+	  @args );
+    $self->_check_outcode (%args);
+    
+    my $outdir = File::Spec->rel2abs ($args{outdir});
+    $LOG->debug ("Arguments for generating cgi services: " . $self->toString (\%args))
+	if ($LOG->is_debug);
+    $LOG->info ("CGI Services will be generated into: '$outdir'")
+	unless $args{outcode};
+
+    # get objects from a local cache
+    my $cache = MOSES::MOBY::Cache::Central->new (cachedir => $args{cachedir}, registry => $args{registry});
+    my @names = ();
+    push (@names, $args{authority}, @{ $args{service_names} })
+	if $args{authority};
+    my @services = $cache->get_services (@names);
+
+    # generate from template
+    my $tt = Template->new ( ABSOLUTE => 1 );
+    my $input = File::Spec->rel2abs ( MOSES::MOBY::Generators::Utils->find_file
+				      ($Bin,
+				       'MOSES', 'MOBY', 'Generators', 'templates',
+				       'service-cgi.tt') );
+
+    foreach my $obj (@services) {
+	my $name = $obj->name;
+	$LOG->debug ("$name\n");
+	if ($args{outcode}) {
+	    # check if the same service is already loaded
+	    # (it can happen when this subroutine is called several times)
+	    next if eval '%' . $obj->module_name . '::';
+	    $tt->process ( 
+	    	$input, 
+	    	{ 
+	    		obj 		  => $obj, 
+	    	  	pmoses_home   => $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_DIR,
+	    	  	generated_dir => $MOBYCFG::GENERATORS_OUTDIR,
+	    	  	services_dir  => $MOBYCFG::GENERATORS_IMPL_OUTDIR,
+	    	},
+			$args{outcode} )
+		 || $LOG->logdie ($tt->error());
+	} else {
+	    # we cannot easily check whether the same file was already
+	    # generated - so we don't
+	    my $outfile =
+		File::Spec->catfile ( $outdir, split (/\./, $obj->authority), $obj->name )
+		. '.cgi';
+	    $tt->process ( $input, 
+	    	{ 
+	    		obj 		  => $obj, 
+	    	  	pmoses_home   => $MOBYCFG::USER_REGISTRIES_USER_REGISTRIES_DIR,
+	    	  	generated_dir => $MOBYCFG::GENERATORS_OUTDIR,
+	    	  	services_dir  => $MOBYCFG::GENERATORS_IMPL_OUTDIR,
+	    	},
+			   $outfile ) || $LOG->logdie ($tt->error());
+		chmod 0755, $outfile;
+	}
+    }
+}
+
+
+#-----------------------------------------------------------------
 # update_table
 #-----------------------------------------------------------------
 sub update_table {