[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at dev.open-bio.org
Tue Jan 28 22:45:12 UTC 2003
Tue Jan 28 17:45:11 EST 2003
Update of /home/repository/moby/moby-live/Perl/Central/MOBY
In directory dev:/tmp/cvs-serv20004/Central/MOBY
Modified Files:
Central.pm
Log Message:
switched off debugging logs
moby-live/Perl/Central/MOBY Central.pm,1.2,1.3
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/Central/MOBY/Central.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- /tmp/T05daqgN 2003-01-28 17:45:12.060011457 -0500
+++ /tmp/T16daqgN 2003-01-28 17:45:12.070004632 -0500
@@ -15,7 +15,7 @@
-my $debug = 1;
+my $debug = 0;
if ($debug){open (OUT, ">/tmp/CentralRegistryLogOut.txt") || die "cant open logfile\n";print OUT "created logfile\n";close OUT;}
@@ -165,7 +165,7 @@
sub _dbAccess {
my $filename = "./MOBY/central.cfg";# $self->config;
- &_LOG("trying to open file $filename\n");
+ $debug && &_LOG("trying to open file $filename\n");
open (IN, $filename) || die "can't open configuration file $filename: $!";
my $url = <IN>; chomp $url;
my $dbname = <IN>; chomp $dbname;
@@ -175,9 +175,9 @@
my ($dsn) = "DBI:mysql:$dbname:$url";
- &_LOG("connecting to db with params $dsn, $username, $password\n");
+ $debug && &_LOG("connecting to db with params $dsn, $username, $password\n");
my $dbh = DBI->connect($dsn, $username, $password, {RaiseError => 1}) or die "can't connect to database";
- &_LOG("CONNECTED!\n");
+ $debug && &_LOG("CONNECTED!\n");
my %sth;
# queries required for registration
@@ -474,7 +474,7 @@
}
my ($acc) = &_deregisterObjectPayload($payload);
- &_LOG("object accession $acc\n");
+ $debug && &_LOG("object accession $acc\n");
unless ($acc){
my $reg = &Registration({
success => 0,
@@ -652,7 +652,7 @@
sub _registerServiceTypePayload {
my ($payload) = @_;
- &_LOG("_registerServiceTypePayload payload=$payload\n");
+ $debug && &_LOG("_registerServiceTypePayload payload=$payload\n");
my $Parser = new XML::DOM::Parser;
my $doc = $Parser->parse($payload);
my $Object = $doc->getDocumentElement();
@@ -662,7 +662,7 @@
my $type = &_nodeTextContent($Object, "serviceType");
my $desc = &_nodeTextContent($Object, "description");
my @ISA = &_nodeArrayContent($Object, "ISA");
- &_LOG("got $type, $desc, @ISA from registerServiceTypePayload\n");
+ $debug && &_LOG("got $type, $desc, @ISA from registerServiceTypePayload\n");
return ($type, $desc, \@ISA);
}
@@ -1265,7 +1265,7 @@
sub deregisterService {
my ($pkg, $payload) = @_;
- &_LOG("\nstarting deregistration\n");
+ $debug && &_LOG("\nstarting deregistration\n");
my ($reg_id) = &_deregisterServicePayload($payload);
unless ($reg_id){
my $reg = &Registration({
@@ -1294,7 +1294,7 @@
sub _deregisterServicePayload {
my ($payload) = @_;
- &_LOG("deregisterService payload: ",($payload),"\n");
+ $debug && &_LOG("deregisterService payload: ",($payload),"\n");
my $Parser = new XML::DOM::Parser;
my $doc = $Parser->parse($payload);
my $Object = $doc->getDocumentElement();
@@ -1513,7 +1513,7 @@
if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
- _LOG("*************************\ Query is: $query\n****************************");
+ $debug && &_LOG("*************************\ Query is: $query\n****************************");
return &_getValidServices($dbh, $sth_hash, $query);
}
@@ -1593,7 +1593,7 @@
my ($serviceType, $AuthURI, $OUT, $full_objects, $full_services) = &_locateServiceByOutputPayload($payload);
unless (defined $full_objects){$full_objects = 1}
unless (defined $full_services){$full_services = 1}
- &_LOG("RECEIVED PARAMS", @_);
+ $debug && &_LOG("RECEIVED PARAMS", @_);
# this one has to be generated dynamically...
return undef unless $OUT;
my ($dbh, $sth_hash) = &_dbAccess;
@@ -1601,21 +1601,21 @@
my %sth = %{$sth_hash};
if ($serviceType && $full_services){ # we need this service type and all child types
- &_LOG("Traversing Service DAG");
+ $debug && &_LOG("Traversing Service DAG");
@ServiceIDs = &_traverseServiceDAG($dbh, $serviceType, $sth_hash);
} elsif ($serviceType) { # we need only the service type of this element
- &_LOG("NOT Traversing Service DAG");
+ $debug && &_LOG("NOT Traversing Service DAG");
my $sth = $dbh->prepare($sth{get_service_type_id});
$sth->execute($serviceType);
@ServiceIDs = $sth->fetchrow_array;
}
- &_LOG("FINISHED Traversing Service DAG");
+ $debug && &_LOG("FINISHED Traversing Service DAG");
my (@ObjectIDs, %ObjectIDs);
if ($full_objects){ # we need this Object type and all parent types
- &_LOG("traversing Object DAG for $OUT");
+ $debug && &_LOG("traversing Object DAG for $OUT");
foreach (&_traverseObjectDAG($dbh, $OUT, $sth_hash, 'c')){
- &_LOG("found $_ in Object DAG");
+ $debug && &_LOG("found $_ in Object DAG");
$ObjectIDs{$_}=1;
}
@ObjectIDs = keys %ObjectIDs;
@@ -1625,9 +1625,9 @@
push @ObjectIDs, $sth->fetchrow_array;
}
- &_LOG("OUT $OUT ::: @ObjectIDs\n");
+ $debug && &_LOG("OUT $OUT ::: @ObjectIDs\n");
# if ($NSs){&_LOG("NSs @{$NSs} \n")};
- if ($serviceType){&_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
+ if ($serviceType){$debug && &_LOG("Servicetypes $serviceType, @ServiceIDs\n")};
my $query = "
Select
@@ -1665,7 +1665,7 @@
if ($serviceType){ $query .= "and (S.service_type_id in (".(join ',', @ServiceIDs).")) "} # service type is a DAG, so get all relevant types
if ($AuthURI){ $query .= "and (S.auth_uri = '$AuthURI') "}
- _LOG("*************************\ Query is: $query\n****************************");
+ $debug && &_LOG("*************************\ Query is: $query\n****************************");
return &_getValidServices($dbh, $sth_hash, $query);
}
@@ -1734,7 +1734,7 @@
if ($wsdl){
$wsdls .= "<Service><![CDATA[$wsdl]]></Service>\n";
}
- #&_LOG("WSDL_________________$wsdls\n____________________");
+ #$debug && &_LOG("WSDL_________________$wsdls\n____________________");
return $wsdls;
}
@@ -2126,11 +2126,11 @@
return undef unless $root_id;
if ($dir eq "p"){
- _LOG("getting parents");
+ $debug && &_LOG("getting parents");
$sth = $dbh->prepare($sth{get_object_parent_list});
}
else {
- _LOG("getting children");
+ $debug && &_LOG("getting children");
$sth = $dbh->prepare($sth{get_object_child_list});
}
@@ -2156,12 +2156,12 @@
# will get text of **all** child $node from the given $DOM
# regardless of their depth!!
my ($DOM, $node) = @_;
- &_LOG("_nodeTextContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
+ $debug && &_LOG("_nodeTextContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
my $x = $DOM->getElementsByTagName($node);
my @child = $x->item(0)->getChildNodes;
my $content;
foreach (@child){
- &_LOG($_->getNodeTypeName, "\t", $_->toString,"\n");
+ $debug && &_LOG($_->getNodeTypeName, "\t", $_->toString,"\n");
next unless $_->getNodeType == TEXT_NODE;
$content = $_->toString;
}
@@ -2172,7 +2172,7 @@
# will get array content of all child $node from given $DOM
# regardless of depth!
my ($DOM, $node) = @_;
- &_LOG("_nodeArrayContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
+ $debug && &_LOG("_nodeArrayContext received DOM: ", $DOM->toString,"\nsearching for node $node\n");
my @result;
my $x = $DOM->getElementsByTagName($node);
my @child = $x->item(0)->getChildNodes;
More information about the MOBY-guts
mailing list