# 2004/05/06 : oneiros : 0.6.0 : Initial version
# 2004/05/07 : oneiros : 0.6.1 : _ThrowError was returning improper ar
+guments.
# 2004/07/?? : oneiros : 0.6.2 : using 'Vxxx' format for errors.
# 2004/07/29 : oneiros : 0.6.3 : Finished merging in 'GetData' and rel
+ated functions.
#                              : _ThrowError can now get passed debugg
+ing info as a second arg.
# 2004/08/03 : oneiros :       : missed a few error codes to 'Vxxx' fo
+rmat.
# 2004/08/09 : oneiros :       : only load XML::Simple when needed; us
+e Base64 encoding
# 2004/08/12 : oneiros : 0.7   : using 'VSO-Dxxx' format for errors re
+turned.
# 2004/09/10 : oneiros :       : handle undefined $arrayRef in _Packag
+eData()
# 2004/09/14 : oneiros : 0.7.1 : handle strict typed inputs better.
# 2004/09/16 : oneiros : 0.7.2 : moving Core's 'prepare_out' bits to _
+PackageData().
# 2004/09/17 : oneiros :       : added providerID to returned results.
# 2004/09/17 : oneiros :       : handle multiple <block> elements in o
+ne <query> block.
# 2004/09/22 : oneiros :       : using UNIVERSAL::isa for HASH & ARRAY
+ checks
# 2004/09/23 : karen   :       : fixed some error checking in GetData

# 2004/??/?? : oneiros :       : flag returned from _NegotiateReturnMe
+thod, per igor.

# 2004/10/12 : oneiros : 0.8.0 : moved namespace to Physics::Solar::VS
+O
# 2004/10/15 : karen   :       : no longer need 2 supported data metho
+ds (fixed docs)
# 2004/10/22 : oneiros :       : always return dataids from GetData
# 2004/11/02 : oneiros : 0.8.1 : removing all calls to SOAP::Data (usi
+ng new serializer)
# 2004/11/04 : oneiros :       : a litle bit of data massaging within 
+GetData incase request was modified in GetDataInner
# 2004/11/05 : oneiros : 0.8.2 : blessing all hashes/arrays for serial
+ization efforts.
# 2004/11/12 : oneiros : 0.8.3 : serializer was naming 'fileid' array 
+'fileids' in one location
# 2004/11/17 : oneiros : 0.8.4 : changes to the BuildTemplate program,
+ and the template contents
# 2004/12/03 : oneiros : 1.0.0 : officialy numbered 1.0
# 2005/01/06 : oneiros : 1.0.1 : commented out some old pod
# 2005/04/15 : oneiros : 1.0.2 : Handle multiple data blocks in one re
+quest.
#                                (Core should make sure this never hap
+pens, though)
# 2005/05/12 : igor    : 1.0.3 : added _WaveConversion function
# 2005/05/23 : oneiros : 1.2.0 : okay to pass angstroms to _WaveConver
+sion

package Physics::Solar::VSO::DataProvider;

$VERSION  = 1.02_00;

use 5.006;
use strict;
use warnings;

use SOAP::Lite;
use UNIVERSAL qw(isa);


{

## needed for stub function error messages.
## (so if we ever move this, I don't have to find/replace)
#my $__PackageName = 'VSO::DataProvider';

# VSO Version support info
my $__vsoVersionSupported = 1.0;

# arguments for XML::Simple parsing & output.

my %__ParserArgs = ( SuppressEmpty => '' );
#my %__OutputArgs = ( RootName => 'xml', XMLDecl => 1, NoAttr => 1 );
my %__OutputArgs = ( RootName => 'xml', XMLDecl => 1, KeyAttr => [ '_n
+ame' ],
        ValueAttr => { anon => '_value' } );


#my $debug = 1;

##########
# Publicly Accessible Functions

#####
# New

# create a new DataProvider.

    sub new
    {
        my $class = shift;
        $class = ref($class) || $class;
        return bless {}, $class;
    }

#####
# Ping
#
#   Input:
#       None
#   Output:
#       Scalar status, with the following options:
#           0     : something seems wrong
#           1     : everything seems good
#           undef : unknown status

    sub Ping
    {
        return undef;
    }

#####
# Query

# Input:
#   hash ref, containing a full VSO query w/ headers
#       ( or an XML string, containing the same )
# Output:
#   hash ref, containing a response or error message.
#       ( or an XML string, if the input was an XML string )
    sub Query
    {
        my ($self, $query) = @_;

        # Determine the format of the query

        if (! ref($query))

        { # we were passed a scalar value.  We'll assume it's an XML s
+tring
            # unpack the XML string, then pass the result back to this
+ function.
            # any results are rencoded as XML, and returned.

            require XML::Simple;
            return
                $self->Query
                (
                    XML::Simple::XMLin ( $query, %__ParserArgs )
            );

        } elsif ( !$query || ! UNIVERSAL::isa( $query, 'HASH') )
        { # anything left that's not a hash.
            return $self->_ThrowError ('400 Bad Request - Improper For
+mat');
        } # else case is a HASH, which don't require extra processing.


        #####
        # VSO Query Header Validation
        # Note -- this function ONLY looks at the block around the que
+ry,
        #         not the actual query itself, which would be a functi
+on
        #         of the individual data provider.

        # in theory, the registry will be sending the correct version
        # of the query format to each registry.  Just in case it didn'
+t,
        # throw an error.

        if ($query->{'version'} > $self->_VSOVersionSupported())
        {
            return $self->_ThrowError ('505 Version not supported');
        }

        # did we get a 'block' element, so we can do a search?

        if ( ! defined($query->{'block'}) )
        {
            return $self->_ThrowError ('400 Bad Request - Missing BLOC
+K');
        }
        
        #
        # We have multiple queries.  We're calling a function
        # to handle this, so that a data provider could override
        # that function, if they can handle the more complex
        # input through some other means.
        # 
                elsif ( UNIVERSAL::isa($query->{'block'}, 'ARRAY') ) {
                        return $self->_SearchMultiple( $query->{'block
+'} );
                }
                elsif ( ! UNIVERSAL::isa($query->{'block'}, 'HASH') )
                {
                        return $self->_ThrowError ('400 Bad Request - 
+Invalid BLOCK');
                }
                
    #####
    # Do the actual searching

    # this _should_ be handed off to the individual data provider.

    # the return from this should be either the output from _ThrowErro
+r or
    # _PackageResults, depending if an error were generated, or a vali
+d
    # result set.

        return scalar $self->_Search( $query->{'block'} );

    }

#   sub _SearchMultiple {
#           my ($self, $block) = @_;
# 
#           return $self->__MergeResults(
#                   map { $self->_Search( $_ ) } @{ $block }
#           );
#   }
# 
#   # It's possible that I could just send an array back, that would
#   # break the API, I think.
# 
#   # what do we do if there's a partial success?  (some success
#   # responses, some error responses?
#   
#   # we might also lose metadata for multiple reasons -- 
#   # We merge three result sets that return (100/300, 100/200, 50/50)
#   # results -- that might be 250/300, due to the later two being
#   # data products that the first one didn't return, or it might
#   # be 100/550, if the three all returned from the same set of data,
#   # but had different non-returned values.
#   
#   # we then come to a difficult question -- is it better to tell
#   # something that is probably incorrect, or not to report anything?
#   
#   
#   sub __MergeResults {
#           my $self = shift;
# 
#           return @_;
# 
#   }



#####
# Search (stub)

# Input:
#   hash ref, containing search parameters
# Output:
#   scalar, number of records found (or undef if unknown)
#   array ref, the records found.

# See VSO::DataProvider::SDAC for an example of how to use this.

    __NewStubFunction ( '_Search' );

    sub __NewStubFunction {
        my $functionName = shift;
        my $packageName = caller;

        no strict 'refs';

        *{$functionName} = sub {
            my $self = shift;
            my $caller = ref($self);

            require Carp;
            if ($caller eq $packageName) {
                Carp::croak ("$packageName is an abstract class.\nYou 
+must inherit it to use it correctly.\n");
            } else {
                Carp::croak ("Package '$caller' must define the functi
+on $functionName to use $packageName correctly\n");
            }
        }
    }


#############################################
## Wave manipulation methods
#############################################
# wl [Angstrom] = 12.40 / E [keV]
# wl [Angstrom] = 2.998e9 / f [GHz]
    sub _WaveConversion {
      shift if ref ($_[0]) =~ /::/;

      my ($wave) = @_;
      return $wave if ( lc($wave->{waveunit}) eq 'angstrom' );
      my $wave2;

      if (lc($wave->{waveunit}) eq 'kev') {
        if (defined($wave->{wavemax})) {
          $wave2->{wavemin} = 12.40 / $wave->{wavemax};
        } 
        if (defined($wave->{wavemin})) {
          $wave2->{wavemax} = 12.40 / $wave->{wavemin};
        }
      } elsif (lc($wave->{waveunit}) eq 'ghz') {
        if (defined($wave->{wavemax})) {
          $wave2->{wavemin} = 2.998e9 / $wave->{wavemax};
        }
        if (defined($wave->{wavemin})) {
          $wave2->{wavemax} = 2.998e9 / $wave->{wavemin};
        }
      }

      $wave2->{waveunit} = 'Angstrom';

      return $wave2;
    }



#####
# VSO Versions Supported

# accessor function, so if need be, someone inheriting this can
# override it.

    sub _VSOVersionSupported
    {
        return $__vsoVersionSupported;
    }


#####
# Valid Date

# technically, we're searching to make sure it's a 14 digit number.
# It might not correspond to a real time/day (eg. 32nd of Feb at 26 o'
+clock)

# You can override this if you prefer better checking

# Input:
#   a date string
# Output:
#   scalar (1 if good, 0 if bad)


    sub _ValidDate {
        my ($self, $date) = @_;

        return 0 if !defined($date);
        return 0 if length($date) != 14;
        return 0 if ($date =~ m/[^0-9]/);
        return 1;
    }

#####
# Package Results

# Input:
#   count of the total number of records found
#   array reference to the records to be returned.
#       (array of hashes)
#   (optional) list of extra options.  currently supported:
#       debug => extra debugging message to insert into results

# Output:
#   hash ref, the packaged results.

    sub _PackageResults {
        my ($self, $numFound, $recordsRef, %options) = @_;

        my $results = bless {
                version                 => $self->_VSOVersionSupported
+,
                no_of_records_found     => $numFound,
                no_of_records_returned  => scalar @{ $recordsRef || []
+ },
                record                  => $recordsRef,
#                record                  => $self->__PackageRecords($r
+ecordsRef),
                provider                => $self->_ProviderID(),
            }, 'QueryResponse';

        if (defined($options{'debug'})) {
            $results->{'debug'} = $options{'debug'};
        }

        return $results;
    }


#####
# Throw Error

# Input:
#   error message to throw
#       (string, but should start with a numeric status code)
# Output:
#   hash ref, the packaged error message.

    sub _ThrowError
    {
        my ($self,$error,$debug) = @_;
        return bless {
#        return SOAP::Data->type( 'ProviderQueryResponse' => {
                provider => $self->_ProviderID(),
                version  => $self->_VSOVersionSupported,
                error    => 'VSO-D'.$error,
                (defined($debug) ? (debug => $debug) : ())
        }, 'QueryResponse';
 #       } )->name( 'QueryResponse' );
    }

    sub _ThrowGetDataError
    {
        my ($self,$error, $debug) = @_;
#        return [ SOAP::Data->type( 'ProviderGetDataResponse' => {
        return bless {
                provider => $self->_ProviderID(),
                version  => $self->_VSOVersionSupported,
                error    => 'VSO-D'.$error,
                (defined($debug) ? (debug => $debug) : ())
        }, 'GetDataResponse';
#        } )->name( 'GetDataResponse' ) ];
    }



####################
# GetData Functions

# 2004/10/14 - Okay, a new approach to handling returning the info to
# recreate the request.  After trying for so long to handle this by mo
+difying
# GetData, _ThrowGetDataError, and _PackageData, I realized I missed t
+he obvious:
# 
# old :
#   GetData {
#       return _ThrowError()
#       or _PackageData()
#   }
# new:
#   GetData { #new wrapper function
#       $result = old_GetData {
#           return _ThrowGetDataError()
#           or _PackageData()
#       }
#       <extra code to insert request details>
#       return $result
#   }


    sub GetData
    {
        my $self = shift;

        my $results = $self->_GetDataInner(@_);
        $results = [ $results ] if (! UNIVERSAL::isa($results, 'ARRAY'
+));

        my $request = shift;

        # now we do our magic processing -- need to make sure there's 
+enough
        # information to re-create the process.

#       # we now _always_ return an array.  Make sure we're doing so.
#       if ( ! UNIVERSAL::isa( $results, 'ARRAY' ) ) {
#           $results = [ $results ];
#       }

        # requests need four parts -- provider, method, info, and data
+id.
        # provider should already be in the response.  If dataid isn't
        # there, we assume that all of the ones requested were returne
+d
        # in the message.  method and info are more difficult, as ther
+e
        # may or may not be something in the message.  If they _are_
        # in the message, they tell what needs to be fixed, or what wa
+s
        # accepted, so we shouldn't mess with them.

        # todo --
        # in an effort to save CPU cycles -- we have placeholders for
        # method and info arrays -- if we need them, we'll populate th
+em.
        # that way, if we're returning more than one object, that need
+s it,
        # we can save a little bit of time.

        # (not sure if that's worth it for code complexity...maybe lat
+er)

        my $methodRef = $request->{'request'}->{'method'} || [];

        $request->{'request'}->{'info'} ||= [];

        if (UNIVERSAL::isa($request->{'request'}->{'info'}, 'HASH')) {
            $request->{'request'}->{'info'} = [ keys %{ $request->{'re
+quest'}->{'info'} } ]
        } elsif (! UNIVERSAL::isa($request->{'request'}->{'info'}, 'AR
+RAY')) {
            $request->{'request'}->{'info'} = [ $request->{'request'}-
+>{'info'} ];
        }

        my $infoRef = $request->{'request'}->{'info'} || [];

        # if they don't have a method or info defined, insert it.
        foreach my $result (@{ $results }) {
            $result->{'method'} ||= $methodRef;
            $result->{'info'}   ||= $infoRef;
        }

        # if we only return one item, then the item we're returning de
+scribes all
        # of the items that were requested
        if (scalar @{$results} == 1 ) {
            # if there's no <data> block, or it's empty

            my $result = $results->[0]; # laziness

            # okay, here's the deal -- the data block _may_ have been
            # flattened when we were inside the block, even though it
            # wasn't passed in as such.  This has caused me many annoy
+ing
            # hours of debugging to try to discover when/why this was
            # happening.
            
            if ( ! UNIVERSAL::isa($request->{'request'}->{'data'}, 'AR
+RAY')) {
                $request->{'request'}->{'data'} = [ $request->{'reques
+t'}->{'data'} ];
            }
            
            my $fileids = [ map
                {
                    if ($_->{'provider'} eq $self->_ProviderID() ) {
                        @{ $_->{'fileid'} };
                    } else {
                        ();
                    }
                } ( @{$request->{'request'}->{'data'}} ) ];

            if (!exists($result->{'data'}) or ! @{$result->{'data'}}) 
+{

                if (defined($request->{'request'}->{'data'})) {
                    $result->{'data'} = bless [ { fileid => $fileids }
+ ], 'DataResponse';
                }

            } elsif ( @{$result->{'data'}} == 1 ) {
                # there was exactly one result block ... did it have f
+ileids ?
                my $data = $result->{'data'}; # laziness
                $data->[0]->{'fileid'} =  $fileids;
            }
        } else {
            # there was more than one result block...
            # we have no idea why it was segmented, so we shouldn't me
+ss
            # with it.
        }

        return $results;
    }

#   sub GetData
    sub _GetDataInner # until 2004/10/14, this function was 'GetData'.
    {
        my ($self, $request) = @_;

        # Determine the format of the request
        # (see Query for notes about this logic)

        if (! ref($request))
        {
            require XML::Simple;
            return XML::Simple::XMLOut (
                $self->GetData (
                    XML::Simple::XMLin ( $request, %__ParserArgs )
                ), %__OutputArgs
            );
        } elsif (! UNIVERSAL::isa( $request, 'HASH' ) )
        { # it's not a hash
            return $self->_ThrowGetDataError ( '400 Bad Request - Impr
+oper Format' );
        }

        # anything left is a hash.

        #####
        # Header validatation

        if ($request->{'version'} > $self->_VSOVersionSupported())
        {
            return $self->_ThrowGetDataError ('505 Version not support
+ed; '.$self->_VSOVersionSupported() );
        }

        # did we get a 'request' element, so have something to process
+?

        if (!defined($request->{'request'}) || ! UNIVERSAL::isa( $requ
+est->{'request'}, 'HASH' ) )
        {
            return $self->_ThrowGetDataError ('400 Bad Request - Missi
+ng REQUEST');
        }

        # did they send us a method that we're happy with?

        # Not sure which is more forward thinking -- passing them the
        # full query, that they can then parse (helps if we add things
+ that
        # they might want to key off of in the future) or passing them
+ fixed
        # values, which helps if we change the request syntax in the f
+uture.

        # I'm going to assume the first one, and we'll just have to av
+oid
        # changing the request syntax in a way that would break backwa
+rds
        # compatability

        my ($methodRef, $matchFlag) = $self->_NegotiateReturnMethod( $
+request->{'request'} );

        my %methods = %{ $methodRef };

        if ( defined($matchFlag) && $matchFlag )
        {
            my ($method) = (keys %methods);
            # was the returned list empty?
            if (! scalar @{ $methods{$method} }) {
                # all is good.
                # Save _ProcessDataRequest from having to do this work
+.
                $request->{'request'}->{'method'} = $methodRef;
            } else
            {
                # they're missing some required field.
                return $self->_PackageData( $methodRef, [], info => $m
+ethods{$method}, error => '412 Missing Required Information');
            }
        } elsif ( scalar keys %methods )
        {
            # we need to finish negotiating (we didn't agree on a meth
+od)
            return $self->_PackageData( $methodRef, [], error => '300 
+Multiple Choices');
        } else
        {
            # the list returned was empty.  (we don't support anything
+?)
            return $self->_PackageData( $methodRef, [], error => '500 
+Server Error', debug => 'no methods returned from _NegotiateReturnMet
+hod');
        }

        #####
        # verify that the data block was formatted correctly.

        if (!defined($request->{'request'}->{'data'}))
        {
            # they didn't ask for anything?  Must've been negotiating.
+..
            # why haven't we stopped already?
            return $self->_PackageData( $methodRef, [], debug => 'no d
+ata block in the request');
    #       return $self->_ThrowError ( '400 Bad Request - Missing REQ
+UEST:DATA' );
        }
        if (! UNIVERSAL::isa( $request->{'request'}->{'data'}, 'HASH' 
+) )
        {
            if ( UNIVERSAL::isa( $request->{'request'}->{'data'}, 'ARR
+AY' ) ) {
                my @data = @{ $request->{'request'}->{'data'} };
                if (!scalar @data) {
                    # this'll cause it to throw an error in the next b
+lock
                    $request->{'request'}->{'data'} = {};
                } elsif (scalar @data == 1) {
                    $request->{'request'}->{'data'} = $data[0];
                } else {
                    return $self->_PackageMultipleData(
                        map { $request->{'request'}{'data'} = $_; $sel
+f->_GetDataInner($request); }
                            @{ $request->{'request'}->{'data'} }
                    );

                }
            } else {
                # improperly formatted.  (might have been an array _be
+fore_ it
                # got to us, but we need just one hash now
                return $self->_ThrowGetDataError ( '400 Bad Request - 
+Improper REQUEST:DATA Format', ref($request->{'request'}->{'data'}) )
+;
            }
        }
        if (!defined($request->{'request'}->{'data'}->{'provider'}))
        {
            # how do we know this was for us?
            return $self->_ThrowGetDataError ( '400 Bad Request - Miss
+ing REQUEST:DATA:PROVIDER' );
        }
        if ($request->{'request'}->{'data'}->{'provider'} ne $self->_P
+roviderID())
        {
            # it wasn't for us.... so we don't have it.
            return $self->_PackageData( $methodRef, [], debug => 'requ
+est not for '.$self->_ProviderID());
        }


        if (!defined($request->{'request'}->{'data'}->{'fileid'}))
        {
            # and they didn't ask us for any files?  So don't return a
+nything.
            return $self->_PackageData( $methodRef, [], debug => 'aske
+d for no fileids');
        }
        if (! ref($request->{'request'}->{'data'}->{'fileid'}))
        {
            # they only asked for one -- put it in an array, so the da
+ta providers
            # can always expect it as such.
            $request->{'request'}->{'data'}->{'fileid'} = [ $request->
+{'request'}->{'data'}->{'fileid'} ];
        }
        elsif (! UNIVERSAL::isa( $request->{'request'}->{'data'}->{'fi
+leid'}, 'ARRAY' ) )
        {
            # it's not an array...
            return $self->_ThrowError ( '400 Bad Request - Improper RE
+QUEST:DATA:FILEID Format' );
        }
        elsif (!scalar @{$request->{'request'}->{'data'}->{'fileid'}})
        {
            # empty
            return $self->_PackageData( $methodRef, [], debug => 'aske
+d for no fileids');
        }

        #####
        # Do the actual processing

        # this _should_ be handed off to the individual data provider.

        # the return from this should be either the output from _Throw
+Error or
        # _PackageData, depending if an error were generated, or a val
+id
        # result set.

        return $self->_ProcessDataRequest( $request->{'request'} );
    }


#####
# Process Data Request (stub)

# Input:
#   hash ref, containing request parameters ( method, info, and data )
# Output:
#   scalar, number of records found (or undef if unknown)
#   array ref, the records found.

# See VSO::DataProvider::SDAC for an example of how to use this.

    __NewStubFunction ( '_ProcessDataRequest' );

#####
# Negotiate Return Method

# Input:
#   hash ref, containing request parameters ( method, info, and data )
# output :
#   hashRef of arrayRefs (name, and optionally, the required fields)
#   integer w/ the 'status' of the match -- 1 = matched, 0 = didn't.

# ignore the notes below, I'll clean them up later:
# (useful for historical info right now)

    # okay, here's the deal with the return values --
    # if it has multiple elements, we didn't negotiate clean, and we
    # need to continue negotiating.

    # if it's a single value, we agree on what we're going to talk ...
    # but if are values in the arrayref of the hash element, they're
    # missing some required information.

    # this is going to be a problem if we ever have a provider that on
+ly
    # supports one method... not sure how to handle that right now.

# note -- this assumes that the order you supply methods in is more im
+portant
# than not getting prompted.  ie, if you ask for STAGING-ZIP, URL, whe
+re
# STAGING-* requires email, and URL doesn't need any info, it's going 
+to
# prompt you for email, to finish STAGING-*, not skip over to URL, whi
+ch
# it can complete now.

# need to make sure this is properly documented.

    sub _NegotiateReturnMethod
    {
        my ( $self, $requestRef ) = @_;

        my %request = %{ $requestRef };

        # did they specify a method?
        if (!defined($request{'method'}))
        {
            # nope, so return a list of
            return $self->_SupportedDataMethods(), 0;
        }

        # make sure the method is an arrayRef, not a scalar.
        if (! ref($request{'method'}))
        {
            $request{'method'} = [ $request{'method'} ];
        }

        # 2005-04-15 : oneiros : this deals with a problem if they
        # pass in two blocks.  (caught by Vasil @ VSPO)
        # unfortunately, this change means we have to process the
        # method type twice -- there might be some way to handle this
        # in a way that optimizes for this condition.
        if ( UNIVERSAL::isa( $request{'method' }, 'HASH' ) ) {
            $request{'method'} = [ keys %{$request{'method'}} ];
        }

        # is there something in it?
        if (! scalar @{$request{'method'}} || $request{'method'}->[0] 
+!~ m/[^\s]/ )
        {
            # they didn't ask for anything... so return a list of what
+ we support
            return $self->_SupportedDataMethods(), 0;
        }

        # okay, they requested something...

        # need a list of which ones we support
        my $supported = $self->_SupportedDataMethods();

        # work on them one at a time.
        # (but only those in %$supported)
        foreach my $method ( grep { defined($supported->{$_}) } @{$req
+uest{'method'}} )
        {
            # what info does it require?
            my @required = @{ $supported->{$method} };

            if (! scalar @required )
            {
                # it doesn't require anything.
                return { $method => [] }, 1;
            }

            # did they supply the required information?
            # if there's no info, or it's not a hashref, we have a pro
+blem.
            if (!defined($request{'info'}) || ! UNIVERSAL::isa( $reque
+st{'info'}, 'HASH' ) )
            {
                return { $method => \@required }, 1;
            }

            # check that each of the items is there.
            foreach my $field ( @required )
            {
                if (!defined($request{'info'}{lc($field)}))
                {
                    return { $method => \@required }, 1;
                }
            }

            # everything looks good.
            return { $method => [] }, 1;
        }

# note -- this only expands the first one that we find ... do we want 
+to
# expand all of them to give them more choices?


        # next we check the generic types
        # (so we don't get into a disagreement infinate loop)

        # and a list of the basic methods we support
        my $basicSupported = $self->_GenericDataMethods();

        my @genericMethods =  ( grep { defined($basicSupported->{$_}) 
+} @{$request{'method'}} );

        if (scalar @genericMethods) {
            # tell 'em which ones we support
            return { map { $_ => $supported->{$_} } map { keys %{$basi
+cSupported->{$_}} } @genericMethods };
        }
        # we didn't find anything we supported.
        # tell 'em what we know about.
        return $supported;

    }

    my $__genericMethods;

    sub _GenericDataMethods
    {
        return $__genericMethods
            if defined($__genericMethods);

        my ( $self, $supported ) = @_;

        $__genericMethods = {};

        foreach my $method ( keys %{ $self->_SupportedDataMethods() } 
+)
        {
            my ($type) = ( $method =~ m/^([^\-]+)-/ );
            next if (!defined($type));

            $__genericMethods->{$type}{$method} = 1;

            # URL is special, because of URL-package
            if (($type eq 'URL') and ($method ne 'URL-FILE'))
            {
                $__genericMethods->{'URL-package'}{$method} = 1;
            }
        }
        return $__genericMethods;
    }


#####
# List Supported Data Methods (stub)

# Input:
#   (none)
# Output:
#   hashRef of arrayRefs (name, and optionally, the required fields)


# See VSO::DataProvider::SDAC for an example of how to use this.

    __NewStubFunction ( '_SupportedDataMethods' );

#####
# Provider ID (stub)

# Input:
#   (none)
# Output:
#   string w/ the ID of the provider.


# See VSO::DataProvider::SDAC for an example of how to use this.

    __NewStubFunction ( '_ProviderID' );


#####
# Package Data

# Input:
#   array reference to the list of methods supported (or method being 
+used)
#   array reference to the info about methods to access the data being
+ requested.
#       (array of hashes)
#   (optional) list of extra options.  currently supported:
#       debug => extra debugging message to insert into results
#       info => list of required fields to process the request.

# Output:
#   hash ref, the packaged results.

=begin comment

        <version>
        <error> ?
        <response> +
           <info> *
           <data> +
               <provider>
               <fileid> *
               <status> ?
               <url> ?
               <content> ?
               <details> ?

<GetDataResponseArray>
    <GetDataResponseElement>
        <version>
        <status>
        <info>
        <method>
        <provider>
        <data>
            <fileid>
            <url>
            <content>
            <details>
        </data>
    </GetDataResponseElement>
<GetDataResponseArray>

# note -- the only reason for the <data> block to exist is to deal wit
+h those
# times when the <method> and <info> fields remain the same, and there
+ is a
# seperate correlation between the <fileid> and the final response (mo
+st likely
# <url>, for URL-FILE requests.)


When should I return multiple GetDataResponseElement blocks as opposed
to a single one, with multiple data blocks?

If at all possible, you should send back one GetDataResponseElement, a
+nd
for most situations under normal circumstances, we believe that is
possible.  Situations where it may be necessary to use multiple
GetDataResponseElement blocks include the following:

    1. The request is for fileids that are maintained under
    heterogeneous systems, and may not be available under the same dat
+a
    transfer method.

    [Note -- if the classification criteria is static, it may be
    preferable to advertize the data sets as being contained in more
    than one service, with each one advertizing a fixed list of data
    transfer methods and corresponding required information.]

    2. If there were errors generated in accessing particular datasets
+,
    but were able to process the rest of the request successfully.

    For instance, if you determine that some of the fileids requested
    were not valid, you may generate an error for those fileids, while
    returning the valid ones in a second GetDataResponseElement block.

=end comment

=cut


    sub _PackageData
    {
        my ($self, $methodRef, $dataRef, %options) = @_;
        if ( UNIVERSAL::isa( $methodRef, 'HASH' ) ) {
            $methodRef = [ keys %$methodRef ];
        }

        if (! UNIVERSAL::isa( $dataRef, 'ARRAY' ) ) {
            $dataRef = [ $dataRef ];
        }

        bless $dataRef, 'DataResponse';

        my $results = bless
            {
                version  => $self->_VSOVersionSupported,
                provider => $self->_ProviderID(),
                method   => $methodRef,
                data     => $dataRef,
                ( defined($options{'debug'})  ? ( debug  => $options{'
+debug'} ) : () ),
                ( defined($options{'info'})   ? ( info   => $options{'
+info'}  ) : () ),
                ( defined($options{'error'})  ? ( status => 'VSO-D'.$o
+ptions{'error'} ) :
                    ( defined($options{'status'}) ? ( status => 'VSO-D
+'.$options{'status'} ) : () )
                ),
            }, 'GetDataResponse';

        return $results;
    }

    sub _PackageMultipleData
    {
        shift;
        return [@_];

    }

}


1;



=head1 NAME

Physics::Solar::VSO::DataProvider - Inheritable Perl object for Virtua
+l Solar Observatory Data Providers.

=head1 SYNOPSIS

  use VSO::DataProvider;
  @ISA = qw (VSO::DataProvider);

  sub _ProviderID   { return $id; }
  sub _Search               { ... }
  sub _SupportedDataMethods { ... }
  sub _ProcessDataRequest   { ... }


=head1 DESCRIPTION

VSO::DataProvider is an inheritable to allow organizations
with archives of solar physics data to more easily create a web
service to participate in the Virtual Solar Observatory project.

For more information about this project, please visit the VSO website:

  http://www.virtualsolar.org/

=head1 USAGE

The VSO::DataProvider module contains functions to handle the
encoding and decoding of VSO messages.  VSO::DataProvider will
perform some basic sanity checks on the message, and then call
specific functons to handle the low-level processing, and to
actually interact with the data archive.

=head2 Required Functions

=over 4

=item _ProviderID()

This function should return a string containing this data provider's P
+rovider ID.

For information about obtaining a Provider ID, please visit
the VSO website:

  http://www.virtualsolar.org/

=item _Search()

The _Search function handles the main processing for a VSO Query.

The input is a hashref containing the search parameters.  The
output should be either a VSO error message, or a VSO query response.

Two helper functions are provided to handle the encapsulation of the
response, L<_ThrowError>() and L<_PackageResults>()

Please see the VSO website for an explaination of the formatting
of a search request:

  http://www.virtualsolar.org/

=item _SupportedDataMethods()

This function should return a reference to a hash of arrays, that
contains the list of data transfer methods that the Data Provider
supports, and the list of required information to complete the
transaction:

  sub _SupportedDataMethods {
    return {
      'TRANSFER_METHOD'  => [ qw( INFO KEYWORD LIST ) ],
      'TRANSFER_METHOD2' => [ qw( INFO KEYWORD LIST ) ],
    };
  }

See the VSO website for information about the current list
of defined transfer methods and information keywords, and
for information about adding defining new methods or keywords:

  http://www.virtualsolar.org/

=item _ProcessDataRequest()

The _ProcessDataRequest function handles the main processing for a VSO
+ GetData request.

The input is a hashref containing the search parameters.  The
output should be either a VSO error message, or a VSO query response.

Two helper functions are provided to handle the encapsulation of the
response, _ThrowError() and _PackageData()

Please see the VSO website for an explaination of the formatting
of a GetData request:

  http://www.virtualsolar.org/

=back

=head2 Useful Functions


The following functions may be useful in the writing of your functions
+.

=over 4

=item Ping()

A function for the VSO Central Server to test the status of your
system.  There is no input.  A Data Provider should return one of the
following:

=over 4

=item '0'

The system is not currently available.

=item '1'

The system seems to be functional.

=item undef

You have no idea if the system is available.

=back

The default Ping() function will return undef.

=item _ValidDate()

Accepts a scalar, and returns 1 if it thinks the string looks
like a VSO date, otherwise, it returns 0.  The default function
tests to see if the scalar is a 14 digit number.  You can override
this function if you want to make sure that you don't accept requests
for February 42nd at 2762 UTC.

=item _PackageResults()

This function wraps the necessary packaging around a Query result set.

Input Arguments:

=over 4

=item Number Found

A scalar, with the number of records the Data Provider found.  This
number will not necessarily match the number of records returned, if t
+he
number of records exceeded an internal limit.  If this number would be
prohibitively expensive to calculate, the Data Provider may send undef
+.

=item Records

A reference to an array of VSO records.  Please see the VSO website fo
+r
documentation on the format of VSO records:

  http://www.virtualsolar.org/

=item Additional Options

Additional options may be included as a hash after the positional argu
+ments.
There is currently only one option recognized:

=over 4

=item debug

Will include a 'debug' element in the VSO response, with the value pas
+sed
in.

=back

=back

=item _ThrowError()

Will package an error message to be returned.

Input Arguments:

=over 4

=item Error Message

The error message should be a three digit status code, a space, and th
+en
a short message that is human readable.

=item Debugging Message

You may also specify an extra message that would not typically be retu
+rned
to the end user, but may assist in debugging problems down the road.  
+This
can be useful when you may generate the same error message multiple wa
+ys, or
if you want to explain further about why you were throwing the error m
+essage.

=back

=item _PackageData()


=item _PackageMultipleData()

Combines the results of multiple calls to _PackageData() into one
VSO result message.

=back

=head2 Other Functions

The following functions are explained for completeness of documentatio
+n.
There should be no need for a Data Provider to override these function
+s,
but this documentation may be useful to future maintainers of this
module.

=over 4

=item new()

Creates a new VSO::DataProvider object.

=item Query()

Accepts the VSO request, and performs simple sanity checks on the
request to search for data.  Hands off any significant processing to _
+Search()

=item GetData()

Accepts the VSO request, and performs simple sanity checks on the
request to retrieve information.  Will check that the client has
requested an acceptable data transfer method, and that they have
supplied the necessary information keywords.  [Note -- it tests
that they are defined, but additional tests may be required to
ensure that they are valid values].

Hands off any significant processing to _ProcessDataRequest()

=item __NewStubFunction()

Creates a function that will throw an error if it is called.  This
exists because the original coder was getting tired of redundant
code in the module.

=item _VSOVersionSupported()

Returns the version of the VSO API that is supported by this web servi
+ce.

=item _NegotiateReturnMethod()

Given a VSO GetData request, it will return a hashref containing a sub
+set of
the data transfer methods that the Data Provider supports.

The function will return a hashref containing one of the following:

=over 4

=item A single hash element, containing an empty array

The key of the hash element is a mutually agreed upon data transfer
method, and the client has supplied all required information for the
method.

=item A single hash element, containg a non-empty array

The key of the hash element is a mutually agreed upon data transfer
method, but the client is missing required information to the
method.

=item Multiple hash elements

The keys of the hash are data transfer methods that the client
may be interested in.  The list is generated by comparing the
list of generic methods that the client desires, and will expand
those that the provider supports.  If there is no match between
the client request and the provider, will return all transfer
methods that the provider supports.

=back

=item _GenericDataMethods()

Will parse the return value of _SupportedDataMethods() to generate
a list of the non-specific transfer methods that the provider supports
+.

=back

=head1 SEE ALSO

For more information about the Virtual Solar Observatory
Project, please visit the VSO website:

  http://www.virtualsolar.org/

Example files are available to show some of the functionality
that is available in the different


=head1 AUTHOR

This module is a collaborative effort by the VSO Team.

Please see the VSO website for current contact information:

  http://www.virtualsolar.org/


=head1 COPYRIGHT AND LICENSE

Copyright 2004 by The VSO Team

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut
[download]