[MOBY-guts] biomoby commit
Mark Wilkinson
mwilkinson at pub.open-bio.org
Thu Mar 18 23:10:34 UTC 2004
mwilkinson
Thu Mar 18 18:10:34 EST 2004
Update of /home/repository/moby/moby-live/Perl/MOBY
In directory pub.open-bio.org:/tmp/cvs-serv8029/Perl/MOBY
Modified Files:
CommonSubs.pm
Log Message:
various bug fixes. Added the ability to create a serviceNotes block. Don't know if this will break the clients or not because I haven't tested them yet. See CommonSubs pod (responseHeader) for details
moby-live/Perl/MOBY CommonSubs.pm,1.40,1.41
===================================================================
RCS file: /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm 2003/12/30 20:21:30 1.40
+++ /home/repository/moby/moby-live/Perl/MOBY/CommonSubs.pm 2004/03/18 23:10:34 1.41
@@ -481,12 +481,16 @@
=head2 responseHeader
- name : responseHeader($auth)
- function : print the XML string of a MOBY response header
- usage : return responseHeader('illuminae.com') . $DATA . responseFooter;
- args : a string representing the service providers authority URI
- caveat : will soon be expanded to include service provision info
- and additional namespace declarations
+ name : responseHeader
+ function : print the XML string of a MOBY response header +/- serviceNotes
+ usage : responseHeader('illuminae.com')
+ responseHeader(
+ -authority => 'illuminae.com',
+ -note => 'here is some data from the service provider')
+ args : a string representing the service providers authority URI,
+ OR a set of named arguments with the authority and the
+ service provision notes.
+ caveat :
notes : returns everything required up to the response articles themselves.
i.e. something like:
<?xml version='1.0' encoding='UTF-8'?>
@@ -498,12 +502,18 @@
sub responseHeader {
- my ($auth) = @_;
+ use HTML::Entities ();
+ my ($auth, $notes) = &_rearrange([qw[AUTHORITY NOTE]], @_);
$auth ||="not_provided";
- return "<?xml version='1.0' encoding='UTF-8'?>
- <moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>
- <moby:Response moby:authority='$auth'>
- ";
+ $notes ||="";
+ my $xml = "<?xml version='1.0' encoding='UTF-8'?>".
+ "<moby:MOBY xmlns:moby='http://www.biomoby.org/moby' xmlns='http://www.biomoby.org/moby'>".
+ "<moby:Response moby:authority='$auth'>";
+ if ($notes){
+ my $encodednotes = HTML::Entities::encode($notes);
+ $xml .="<moby:serviceNotes>$encodednotes</moby:serviceNotes>";
+ }
+ return $xml;
}
@@ -522,9 +532,7 @@
sub responseFooter {
- return "
- </moby:Response>
- </moby:MOBY>\n"
+ return "</moby:Response></moby:MOBY>";
}
@@ -1159,4 +1167,89 @@
namespace => $ns->getValue,
id => $id->getValue,
);
-}
\ No newline at end of file
+}
+
+
+# _rearrange stolen from BioPerl's Bio::RootI.pm
+# because it is just so useful!
+
+=head2 _rearrange
+
+ Usage : $object->_rearrange( array_ref, list_of_arguments)
+ Purpose : Rearranges named parameters to requested order.
+ Example : $self->_rearrange([qw(SEQUENCE ID DESC)], at param);
+ : Where @param = (-sequence => $s,
+ : -desc => $d,
+ : -id => $i);
+ Returns : @params - an array of parameters in the requested order.
+ : The above example would return ($s, $i, $d).
+ : Unspecified parameters will return undef. For example, if
+ : @param = (-sequence => $s);
+ : the above _rearrange call would return ($s, undef, undef)
+ Argument : $order : a reference to an array which describes the desired
+ : order of the named parameters.
+ : @param : an array of parameters, either as a list (in
+ : which case the function simply returns the list),
+ : or as an associative array with hyphenated tags
+ : (in which case the function sorts the values
+ : according to @{$order} and returns that new array.)
+ : The tags can be upper, lower, or mixed case
+ : but they must start with a hyphen (at least the
+ : first one should be hyphenated.)
+ Source : This function was taken from CGI.pm, written by Dr. Lincoln
+ : Stein, and adapted for use in Bio::Seq by Richard Resnick and
+ : then adapted for use in Bio::Root::Object.pm by Steve Chervitz,
+ : then migrated into Bio::Root::RootI.pm by Ewan Birney.
+ Comments :
+ : Uppercase tags are the norm,
+ : (SAC)
+ : This method may not be appropriate for method calls that are
+ : within in an inner loop if efficiency is a concern.
+ :
+ : Parameters can be specified using any of these formats:
+ : @param = (-name=>'me', -color=>'blue');
+ : @param = (-NAME=>'me', -COLOR=>'blue');
+ : @param = (-Name=>'me', -Color=>'blue');
+ : @param = ('me', 'blue');
+ : A leading hyphenated argument is used by this function to
+ : indicate that named parameters are being used.
+ : Therefore, the ('me', 'blue') list will be returned as-is.
+ :
+ : Note that Perl will confuse unquoted, hyphenated tags as
+ : function calls if there is a function of the same name
+ : in the current namespace:
+ : -name => 'foo' is interpreted as -&name => 'foo'
+ :
+ : For ultimate safety, put single quotes around the tag:
+ : ('-name'=>'me', '-color' =>'blue');
+ : This can be a bit cumbersome and I find not as readable
+ : as using all uppercase, which is also fairly safe:
+ : (-NAME=>'me', -COLOR =>'blue');
+ :
+ : Personal note (SAC): I have found all uppercase tags to
+ : be more managable: it involves less single-quoting,
+ : the key names stand out better, and there are no method naming
+ : conflicts.
+ : The drawbacks are that it's not as easy to type as lowercase,
+ : and lots of uppercase can be hard to read.
+ :
+ : Regardless of the style, it greatly helps to line
+ : the parameters up vertically for long/complex lists.
+
+=cut
+
+
+sub _rearrange {
+# my $dummy = shift;
+ my $order = shift;
+
+ return @_ unless (substr($_[0]||'',0,1) eq '-');
+ push @_,undef unless $#_ %2;
+ my %param;
+ while( @_ ) {
+ (my $key = shift) =~ tr/a-z\055/A-Z/d; #deletes all dashes!
+ $param{$key} = shift;
+ }
+ map { $_ = uc($_) } @$order; # for bug #1343, but is there perf hit here?
+ return @param{@$order};
+}
More information about the MOBY-guts
mailing list