XML::Document::RTML - module which builds and parses RTML documents

XML-Document-RTML documentation Contained in the XML-Document-RTML distribution.

Index

Code Index:

NAME

Top

XML::Document::RTML - module which builds and parses RTML documents

SYNOPSIS

Top

An object instance can be created from an existing RTML document in a scalar, or directly from a file on local disk.



   my $object = new XML::Document::RTML( XML => $xml );
   my $object = new XML::Document::RTML( File => $file );

or via the build method,

   my $object = new XML::Document::RTML() 
   $document = $object->build( %hash );

once instantiated various query methods are supported, e.g.,

   my $object = new XML::Document::RTML( File => $file );
   my $role = $object->role();

DESCRIPTION

Top

The module can build and parse RTML documents. Currently only version 2.2 of the standard is supported by the module.

REVISION

Top

$Id: RTML.pm,v 1.16 2006/11/17 20:43:26 aa Exp $

METHODS

Top

Constructor

new

Create a new instance from a hash of options

  my $object = new XML::Document::RTML( %hash );

returns a reference to an message object.

Accessor Methods

type

Return, or set, the type of the RTML document

  my $type = $object->type();
  $object->type( $type );
version

Return, or set, the version of the RTML specification used

  my $version = $object->version();
  $object->version( $version );

Scheduling Methods

group_count

Return, or set, the group count of the observation

  my $num = $object->group_count();
  $object->group_count( $num );
exposure_time

Return, or set, the exposure time of the observation

  my $num = $object->exposure_time();
  $object->exposure_time( $num );
signal_to_noise

Return, or set, the S/N of the observation

  my $num = $object->signal_to_noise();
  $object->signal_to_noise( $num );
reference_flux

Sets (or returns) the flux of the object needed for signal to noise calculations for the image

   my $mag = $object->reference_flux();
   $object->reference_flux( $mag );

the flux should be a continuum R band magnitude value.

exposure_type

Return, or set, the type of exposure of the observation

  my $string = $object->exposure_type();
  $object->exposure_type( $string );

where $string can have values of "snr" or "time".

series_count

Return, or set, the series count of the observation

  my $num = $object->series_count();
  $object->series_count( $num );
interval

Return, or set, the interval between a series of observations blocks

  my $num = $object->interval();
  $object->interval( $num );
tolerance

Return, or set, the tolerance between a series of observations blocks

  my $num = $object->tolerance();
  $object->tolerance( $num );
priority

Return, or set, the priority of the observation

  my $num = $object->priority();
  $object->priority( $num );

Schedule (RTML) priority Phase II Priority Phase II GUI N/A 5 Urgent 0 4 (default) Normal 1 3 High 2 2 Medium 3 1 Normal default(other) 1 Normal N/A 0 Normal

where: "Schedule (RTML) priority" is the number specified in the RTML: <Schedule priority="n">, "Phase II Priority" is the number stored in the Phase II database and "Phase II GUI" is what is displayed in the Phase II GUI.

Note: The Phase II priority 4 can be specified by the TEA but cannot be specified by the Phase II GUI (and displays as the default "Normal" in the GUI). The Phase II priority 5 cannot be specified by the TEA but can be specified by the Phase II GUI as Urgent.

time_constraint

Return, or set, the time constraints of the the observation

  my $array_reference = $object->time_constraint();
  $object->exposure_type( \@times );

where it takes and returns a scalar reference to an array of ISO8601 times, e.g. my $array_reference = [ $start, $end ] which maps to,

      <TimeConstraint>
        <StartDateTime>2006-09-10T11:12:51+0100</StartDateTime>
        <EndDateTime>2006-09-12T00:12:51+0100</EndDateTime>
      </TimeConstraint>

Device Methods

device_type

Return, or set, the device type for the observation

  my $string = $object->device_type();
  $object->device_type( $string );
filter_type

Return, or set, the filter type for the observation

  my $string = $object->filter_type();
  $object->filter_type( $string );

Target Methods

target_type

Return, or set, the type of target for the observation

  my $string = $object->target_type();
  $object->target_type( $string );

there are two types of valid target type; "normal" or "toop". A normal observation is placed into the queue

target_ident

Return, or set, the type identifier of target for the observation

  my $string = $object->target_ident();
  $object->target_ident( $string );

The target identity is used by the eSTAR system to choose post-observation processing blocks, e.g.

  <Target type="normal" ident="ExoPlanetMonitor">

signifies a normal queued observation which is part of the exo-planet monitoring programme on Robonet-1.0.

target_name

Return, or set, the target name for the observation

  my $string = $object->target_name();
  $object->target_name( $string );
coordinate_type

Sets (or returns) the type of co-ordinate system expected,

   my $ra = $object->coordinate_type();
   $object->coordinate_type( 'equatorial' );

defaults to "equatorial". Don't change this unless you know what you're doing and set all the other relevant parameters via the relevant private methods provided by the class.

ra

Sets (or returns) the target RA

   my $ra = $object->ra();
   $object->ra( '12 35 65.0' );

must be in the form HH MM SS.S.

dec

Sets (or returns) the target DEC

   my $dec = $object->dec();
   $object->dec( '+60 35 32' );

must be in the form SDD MM SS.S.

equinox

Sets (or returns) the equinox of the target co-ordinates

   my $equnox = $object->equinox();
   $object->equinox( 'B1950' );

default is J2000, currently the telescope expects J2000.0 coordinates, no translation is currently carried out by the library before formatting the RTML message. It is therefore suggested that the user provides their coordinates in J2000.0 as this is merely a placeholder routine.

Agent Methods

host

Return, or set, the host to return asynchronous messages to regarding the status of the observation, see also port( ).

  my $string = $object->host();
  $object->host( $string );

defaults to the current machine's IP address

port

Return, or set, the port to return asynchronous messages to regarding the status of the observation, see also host( ).

  my $string = $object->port();
  $object->port( $string );

defaults to 8000.

id

Sets (or returns) the unique ID for the observation request

   my $id = $object->id();
   $object->id( 'IATEST0001:CT1:0013' );

note that there is NO DEFAULT, a unique ID for the score/observing request must be supplied, see the eSTAR Communications and the TEA command set documents for further details.

Note: This is not the same thing as the target identity for the observation.

Contact Methods

name

Return, or set, the name of the observer

  my $string = $object->name();
  $object->name( $string );
user

Return, or set, the user name of the observer

  my $string = $object->user();
  $object->user( $string );

e.g. PATT/keith.horne

institution

Return, or set, the institutional affliation of the observer

  my $string = $object->institution();
  $object->institution( $string );

e.g. University of Exeter

email

Return, or set, the email address of the observer

  my $string = $object->email();
  $object->email( $string );
project

Return, or set, the user name of the observer

  my $string = $object->user();
  $object->user( $string );

e.g. PATT/keith.horne

Scoring Methods

score

Sets (or returns) the target score

   my $score = $object->score();
   $object->score( $score );

the score will be between 0.0 and 1.0

completion_time

Sets (or returns) the target completion time

   my $time = $object->completion_time();
   $object->completion_time( $time );

the completion time should be of the format YYYY-MM-DDTHH:MM:SS

Data Methods

data

Sets (or returns) the data associated with the observation

   my @data = $object->data( );
   $object->data( @data );

Takes an array of hashes where,

   @data = [ { Catalogue => ' ', Header => ' ', URL => ' ' },
             { Catalogue => ' ', Header => ' ', URL => ' ' },
	           .
	           .
	           .
             { Catalogue => ' ', Header => ' ', URL => ' ' } ];

and the value of the Catalogue hash entry is a URL pointing to a VOTavle, the Header hash entry is a FITS header block and the URL is either points to a FITS file, or other associated data product. You can not append data to an existing memory structure, any data passed via this routine will overwrite any existing data structure in memory.

The routine returns a similar array when queried. This array will be populated either by calling build( ), or through parsing a document.

General Methods

dump_buffer

Dumps the contents of the RTML buffer in memory to a scalar,

   my $object = new XML::Document::RTML();
   $object->build( %hash );
   my $document = $object->dump_buffer();

If build( ) has not been called this function will return an undef.

dump_tree

Returns a refence to the parsed RTML document hash currently held in memory,

   my $object = new XML::Document::RTML( XML => $xml );
   my $hash_reference = $object->dump_tree();

should return an undefined value if that tree is empty. This error will occur if we haven't called build( ) to create a document, or populated the tree using the object creator by calling the XML or File methods to read in a document.

configure

Configures the object, takes an options hash as an argument

  $message->configure( %options );

Does nothing if the hash is not supplied. This is called directly from the constructor during object creation

XML-Document-RTML documentation Contained in the XML-Document-RTML distribution. 
package XML::Document::RTML;
# ---------------------------------------------------------------------------

#+ 
#  Name:
#    XML::Document::RTML

#  Purposes:
#    Perl module to build and parse RTML documents

#  Language:
#    Perl module

#  Authors:
#    Alasdair Allan (aa@astro.ex.ac.uk)

#  Revision:
#     $Id: RTML.pm,v 1.16 2006/11/17 20:43:26 aa Exp $

#  Copyright:
#     Copyright (C) 200s University of Exeter. All Rights Reserved.

#-

# ---------------------------------------------------------------------------


# L O A D   M O D U L E S --------------------------------------------------

use strict;
use vars qw/ $VERSION $SELF /;

use XML::Simple;
use XML::Writer;
use XML::Writer::String;

use Net::Domain qw(hostname hostdomain);
use File::Spec;
use Carp;
use Data::Dumper;
use Scalar::Util qw(reftype);

#use Astro::FITS::Header;
#use Astro::VO::VOTable;

'$Revision: 1.16 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1);

# C O N S T R U C T O R ----------------------------------------------------



sub new {
  my $proto = shift;
  my $class = ref($proto) || $proto;

  # bless the query hash into the class
  my $block = bless { DOCUMENT => undef,  # hash generated by XML::Simple
                      WRITER   => undef,  # reference to an XML::Writer
                      BUFFER   => undef,  # reference to an XML::Writer::String
		      DTD      => undef
		    }, $class;

  # Configure the object
  $block->configure( @_ ); 

  return $block;

}

# B U I L D   M E T H O D ------------------------------------------------

sub build {
  my $self = shift;
  my %args = @_;

  # mandatory tags
  unless ( exists $args{Type} ) {
     return undef;
  } 
   
  # Loop over the rest of the keys
  for my $key (qw / Role Type Version DTD GroupCount ExposureTime Exposure
                    SignalToNoise Snr Flux ExposureType ExposureUnits
                    SeriesCount Interval Tolerance Priority TimeConstraint
                    DeviceType Device FilterType Filter TargetType TargetIdent
                    Identity TargetName Target CoordinateType Coordtype  
                    RA RAFormat RAUnits Dec DecFormat DecUnits Equinox
                    Host Port PortNumber ID UniqueID Name ObserverName
                    RealName User UserName Institution Email EmailAddress
                    Project Score CompletionTime Time Data  / ) {
      my $method = lc($key);
      $self->$method( $args{$key} ) if exists $args{$key};
  }    

  # open the document
  $self->{WRITER}->xmlDecl( 'ISO-8859-1' );
   
  # BEGIN DOCUMENT ------------------------------------------------------- 
  
  if ( $self->version() == 2.2 ) {
     $self->{WRITER}->doctype( 'RTML', '', $self->{DTD} );
  } elsif ( $self->version() == 2.1 ) {
     $self->{WRITER}->doctype( 'RTML', '',
          "http://astro.livjm.ac.uk/HaGS/rtml2.1.dtd" );
  } else {
     $self->{WRITER}->doctype( 'RTML' );
  }
   
  # open the RTML document
  # ======================
  $self->{WRITER}->startTag( 'RTML','version' => $self->version(),
                             'type' => $self->type() );
			        
  # Contact Tag
  # -----------
  if( defined $self->user_name() || 
      defined $self->real_name() ||
      defined $self->institution() ||
      defined $self->email() ) {
      
     $self->{WRITER}->startTag( 'Contact', 'PI' => 'true' );

     if (defined $self->real_name() ) {
     
        $self->{WRITER}->startTag( 'Name');                          
        $self->{WRITER}->characters( $self->real_name() );
        $self->{WRITER}->endTag( 'Name' );  
     } else {
        $self->{WRITER}->emptyTag( 'Name');                          
     }
     if (defined $self->user_name() ) {
        $self->{WRITER}->startTag( 'User');                          
        $self->{WRITER}->characters( $self->user_name() );
        $self->{WRITER}->endTag( 'User' );
     } else {
        $self->{WRITER}->emptyTag( 'User');                          
     }
     if (defined $self->institution() ) {
      
        $self->{WRITER}->startTag( 'Institution');                          
        $self->{WRITER}->characters( $self->institution() );
        $self->{WRITER}->endTag( 'Institution' ); 
     } else {
        $self->{WRITER}->emptyTag( 'Institution');                          
     }
     if (defined $self->email() ) {
      
        $self->{WRITER}->startTag( 'Email');                          
        $self->{WRITER}->characters( $self->email() );
        $self->{WRITER}->endTag( 'Email' ); 
     } else {
        $self->{WRITER}->emptyTag( 'Email');                          
     }
     
     $self->{WRITER}->endTag( 'Contact' ); 
  } else {
     $self->{WRITER}->emptyTag( 'Contact' );
  }   
  
  # Project Tag
  # -----------
  if (defined $self->project() ) {
    $self->{WRITER}->startTag( 'Project' );     
    $self->{WRITER}->characters( $self->project() );
    $self->{WRITER}->endTag( 'Project' );          		     
  } else {
    $self->{WRITER}->emptyTag( 'Project' );
  }

  # Telescope Tag
  # -------------
  $self->{WRITER}->emptyTag( 'Telescope' );

  # IntelligentAgent Tag
  # --------------------

  if (defined $self->id() && defined $self->host() && defined $self->port() ) {

     $self->{WRITER}->startTag( 'IntelligentAgent', 
        'host' => $self->host(), 'port' => $self->port() ); 	
     
     $self->{WRITER}->characters( $self->id() );
  
     $self->{WRITER}->endTag( 'IntelligentAgent' );     
  } 
   
  # Observation tag
  # ---------------   
  $self->{WRITER}->startTag( 'Observation', 'status' => 'ok' );  
   
     # Target
     # ------
     $self->{WRITER}->startTag( 'Target', , 
       'type' => $self->target_type(),
       'ident' => $self->target_ident() );
    
        # Target Name
	# -----------
        if ( defined $self->target() ) {
     	   $self->{WRITER}->startTag( 'TargetName' );
     	   $self->{WRITER}->characters( $self->target() );
     	   $self->{WRITER}->endTag( 'TargetName' );
        } else {
           $self->{WRITER}->emptyTag( 'TargetName' );
        }
	
        # Co-ordinates
        # ------------
	if ( defined $self->coordinate_type() ) {
           $self->{WRITER}->startTag( 'Coordinates', 
	                              'type' => $self->coordinate_type());
	} else {
           $self->{WRITER}->startTag( 'Coordinates' );	
	}
        $self->{WRITER}->startTag( 'RightAscension', 
        			   'format' => $self->raformat(), 
     				   'units'  => $self->raunits() );
        $self->{WRITER}->characters( $self->ra() );
        $self->{WRITER}->endTag( 'RightAscension' );
     	
        $self->{WRITER}->startTag( 'Declination', 
     			           'format' => $self->decformat(), 
				   'units'  => $self->decunits() );
        if ( $self->dec() =~ m/^\+/ ) {
     	   $self->{WRITER}->characters( $self->dec() );
        } else {			    
           if ( $self->dec() =~ m/-/ ) { 
     	     $self->{WRITER}->characters( $self->dec() );
     	   } else {		    
     	     $self->{WRITER}->characters( "+" . $self->dec() );
     	   }  
        }
        $self->{WRITER}->endTag( 'Declination' );   

        $self->{WRITER}->startTag( 'Equinox'  );
        $self->{WRITER}->characters( $self->equinox() );
        $self->{WRITER}->endTag( 'Equinox' );

        $self->{WRITER}->endTag( 'Coordinates' );       

 
        # Flux
        # ----
        if( $self->exposure_type() eq "snr" ) {
     
           $self->{WRITER}->startTag( 'Flux', 
                                      'type'       => 'continuum', 
	                              'units'      => 'mag', 
                                      'wavelength' => $self->filter_type() ); 
           $self->{WRITER}->characters( $self->reference_flux() );
           $self->{WRITER}->endTag( 'Flux' );
        }
	
     $self->{WRITER}->endTag( 'Target' );
     
     # Device
     # ------
     $self->{WRITER}->startTag( 'Device', 'type' => $self->device_type() );
    
        # Filter
	# ------
        $self->{WRITER}->startTag( 'Filter' ); 
        $self->{WRITER}->startTag( 'FilterType'); 
        $self->{WRITER}->characters( $self->filter_type() );
        $self->{WRITER}->endTag( 'FilterType' ); 
        $self->{WRITER}->endTag( 'Filter' );
     $self->{WRITER}->endTag( 'Device' );          
     	
     # Schedule
     # --------
     $self->{WRITER}->startTag( 'Schedule', 'priority' => $self->priority() );
     
     	# Exposure
	# --------
        if ( $self->exposure_type() eq "time" ) {
           $self->{WRITER}->startTag( 'Exposure',
                                      'type'  => $self->exposure_type(), 
				      'units' => $self->exposure_units() );
           if( defined $self->group_count() && $self->group_count() > 1 ) {
              $self->{WRITER}->startTag( 'Count'); 
              $self->{WRITER}->characters( $self->group_count() );
              $self->{WRITER}->endTag( 'Count' ); 
           }                        
           $self->{WRITER}->characters( $self->exposure_time() );   
	
        } else {
     	   $self->exposure_type( "snr" );
           $self->{WRITER}->startTag( 'Exposure',
                                      'type'  => $self->exposure_type() );	
           if( defined $self->group_count() && $self->group_count() > 1 ) {
              $self->{WRITER}->startTag( 'Count'); 
              $self->{WRITER}->characters( $self->group_count() );
              $self->{WRITER}->endTag( 'Count' ); 
           }                        
           $self->{WRITER}->characters( $self->signal_to_noise() );   
	
        }
        $self->{WRITER}->endTag( 'Exposure' );
		
	# TimeConstraint
	# --------------
        if( defined $self->start_time() && defined $self->end_time() ) {
           $self->{WRITER}->startTag( 'TimeConstraint' );
           $self->{WRITER}->startTag( 'StartDateTime' );
           $self->{WRITER}->characters( $self->start_time() );
           $self->{WRITER}->endTag( 'StartDateTime' );
           $self->{WRITER}->startTag( 'EndDateTime' );
           $self->{WRITER}->characters( $self->end_time() );
           $self->{WRITER}->endTag( 'EndDateTime' );	    
           $self->{WRITER}->endTag( 'TimeConstraint' );
        }	
	
	# SeriesConstraint
	# ----------------
        if ( defined $self->series_count() &&
             defined $self->interval() &&
             defined $self->tolerance() ) {
             
             $self->{WRITER}->startTag( 'SeriesConstraint' );
             
             $self->{WRITER}->startTag( 'Count' );
             $self->{WRITER}->characters($self->series_count() );
             $self->{WRITER}->endTag( 'Count' );
             
             $self->{WRITER}->startTag( 'Interval' );
             $self->{WRITER}->characters( $self->interval() );
             $self->{WRITER}->endTag( 'Interval' );               
             
             $self->{WRITER}->startTag( 'Tolerance' );
             $self->{WRITER}->characters( $self->tolerance() );
             $self->{WRITER}->endTag( 'Tolerance' );               
            
             $self->{WRITER}->endTag( 'SeriesConstraint' );
        }	
	
     $self->{WRITER}->endTag( 'Schedule' );

     # Data tags
     # ---------
     my @images = $self->images();
     my @image_type = $self->image_type();
     my @image_delivery = $self->image_delivery();
     my @image_reduced = $self->image_reduced();
  
     my @catalogues = $self->catalogues();
     my @catalogue_types = $self->catalogue_type();
  
     my @headers = $self->headers();
     my @header_types = $self->header_type();
  
     foreach my $j ( 0 .. $#images ) {
  
        $self->{WRITER}->startTag( 'ImageData',
                         'type'     => $image_type[$j],
		         'delivery' => $image_delivery[$j],
		         'reduced'  => $image_reduced[$j] );
        
	# FITSHeader
	# ----------
	if( defined $headers[$j] && defined $header_types[$j] ) {
           $self->{WRITER}->startTag( 'FITSHeader', 'type' => $header_types[$j] );	
	   $self->{WRITER}->characters( $headers[$j] );
           $self->{WRITER}->endTag( 'FITSHeader' );		      
	}

	# ObjectList
	# ----------
	if ( defined $catalogues[$j] && defined $catalogue_types[$j] ) {
           $self->{WRITER}->startTag( 'ObjectList', 'type' => $catalogue_types[$j] );	
	   $self->{WRITER}->characters( $catalogues[$j] );
           $self->{WRITER}->endTag( 'ObjectList' );	
	}
	
	# FITS file
	# ---------
	$self->{WRITER}->characters( $images[$j] );
	
        $self->{WRITER}->endTag( 'ImageData' );		      
     }  
     
  $self->{WRITER}->endTag( 'Observation' );  
       
  # Score Tags
  # ---------- 
  if (defined $self->{DOCUMENT}->{Score} ) {
     $self->{WRITER}->startTag( 'Score' );
     $self->{WRITER}->characters( $self->{DOCUMENT}->{Score} );
     $self->{WRITER}->endTag( 'Score' );
  }
  if ( defined $self->{DOCUMENT}->{CompletionTime} ) {   
     $self->{WRITER}->startTag( 'CompletionTime' );
     $self->{WRITER}->characters( $self->{DOCUMENT}->{CompletionTime} );
     $self->{WRITER}->endTag( 'CompletionTime' );       
  }    
  
  # close the RTML DOCUMENT
  # =======================

  $self->{WRITER}->endTag( 'RTML' );
  $self->{WRITER}->end();

  # END DOCUMENT --------------------------------------------------------

  my $xml = $self->{BUFFER}->value();
  $self->_parse( XML => $xml ); # populates the object with a parsed document
  return $xml;  

}  

# A C C E S S O R   M E T H O D S -------------------------------------------


sub role {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{type} = shift;
  }
  return $self->{DOCUMENT}->{type};
}

sub type {
  role( @_ );
}

sub determine_type {
  role( @_ );
}


sub version {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{version} = shift;
  }  
  return $self->{DOCUMENT}->{version};
}

sub dtd {
   version( @_ );
}


# S C H E D U L E #########################################################


sub group_count {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{Count} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{Count};
}

sub groupcount {
  group_count( @_ );
}  


sub exposure_time {
  my $self = shift;
  if (@_) {
     my $exposure = shift;
     if ( defined $self->exposure_units() && $self->exposure_units() eq "ms" ) {
        $exposure = $exposure / 1000.0;
     }
     $exposure =~ s/^\s*//;
     $exposure =~ s/\s*$//;
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{content} = $exposure;
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{type} = "time";
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{units} = "seconds";
  }
  my $exposure = $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{content};
  if ( defined $exposure ) {
     $exposure =~ s/^\s*//;
     $exposure =~ s/\s*$//;
     if ( $self->exposure_units() eq "ms" ) {
        $exposure = $exposure / 1000.0;
        $self->exposure_units( "seconds" );
     } 
  }
  return $exposure;
}

sub exposuretime {
  exposure_time( @_ );
}  

sub exposure {
  exposure_time( @_ );
}  


sub signal_to_noise {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{content} = shift;
     $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{type} = "snr";
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{content};
}

sub signaltonoise {
  signal_to_noise( @_ );
}  

sub snr {
  signal_to_noise( @_ );
}  


sub reference_flux {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Target}->{Flux}->{content} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Target}->{Flux}->{content};
}

sub flux {
  reference_flux( @_ );
}  


sub exposure_type {
  my $self = shift;
  if (@_) {
     my $type = shift;
     if ( $type eq "snr" )  {
        $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{type} = "snr";
     } else {
        $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{type} = "time";
        $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{units} = "seconds";
     }
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{type};
}

sub exposuretype {
  exposure_type( @_ );
}  

sub exposure_units {
  my $self = shift;
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{Exposure}->{units};
}

sub exposureunits {
  exposure_units( @_ );
}  


sub series_count {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Count} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Count};
}

sub seriescount {
  series_count( @_ );
}  


sub interval {
  my $self = shift;
  if (@_) {
     my $arg = shift;
     unless ( $arg =~ "PT" ) {
       $arg = "PT" . $arg;
     }   
     $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Interval} = $arg;
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Interval};
}


sub tolerance {
  my $self = shift;
  if (@_) {
    my $arg = shift;
    unless ( $arg =~ "PT" ) {
       $arg = "PT" . $arg;
    }
    $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Tolerance} = $arg;
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{SeriesConstraint}->{Tolerance};
}



sub priority {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Schedule}->{priority} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Schedule}->{priority};
}

sub schedule_priority {
  priority( @_ );
}  


sub time_constraint {
  my $self = shift;

  if (@_) {
    
    my $ref = shift;
    my @array = @{$ref};
  
    $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{StartDateTime} = $array[0];
    $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{EndDateTime} = $array[1];
  }

  return ( $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{StartDateTime},
           $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{EndDateTime} );
	   
}

sub timeconstraint {
   time_constraint( @_ );
}   

sub start_time {
   my $self = shift;
   return $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{StartDateTime};
}

sub end_time{
   my $self = shift;
   return $self->{DOCUMENT}->{Observation}->{Schedule}->{TimeConstraint}->{EndDateTime};
}

# D E V I C E ##############################################################


sub device_type {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Device}->{type} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Device}->{type};
}

sub devicetype {
  device_type( @_ );
}  

sub device {
  device_type( @_ );
}


sub filter_type {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Device}->{Filter}->{FilterType} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Device}->{Filter}->{FilterType};
}

sub filtertype {
  filter_type( @_ );
}  

sub filter {
  filter_type( @_ );
} 
 
# T A R G E T ##############################################################


sub target_type {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Target}->{type} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Target}->{type};
}

sub targettype {
  target_type( @_ );
}  



sub target_ident {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Target}->{ident} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Target}->{ident};
}

sub targetident {
  target_ident( @_ );
}  

sub identity {
  target_ident( @_ );
}  


sub target_name {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Observation}->{Target}->{TargetName} = shift;
  }  
  return $self->{DOCUMENT}->{Observation}->{Target}->{TargetName};
}

sub targetname {
  target_name( @_ );
}  

sub target {
  target_name( @_ );
}  


sub coordinate_type {
  my $self = shift;
  
  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{type} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{type};
}  

sub coord_type {
  coordinate_type( @_ );
} 

sub coordinatetype {
  coordinate_type( @_ );
} 

sub coordtype {
  coordinate_type( @_ );
} 
 

sub ra {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{content} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{content};
}  
 
sub ra_format {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{format} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{format};
}

sub raformat {
  ra_format( @_ );
}
   
sub ra_units {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{units} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{RightAscension}->{units};
} 

sub raunits {
  ra_units( @_ );
}  


sub dec {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{content} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{content};
}  
 
sub dec_format {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{format} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{format};
}

sub decformat {
  dec_format( @_ );
}  
   
sub dec_units {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{units} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Declination}->{units};
} 

sub decunits {
  dec_units( @_ );
}  


sub equinox {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Equinox} = shift;
  }
  return $self->{DOCUMENT}->{Observation}->{Target}->{Coordinates}->{Equinox};
}

 
# A G E N T ##############################################################


sub host {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{IntelligentAgent}->{host} = shift;
  }  
  return $self->{DOCUMENT}->{IntelligentAgent}->{host};
}

sub host_name {
  host( @_ );
}  

sub agent_host {
  host( @_ );
}   


sub port {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{IntelligentAgent}->{port} = shift;
  }  
  return $self->{DOCUMENT}->{IntelligentAgent}->{port};
}

sub port_number {
  port( @_ );
} 

sub portnumber {
  port( @_ );
} 


sub id {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{IntelligentAgent}->{content} = shift;
  }

  # return the current ID
  return $self->{DOCUMENT}->{IntelligentAgent}->{content};
} 
 
sub unique_id {
  id( @_ );
}   
 
sub uniqueid {
  id( @_ );
}
 
# C O N A C T ##############################################################


sub name {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Contact}->{Name} = shift;
  }  
  return $self->{DOCUMENT}->{Contact}->{Name};
}

sub observer_name {
  name( @_ );
}  

sub real_name {
  name( @_ );
}   


sub observername {
  name( @_ );
}  

sub realname {
  name( @_ );
}


sub user {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Contact}->{User} = shift;
  }  
  return $self->{DOCUMENT}->{Contact}->{User};
}

sub user_name {
  user( @_ );
} 

sub username {
  user( @_ );
} 


sub institution {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Contact}->{Institution} = shift;
  }  
  return $self->{DOCUMENT}->{Contact}->{Institution};
}

sub institution_affiliation {
  institution( @_ );
}


sub email {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Contact}->{Email} = shift;
  }  
  return $self->{DOCUMENT}->{Contact}->{Email};
}

sub email_address {
  email( @_ );
}

sub emailddress {
  email( @_ );
}


sub project {
  my $self = shift;
  if (@_) {
     $self->{DOCUMENT}->{Project} = shift;
  }  
  my $project = $self->{DOCUMENT}->{Project};
  return $project unless defined reftype($project);
  $project = undef if reftype($project) eq "HASH"; # hash implies an empty tag
  return $project;
}

 
# S C O R I N G  ##############################################################


sub score {
  my $self = shift;

  if (@_) {
     $self->{DOCUMENT}->{Score} = shift;
  }

  # return the current target score
  return $self->{DOCUMENT}->{Score};
}

  

sub completion_time {
  my $self = shift;

  if (@_) {
    $self->{DOCUMENT}->{CompletionTime} = shift;
  }

  # return the current target score
  return $self->{DOCUMENT}->{CompletionTime};
} 

sub completiontime {
   completion_time( @_ );
}

sub time {
   completion_time( @_ );
}

 
# D A T A  ################################################################


sub data {
  my $self = shift;

  #  TAKING DATA INTO THE MESSAGE
  if (@_) {
     my @array = @_;
     $self->{DOCUMENT}->{Observation}->{ImageData} = [];
     foreach my $i ( 0 ... $#array ) {
        my %hash = %{$array[$i]};

	# Images
	if ( defined $hash{URL} ) {
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{content} = $hash{URL};
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{delivery} = "url";
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{type} = "FITS16";
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{reduced} = "true";
	}
	   
	# Catalogues
        if( defined $hash{Catalogue} ) {
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{ObjectList}->{content} = $hash{Catalogue};
	   if( $hash{Catalogue} =~ "http" && $hash{Catalogue} =~ "votable" ) {
	      $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{ObjectList}->{type} = "votable-url";
	   } else {
	      $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{ObjectList}->{type} = "unknown";
	   }   
        }
	
	# FITS Headers
        if( defined $hash{Catalogue} ) {
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{FITSHeader}->{content} = $hash{Header};
	   $self->{DOCUMENT}->{Observation}->{ImageData}[$i]->{FITSHeader}->{type} = "all";
        }
		
     } # end of foreach loop
  } # end of if ( @_ ) block

  # PUSHING DATA OUT OF THE MESSAGE
  if ( defined $self->{DOCUMENT}->{Observation}->{ImageData} && 
       reftype($self->{DOCUMENT}->{Observation}->{ImageData}) eq "HASH" ) { 
       return (); 
  } 
  my @output;
  
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $header = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{FITSHeader}->{content};
    my $url = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{content};
    my $catalogue = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{ObjectList}->{content};
    if ( defined $url ) {
       $url =~ s/^\s*//;
       $url  =~ s/\s*$//;    
    
    }
    if ( defined $catalogue ) {
       $catalogue =~ s/^\s*//;
       $catalogue =~ s/\s*$//;
    }   
    $output[$j] = ( { Catalogue => $catalogue,
                      URL => $url,
		      Header => $header } );
  }
  return @output;
}

sub headers {
  my $self = shift;
  
  if ( defined $self->{DOCUMENT}->{Observation}->{ImageData} && 
       reftype($self->{DOCUMENT}->{Observation}->{ImageData}) eq "HASH" ) { 
       return (); 
  } 
  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $header = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{FITSHeader}->{content};
    $output[$j] = $header;
  }
  return @output;
}

sub images {
  my $self = shift;

  if ( defined $self->{DOCUMENT}->{Observation}->{ImageData} && 
       reftype($self->{DOCUMENT}->{Observation}->{ImageData}) eq "HASH" ) { 
       return (); 
  } 
  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $url = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{content};
    if ( defined $url ) {
       $url =~ s/^\s*//;
       $url =~ s/\s*$//;
    }
    $output[$j] = $url;
  }
  return @output;
}

sub catalogues {
  my $self = shift;
  
  if ( defined $self->{DOCUMENT}->{Observation}->{ImageData} && 
       reftype($self->{DOCUMENT}->{Observation}->{ImageData}) eq "HASH" ) { 
       return (); 
  } 
  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $catalogue = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{ObjectList}->{content};
    if ( defined $catalogue ) {
       $catalogue =~ s/^\s*//;
       $catalogue =~ s/\s*$//;
    }
    $output[$j] = $catalogue;
  }
  return @output;
}

sub image_delivery {
  my $self = shift;

  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $delivery = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{delivery};
    $output[$j] = $delivery;
  }
  return @output;
}

sub image_type {
  my $self = shift;

  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $type = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{type};
    $output[$j] = $type;
  }
  return @output;
}
  
sub image_reduced {
  my $self = shift;

  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $reduced = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{reduced};
    $output[$j] = $reduced;
  }
  return @output;
}  

sub catalogue_type {
  my $self = shift;

  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $type = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{ObjectList}->{type};
    $output[$j] = $type;
  }
  return @output;
}

sub header_type {
  my $self = shift;

  my @output;
  foreach my $j ( 0 .. $#{$self->{DOCUMENT}->{Observation}->{ImageData}} ) {
    my $type = $self->{DOCUMENT}->{Observation}->{ImageData}[$j]->{FITSHeader}->{type};
    $output[$j] = $type;
  }
  return @output;
}
   
# G E N E R A L ------------------------------------------------------------


sub dump_buffer {
  my $self = shift;
  
  if ( defined $self->{BUFFER} ){
     return $self->{BUFFER}->value();
  } else {
     return undef;
  }
}

sub dump_rtml {
  dump_buffer( @_ );
} 

sub buffer {
  dump_buffer( @_ );
}   


sub dump_tree {
  my $self = shift;
  
  if ( defined $self->{DOCUMENT} ){
     return $self->{DOCUMENT};
  } else {
     return undef;
  }
}

sub dump_hash {
  dump_tree( @_ );
}  

sub tree {
  dump_tree( @_ );
} 


# C O N F I G U R E ---------------------------------------------------------



sub configure {
  my $self = shift;

  # BLESS XML WRITER
  # ----------------
  $self->{BUFFER} = new XML::Writer::String();  
  $self->{WRITER} = new XML::Writer( OUTPUT      => $self->{BUFFER},
                                     DATA_MODE   => 1, 
                                     UNSAFE      => 1, 
                                     DATA_INDENT => 4 );
				     
  # DEFAULTS
  # --------
  
  # use the RTML Namespace as defined by the v2.2 DTD by default
  $self->version( 2.2 );
  $self->{DTD} = "http://www.estar.org.uk/documents/rtml" . $self->version() . ".dtd"; 
  
  # we're guessing we're talking to
  $self->host( "127.0.0.1" );
  $self->port( 8000 );
  
  # default to J2000
  $self->coordinate_type( "equatorial" );
  $self->equinox ( "J2000" );
  $self->raformat( "hh mm ss.ss" );
  $self->raunits( "hms" );
  $self->decformat( "dd mm ss.ss" );
  $self->decunits( "dms" );
  
  # default to using the queue with "normal" priority
  $self->priority( 3 );
  $self->target_type( "normal" );
  $self->target_ident( "SingleExposure" );
  $self->exposure_type( "time" );
  
  # default to a CCD camera, and an R-band filter
  $self->device_type( "camera" );
  $self->filter_type( "R" );

  # CONFIGURE FROM ARGUEMENTS
  # -------------------------

  # return unless we have arguments
  return undef unless @_;

  # grab the argument list
  my %args = @_;
				        
  # Loop over the keys that mean we're parsing a document
  for my $key (qw / File XML / ) {
     if ( lc($key) eq "file" && exists $args{$key} ) { 
        eval { $self->_parse( File => $args{$key} ); };
	if ( $@ ) {
	   die "$@";
	}   
	last;
	
     } elsif ( lc($key) eq "xml"  && exists $args{$key} ) {
        eval { $self->_parse( XML => $args{$key} ); };
	if ( $@ ) {
	   die "$@";
	}
	last;
	      
     }  
  }	
  
  # Loop over the rest of the keys
  for my $other (qw / Role Type Version DTD GroupCount ExposureTime Exposure
                      SignalToNoise Snr Flux ExposureType ExposureUnits
                      SeriesCount Interval Tolerance Priority TimeConstraint
                      DeviceType Device FilterType Filter TargetType TargetIdent
                      Identity TargetName Target CoordinateType Coordtype  
                      RA RAFormat RAUnits Dec DecFormat DecUnits Equinox
                      Host Port PortNumber ID UniqueID Name ObserverName
                      RealName User UserName Institution Email EmailAddress
                      Project Score CompletionTime Time Data / ) {
      my $method = lc($other);
      $self->$method( $args{$other} ) if exists $args{$other};
  }
  
  # Nothing to configure...
  return undef;

}


# P R I V A T E   M E T H O D S ------------------------------------------

sub _parse {
  my $self = shift;

  # return unless we have arguments
  return undef unless @_;

  # grab the argument list
  my %args = @_;

  my $xs = new XML::Simple( );

  # Loop over the allowed keys
  for my $key (qw / File XML / ) {
     if ( lc($key) eq "file" && exists $args{$key} ) {
        $args{$key} =~ s/US_ASCII/ISO-8859-1/; 
	$self->{DOCUMENT} = $xs->XMLin( $args{$key}, ForceArray => [ "ImageData" ] );
	last;
	
     } elsif ( lc($key) eq "xml"  && exists $args{$key} ) {
        $args{$key} =~ s/US_ASCII/ISO-8859-1/; 
	$self->{DOCUMENT} = $xs->XMLin( $args{$key}, ForceArray => [ "ImageData" ] );
	last;
	
     }  
  }
  
  #print Dumper( $self->{DOCUMENT} );      
  return;
}

# L A S T  O R D E R S ------------------------------------------------------

1;