package Astro::VO::VOEvent; =head1 NAME Astro::VO::VOEvent - Object interface to parse and create VOEvent messages =head1 SYNOPSIS To parse a VOEvent file, $object = new Astro::VO::VOEvent( File => $file_name ); or $object = new Astro::VO::VOEvent( XML => $scalar ); Or to build a VOEVENT file, $xml = $object->build( %hash ); =head1 DESCRIPTION The module can parse VOEvent messages, and serves as a limited convenience layer for building new messages. Functionality is currently very limited. =cut # L O A D M O D U L E S -------------------------------------------------- use strict; use vars qw/ $VERSION $SELF /; #use XML::Parser; use XML::Simple; use XML::Writer; use XML::Writer::String; use Net::Domain qw(hostname hostdomain); use File::Spec; use Carp; use Data::Dumper; '$Revision: 1.29 $ ' =~ /.*:\s(.*)\s\$/ && ($VERSION = $1); # C O N S T R U C T O R ---------------------------------------------------- =head1 REVISION $Id: VOEvent.pm,v 1.29 2006/11/17 16:54:40 voevent Exp $ =head1 METHODS =head2 Constructor =over 4 =item B Create a new instance from a hash of options $object = new Astro::VO::VOEvent( ); returns a reference to an VOEvent object. =cut sub new { my $proto = shift; my $class = ref($proto) || $proto; # bless the query hash into the class my $block = bless { DOCUMENT => undef, WRITER => undef, BUFFER => undef }, $class; # Configure the object $block->configure( @_ ); return $block; } # A C C E S S O R M E T H O D S ------------------------------------------- =back =head2 Accessor Methods =over 4 =item B Build a VOEvent document $xml = $object->build( Type => $string, Role => $string, ID => $url, Reference => { URL => $url, Type => $string } ); or $xml = $object->build( Type => $string, Role => $string, ID => $url, Description => $string, Citations => [ { ID => $strig, Cite => $string }, . . . { ID => $string, Cite => $string }], Who => { Publisher => $url, Contact => { Name => $string, Institution => $string, Address => $string, Telephone => $string, Email => $string, }, Date => $string }, WhereWhen => { RA => $ra, Dec => $dec, Error => $error, Time => $time }, How => { Name => $string, Location => $string, RTML => $url, Reference => { URL => $url, Type => $string, Name => $string } }, What => [ { Name => $strig, UCD => $string, Value => $string }, . . . { Name => $string, UCD => $string, Value => $string } ], Why => [ {Inference => { Probability => $string, Relation => $string, Name => string Concept => string }}, . . . {Inference => { Probability => $string, Relation => $string, Name => string Concept => string }}, . . . {Name => $string}, {Concept => $string } } ); this will create a document from the options passed to the method, most of the hash keys are optional and if missed out the relevant keywords will be blank or missing entirely from the built document. Type, Role, ID and either Reference or WhereWhen (and their sub-tags) are mandatory. The tag can be utilised from within the tag as follows What => [ { Group => [ { Name => $string, UCD => $string, Value => $string, Units => $string }, . . . { Name => $string, UCD => $string, Value => $string, Units => $string } ], }, { Group => [ { Name => $string, UCD => $string, Value => $string, Units => $string }, . . . { Name => $string, UCD => $string, Value => $string, Units => $string } ], }, { Name => $string, UCD => $string, Value => $string, Units => $string }, . . . { Name => $string, UCD => $string, Value => $string, Units => $string } ], this will probably NOT be the final API for the build() method, as it is overly complex. It is probably one or more convenience methods will be put ontop of this routine to make it easier to use. See the t/2_simple.t file in the test suite for an example which makes use of the complex form of the What tag above. NB: This is the low level interface to build a message, this is subject to change without notice as higher level "easier to use" accessor methods are added to the module. It may eventually be reclassified as a PRIVATE method. =cut sub build { my $self = shift; my %args = @_; # mandatory tags unless ( exists $args{Role} && exists $args{ID} ) { return undef; } # open the document $self->{WRITER}->xmlDecl( 'UTF-8' ); # BEGIN DOCUMENT ------------------------------------------------------- if ( exists $args{UseHTN} ) { $self->{WRITER}->startTag( 'VOEvent', #'type' => $args{Type}, 'role' => $args{Role}, 'id' => $args{ID}, 'version' => 'HTN/0.2' ); } elsif ( exists $args{UseQualified} ) { if ( exists $args{UseID} ) { $self->{WRITER}->startTag( 'VOEvent', #'type' => $args{Type}, 'role' => $args{Role}, 'id' => $args{ID}, 'version' => '1.1', 'xmlns' => 'http://www.ivoa.net/xml/VOEvent/v1.1', 'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance', 'xsi:schemaLocation' => 'http://www.ivoa.net/xml/VOEvent/v1.1 ' . 'http://www.ivoa.net/xml/VOEvent/VOEvent-v1.1.xsd' ); } else { $self->{WRITER}->startTag( 'VOEvent', #'type' => $args{Type}, 'role' => $args{Role}, 'ivorn' => $args{ID}, 'version' => '1.1', 'xmlns' => 'http://www.ivoa.net/xml/VOEvent/v1.1', 'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance', 'xsi:schemaLocation' => 'http://www.ivoa.net/xml/VOEvent/v1.1 ' . 'http://www.ivoa.net/xml/VOEvent/VOEvent-v1.1.xsd' ); } } else { $self->{WRITER}->startTag( 'voe:VOEvent', #'type' => $args{Type}, 'role' => $args{Role}, 'ivorn' => $args{ID}, 'version' => '1.1', 'xmlns:voe' => 'http://www.ivoa.net/xml/VOEvent/v1.1', 'xmlns:xsi' => 'http://www.w3.org/2001/XMLSchema-instance', 'xsi:schemaLocation' => 'http://www.ivoa.net/xml/VOEvent/v1.1 ' . 'http://www.ivoa.net/xml/VOEvent/VOEvent-v1.1.xsd' ); } # REFERENCE ONLY ------------------------------------------------------- if ( exists $args{Reference} ) { if ( exists $args{Description} ) { $self->{WRITER}->startTag( 'Description' ); $self->{WRITER}->characters( $args{Description} ); $self->{WRITER}->endTag( 'Description' ); } $self->{WRITER}->emptyTag( 'Reference', 'uri' => ${$args{Reference}}{URL}, 'type' => ${$args{Reference}}{Type} ); if( exists $args{UseHTN} || exists $args{UseQualified} ) { $self->{WRITER}->endTag( 'VOEvent' ); } else { $self->{WRITER}->endTag( 'voe:VOEvent' ); } $self->{WRITER}->end(); return $self->{BUFFER}->value(); } # SKELETON DOCUMENT ---------------------------------------------------- # DESCRIPTION if ( exists $args{Description} ) { $self->{WRITER}->startTag( 'Description' ); $self->{WRITER}->characters( $args{Description} ); $self->{WRITER}->endTag( 'Description' ); } # WHO if ( exists $args{Who} ) { $self->{WRITER}->startTag( 'Who' ); if ( exists ${$args{Who}}{Publisher} && ${$args{Who}}{Publisher} =~ 'ivo:' ) { $self->{WRITER}->startTag( 'AuthorIVORN' ); $self->{WRITER}->characters( ${$args{Who}}{Publisher} ); $self->{WRITER}->endTag( 'AuthorIVORN' ); } my $author_flag = 0; if ( exists ${$args{Who}}{Publisher} && ( ! (${$args{Who}}{Publisher} =~ 'ivo:') || exists ${$args{Who}}{Contact} ) ) { $self->{WRITER}->startTag( 'Author' ); $author_flag = 1; } # Backward compatible interface to older API, translate as much as possible the # RTML based format into the new IVOA RM format used in v1.1 if ( exists ${$args{Who}}{Publisher} && ! ${$args{Who}}{Publisher} =~ 'ivo:' ) { $self->{WRITER}->startTag( 'title' ); $self->{WRITER}->characters( ${$args{Who}}{Publisher} ); $self->{WRITER}->endTag( 'title' ); } if ( exists ${$args{Who}}{Contact} ) { if ( exists ${${$args{Who}}{Contact}}{Institution} ) { $self->{WRITER}->startTag( 'shortName' ); $self->{WRITER}->characters( ${${$args{Who}}{Contact}}{Institution} ); $self->{WRITER}->endTag( 'shortName' ); } if ( exists ${${$args{Who}}{Contact}}{Address} ) { $self->{WRITER}->startTag( 'contributor' ); $self->{WRITER}->characters( ${${$args{Who}}{Contact}}{Address} ); $self->{WRITER}->endTag( 'contributor' ); } if ( exists ${${$args{Who}}{Contact}}{Name} ) { $self->{WRITER}->startTag( 'contactName' ); $self->{WRITER}->characters( ${${$args{Who}}{Contact}}{Name} ); $self->{WRITER}->endTag( 'contactName' ); } if ( exists ${${$args{Who}}{Contact}}{Telephone} ) { $self->{WRITER}->startTag( 'contactPhone' ); $self->{WRITER}->characters( ${${$args{Who}}{Contact}}{Telephone} ); $self->{WRITER}->endTag( 'contactPhone' ); } if ( exists ${${$args{Who}}{Contact}}{Email} ) { $self->{WRITER}->startTag( 'contactEmail' ); $self->{WRITER}->characters( ${${$args{Who}}{Contact}}{Email} ); $self->{WRITER}->endTag( 'contactEmail' ); } } if ( $author_flag == 1 ) { $self->{WRITER}->endTag( 'Author' ); } # The new 1.1 format if ( exists ${$args{Who}}{AuthorIVORN} ) { $self->{WRITER}->startTag( 'AuthorIVORN' ); $self->{WRITER}->characters( ${$args{Who}}{AuthorIVORN} ); $self->{WRITER}->endTag( 'AuthorIVORN' ); } if ( exists ${$args{Who}}{Author} ) { $self->{WRITER}->startTag( 'Author' ); if( exists ${${$args{Who}}{Author}}{Title} ) { $self->{WRITER}->startTag( 'title' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{Title} ); $self->{WRITER}->endTag( 'title' ); } if( exists ${${$args{Who}}{Author}}{ShortName} ) { $self->{WRITER}->startTag( 'shortName' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{ShortName} ); $self->{WRITER}->endTag( 'shortName' ); } if( exists ${${$args{Who}}{Author}}{Contributor} ) { $self->{WRITER}->startTag( 'contributor' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{Contributor} ); $self->{WRITER}->endTag( 'contributor' ); } if( exists ${${$args{Who}}{Author}}{LogoURL} ) { $self->{WRITER}->startTag( 'logoURL' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{LogoURL} ); $self->{WRITER}->endTag( 'logoURL' ); } if( exists ${${$args{Who}}{Author}}{ContactName} ) { $self->{WRITER}->startTag( 'contactName' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{ContactName} ); $self->{WRITER}->endTag( 'contactName' ); } if( exists ${${$args{Who}}{Author}}{ContactEmail} ) { $self->{WRITER}->startTag( 'contactEmail' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{ContactEmail} ); $self->{WRITER}->endTag( 'contactEmail' ); } if( exists ${${$args{Who}}{Author}}{ContactPhone} ) { $self->{WRITER}->startTag( 'contactPhone' ); $self->{WRITER}->characters( ${${$args{Who}}{Author}}{ContactPhone} ); $self->{WRITER}->endTag( 'contactPhone' ); } $self->{WRITER}->endTag( 'Author' ); } # The tag didn't change between 1.0 and 1.1 if ( exists ${$args{Who}}{Date} ) { $self->{WRITER}->startTag( 'Date' ); $self->{WRITER}->characters( ${$args{Who}}{Date} ); $self->{WRITER}->endTag( 'Date' ); } $self->{WRITER}->endTag( 'Who' ); } # CITATIONS if ( exists $args{Citations} ) { $self->{WRITER}->startTag( 'Citations' ); my @array = @{$args{Citations}}; foreach my $i ( 0 ... $#array ) { if ( exists $args{UseID} ) { $self->{WRITER}->startTag( 'EventID','cite' => ${$array[$i]}{Cite} ); $self->{WRITER}->characters( ${$array[$i]}{ID} ); $self->{WRITER}->endTag( 'EventID' ); } else { $self->{WRITER}->startTag( 'EventIVORN','cite' => ${$array[$i]}{Cite} ); $self->{WRITER}->characters( ${$array[$i]}{ID} ); $self->{WRITER}->endTag( 'EventIVORN' ); } } $self->{WRITER}->endTag( 'Citations' ); } # WHERE & WHEN if ( exists $args{WhereWhen} ) { unless ( exists $args{UseHTN} ) { $self->{WRITER}->startTag( 'WhereWhen' ); $self->{WRITER}->startTag( 'ObsDataLocation', 'xmlns' => 'http://www.ivoa.net/xml/STC/stc-v1.30.xsd', 'xmlns:xlink' => 'http://www.w3.org/1999/xlink' ); $self->{WRITER}->emptyTag( 'ObservatoryLocation', 'id' => "GEOLUN", 'xlink:type' => 'simple', 'xlink:href' => 'ivo://STClib/Observatories#GEOLUN' ); $self->{WRITER}->startTag( 'ObservationLocation' ); $self->{WRITER}->emptyTag( 'AstroCoordSystem', 'id' => 'UTC-FK5-GEO', 'xlink:type' => 'simple', 'xlink:href' => 'ivo://STClib/CoordSys#UTC-FK5-GEO/' ); $self->{WRITER}->startTag( 'AstroCoords', 'coord_system_id' => 'UTC-FK5-GEO' ); $self->{WRITER}->startTag( 'Time', 'unit' => 's' ); $self->{WRITER}->startTag( 'TimeInstant' ); $self->{WRITER}->startTag( 'ISOTime' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{Time} ); $self->{WRITER}->endTag( 'ISOTime' ); $self->{WRITER}->endTag( 'TimeInstant' ); $self->{WRITER}->endTag( 'Time' ); $self->{WRITER}->startTag( 'Position2D', 'unit' => 'deg' ); $self->{WRITER}->startTag( 'Value2' ); $self->{WRITER}->startTag( 'C1' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{RA} ); $self->{WRITER}->endTag( 'C1' ); $self->{WRITER}->startTag( 'C2' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{Dec} ); $self->{WRITER}->endTag( 'C2' ); $self->{WRITER}->endTag( 'Value2' ); if ( exists ${$args{WhereWhen}}{Error} ) { $self->{WRITER}->startTag( 'Error2Radius' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{Error} ); $self->{WRITER}->endTag( 'Error2Radius' ); } $self->{WRITER}->endTag( 'Position2D' ); $self->{WRITER}->endTag( 'AstroCoords' ); $self->{WRITER}->endTag( 'ObservationLocation' ); $self->{WRITER}->endTag( 'ObsDataLocation' ); #$self->{WRITER}->startTag( 'WhereWhen' ); #$self->{WRITER}->startTag( 'stc:ObservationLocation' ); #$self->{WRITER}->startTag( 'crd:AstroCoords', # 'coord_system_id' => 'FK5-UTC' ); #$self->{WRITER}->startTag( 'crd:Time', 'unit' => 's' ); #$self->{WRITER}->startTag( 'crd:TimeInstant' ); #$self->{WRITER}->startTag( 'crd:TimeScale' ); #$self->{WRITER}->characters( 'UTC' ); #$self->{WRITER}->endTag( 'crd:TimeScale' ); #$self->{WRITER}->startTag( 'crd:ISOTime' ); #$self->{WRITER}->characters( ${$args{WhereWhen}}{Time} ); #$self->{WRITER}->endTag( 'crd:ISOTime' ); #$self->{WRITER}->endTag( 'crd:TimeInstant' ); #$self->{WRITER}->endTag( 'crd:Time' ); #$self->{WRITER}->startTag( 'crd:Position2D', 'unit' => 'deg' ); #$self->{WRITER}->startTag( 'crd:Value2'); #my $position = ${$args{WhereWhen}}{RA} . " " . ${$args{WhereWhen}}{Dec}; #$self->{WRITER}->characters( $position ); #$self->{WRITER}->endTag( 'crd:Value2' ); #if ( exists ${$args{WhereWhen}}{Error} ) { # $self->{WRITER}->startTag( 'crd:Error1Circle' ); # $self->{WRITER}->startTag( 'crd:Size' ); # $self->{WRITER}->characters( ${$args{WhereWhen}}{Error} ); # $self->{WRITER}->endTag( 'crd:Size' ); # $self->{WRITER}->endTag( 'crd:Error1Circle' ); #} #$self->{WRITER}->endTag( 'crd:Position2D' ); #$self->{WRITER}->endTag( 'crd:AstroCoords' ); #$self->{WRITER}->endTag( 'stc:ObservationLocation' ); } else { $self->{WRITER}->startTag( 'WhereWhen', 'type' => 'simple', ); $self->{WRITER}->startTag( 'RA', units => 'deg' ); $self->{WRITER}->startTag( 'Coord' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{RA} ); $self->{WRITER}->endTag( 'Coord' ); if ( defined ${$args{WhereWhen}}{Error} ) { $self->{WRITER}->emptyTag( 'Error', value => ${$args{WhereWhen}}{Error}, units => "arcmin" ); } $self->{WRITER}->endTag( 'RA' ); $self->{WRITER}->startTag( 'Dec', units => 'deg' ); $self->{WRITER}->startTag( 'Coord' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{Dec} ); $self->{WRITER}->endTag( 'Coord' ); if ( defined ${$args{WhereWhen}}{Error} ) { $self->{WRITER}->emptyTag( 'Error', value => ${$args{WhereWhen}}{Error}, units => "arcmin" ); } $self->{WRITER}->endTag( 'Dec' ); $self->{WRITER}->emptyTag( 'Epoch', value => "J2000.0" ); $self->{WRITER}->emptyTag( 'Equinox', value => "2000.0" ); $self->{WRITER}->startTag( 'Time' ); $self->{WRITER}->startTag( 'Value' ); $self->{WRITER}->characters( ${$args{WhereWhen}}{Time} ); $self->{WRITER}->endTag( 'Value' ); if ( exists ${$args{WhereWhen}}{TimeError} ) { $self->{WRITER}->emptyTag( 'Error', value => ${$args{WhereWhen}}{TimeError}, units => "s" ); } $self->{WRITER}->endTag( 'Time' ); } $self->{WRITER}->endTag( 'WhereWhen' ); } # HOW if ( exists $args{How} ) { $self->{WRITER}->startTag( 'How' ); #if ( exists ${$args{How}}{Name} ) { # $self->{WRITER}->startTag( 'Name' ); # $self->{WRITER}->characters( ${$args{How}}{Name} ); # $self->{WRITER}->endTag( 'Name' ); #} #if ( exists ${$args{How}}{Location} ) { # $self->{WRITER}->startTag( 'Location' ); # $self->{WRITER}->characters( ${$args{How}}{Location} ); # $self->{WRITER}->endTag( 'Location' ); #} if ( exists ${$args{How}}{RTML} ) { $self->{WRITER}->emptyTag( 'Reference' , uri => ${$args{How}}{RTML}, type => 'rtml', name => 'Phase 0' ); } if ( exists ${$args{How}}{Reference} ) { $self->{WRITER}->emptyTag( 'Reference' , uri => ${${$args{How}}{Reference}}{URL}, type => ${${$args{How}}{Reference}}{Type}, name => ${${$args{How}}{Reference}}{Name} ); } $self->{WRITER}->endTag( 'How' ); } # WHAT if ( exists $args{What} ) { $self->{WRITER}->startTag( 'What' ); my @array = @{$args{What}}; foreach my $i ( 0 ... $#array ) { my %hash = %{${$args{What}}[$i]}; if ( exists $hash{Group} ) { $self->{WRITER}->startTag( 'Group' ); my @subarray = @{$hash{Group}}; foreach my $i ( 0 ... $#subarray ) { # Only UNITS is optional for Param tags if ( exists ${$subarray[$i]}{Units} ) { $self->{WRITER}->emptyTag('Param', 'name' => ${$subarray[$i]}{Name}, 'ucd' => ${$subarray[$i]}{UCD}, 'value' => ${$subarray[$i]}{Value}, 'units' => ${$subarray[$i]}{Units} ); } else { $self->{WRITER}->emptyTag('Param', 'name' => ${$subarray[$i]}{Name}, 'ucd' => ${$subarray[$i]}{UCD}, 'value' => ${$subarray[$i]}{Value}, 'units' => ${$subarray[$i]}{Units} ); } } $self->{WRITER}->endTag( 'Group' ); } else { # Only UNITS is optional for Param tags if ( exists $hash{Units} ) { $self->{WRITER}->emptyTag('Param', 'name' => $hash{Name}, 'ucd' => $hash{UCD}, 'value' => $hash{Value}, 'units' => $hash{Units} ); } else { $self->{WRITER}->emptyTag('Param', 'name' => $hash{Name}, 'ucd' => $hash{UCD}, 'value' => $hash{Value} ); } } } $self->{WRITER}->endTag( 'What' ); } # WHY if ( exists $args{Why} ) { $self->{WRITER}->startTag( 'Why' ); my @array = @{$args{Why}}; foreach my $i ( 0 ... $#array ) { my %hash = %{${$args{Why}}[$i]}; if ( exists $hash{Inference} ) { if ( exists ${$hash{Inference}}{Relation} && exists ${$hash{Inference}}{Probability}) { $self->{WRITER}->startTag( 'Inference', 'probability' => ${$hash{Inference}}{Probability}, 'relation' => ${$hash{Inference}}{Relation} ); } elsif ( exists ${$hash{Inference}}{Probability}) { $self->{WRITER}->startTag( 'Inference', 'probability' => ${$hash{Inference}}{Probability} ); } elsif ( exists ${$hash{Inference}}{Relation} ) { $self->{WRITER}->startTag( 'Inference', 'relation' => ${$hash{Inference}}{Relation} ); } else { $self->{WRITER}->startTag( 'Inference'); } if( exists ${$hash{Inference}}{Concept} ) { $self->{WRITER}->startTag( 'Concept' ); $self->{WRITER}->characters( ${$hash{Inference}}{Concept} ); $self->{WRITER}->endTag( 'Concept' ); } if ( exists ${$hash{Inference}}{Name} ) { $self->{WRITER}->startTag( 'Name' ); $self->{WRITER}->characters( ${$hash{Inference}}{Name} ); $self->{WRITER}->endTag( 'Name' ); } $self->{WRITER}->endTag( 'Inference' ); } elsif( exists $hash{Name} ) { $self->{WRITER}->startTag( 'Name' ); $self->{WRITER}->characters( $hash{Name} ); $self->{WRITER}->endTag( 'Name' ); } elsif( exists $hash{Concept} ) { $self->{WRITER}->startTag( 'Concept' ); $self->{WRITER}->characters( $hash{Concept} ); $self->{WRITER}->endTag( 'Concept' ); } } $self->{WRITER}->endTag( 'Why' ); } # END DOCUMENT --------------------------------------------------------- if( exists $args{UseHTN} || exists $args{UseQualified} ) { $self->{WRITER}->endTag( 'VOEvent' ); } else { $self->{WRITER}->endTag( 'voe:VOEvent' ); } $self->{WRITER}->end(); my $xml = $self->{BUFFER}->value(); $self->_parse( XML => $xml ); return $xml; } =item B Return the id of the VOEvent document $object = new Astro::VO::VOEvent( XML => $scalar ); $id = $object->id(); =cut sub id { my $self = shift; my $id; if ( defined $self->{DOCUMENT}->{ivorn} ) { $id = $self->{DOCUMENT}->{ivorn}; } else { $id = $self->{DOCUMENT}->{id}; } return $id; } =item B Return the role of the VOEvent document $object = new Astro::VO::VOEvent( XML => $scalar ); $id = $object->role(); =cut sub role { my $self = shift; return $self->{DOCUMENT}->{role}; } =item B Return the version of the VOEvent document $object = new Astro::VO::VOEvent( XML => $scalar ); $version = $object->version(); =cut sub version { my $self = shift; return $self->{DOCUMENT}->{version}; } =item B Return the human readable description from the VOEvent document $object = new Astro::VO::VOEvent( XML => $scalar ); $string = $object->description(); =cut sub description { my $self = shift; return $self->{DOCUMENT}->{Description}; } =item B{ra} Return the RA of the object as given in the tag $object = new Astro::VO::VOEvent( XML => $scalar ); $ra = $object->ra(); =cut sub ra { my $self = shift; my %ra; if ( defined $self->{DOCUMENT}->{WhereWhen}->{type} && $self->{DOCUMENT}->{WhereWhen}->{type} eq "simple" ) { if( defined $self->{DOCUMENT}->{WhereWhen}->{RA}->{Coord} ) { $ra{value} = $self->{DOCUMENT}->{WhereWhen}->{RA}->{Coord}; } elsif ( defined $self->{DOCUMENT}->{WhereWhen}->{Ra}->{Coord} ) { $ra{value} = $self->{DOCUMENT}->{WhereWhen}->{Ra}->{Coord}; } $ra{units} = $self->{DOCUMENT}->{WhereWhen}->{RA}->{units}; $ra{error} = {"value" => $self->{DOCUMENT}->{WhereWhen}->{RA}->{Error}{value}, "units" => $self->{DOCUMENT}->{WhereWhen}->{RA}->{Error}{units}}; } else { #print Dumper( $self->{DOCUMENT}->{WhereWhen} ); # Try old style eSTAR default my $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"crd:Position2D"}->{"crd:Value2"}; my ($ra, $dec) = split " ", $string if defined $string; $ra{value} = $ra; $ra{units} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"crd:Position2D"}->{unit}; # Try RAPTOR default unless ( defined $ra{value} ) { $ra{value} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"}->{"stc:Position2D"} ->{"stc:Value2"}->{"stc:C1"}; $ra{units} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"}->{"stc:Position2D"} ->{unit}; } # Try new style v1.1 default unless ( defined $ra{value} ) { $ra{value} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{'Position2D'} ->{'Value2'}->{'C1'}; $ra{units} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{'Position2D'} ->{unit}; } # Try new style v1.1 default with the # and the tags added into the path. unless ( defined $ra{value} ) { $ra{value} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{'Position2D'}->{'Value2'}->{'C1'}; $ra{units} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{'Position2D'}->{unit}; } } return ( wantarray ? %ra : $ra{"value"} ); } =item B{dec} Return the Dec of the object as given in the tag $object = new Astro::VO::VOEvent( XML => $scalar ); $dec = $object->dec(); =cut sub dec { my $self = shift; my %dec; if ( defined $self->{DOCUMENT}->{WhereWhen}->{type} && $self->{DOCUMENT}->{WhereWhen}->{type} eq "simple" ) { $dec{value} = $self->{DOCUMENT}->{WhereWhen}->{Dec}->{Coord}; $dec{units} = $self->{DOCUMENT}->{WhereWhen}->{Dec}->{units}; $dec{error} = {"value"=>$self->{DOCUMENT}->{WhereWhen}->{Dec}->{Error}{value}, "units"=>$self->{DOCUMENT}->{WhereWhen}->{Dec}->{Error}{units}}; } else { # Try old style eSTAR default my $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"crd:Position2D"}->{"crd:Value2"}; my ($ra, $dec) = split " ", $string if defined $string; $dec{value} = $dec; $dec{units} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"crd:Position2D"}->{unit}; # Try RAPTOR default unless ( defined $dec{value} ) { $dec{value} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"}->{"stc:Position2D"} ->{"stc:Value2"}->{"stc:C2"}; $dec{units} = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"}->{"stc:Position2D"} ->{unit}; } # Try new style v1.1 default unless ( defined $dec{value} ) { $dec{value} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{'Position2D'} ->{'Value2'}->{'C2'}; $dec{units} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{'Position2D'} ->{unit}; } # Try new style v1.1 default with the # and the tags added into the path. unless ( defined $dec{value} ) { $dec{value} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{'Position2D'}->{'Value2'}->{'C2'}; $dec{units} = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{'Position2D'}->{unit}; } } return ( wantarray ? %dec : $dec{"value"} ); } =item B{epoch} Return the Dec of the object as given in the tag $object = new Astro::VO::VOEvent( XML => $scalar ); $epoch = $object->epoch(); =cut sub epoch { my $self = shift; if ( defined $self->{DOCUMENT}->{WhereWhen}->{type} && $self->{DOCUMENT}->{WhereWhen}->{type} eq "simple" ) { return $self->{DOCUMENT}->{WhereWhen}->{Epoch}->{value}; } else { # old style eSTAR default my $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"coord_system_id"}; # RAPTOR default unless (defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"} ->{"coord_system_id"}; } # new style v1.1 default unless ( defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{"coord_system_id"}; } # Try new style v1.1 default with and # tags unless ( defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{"coord_system_id"}; } if( $string =~ "FK5" ) { return "J2000.0"; } else { return undef; } } } =item B{equinox} Return the Dec of the object as given in the tag $object = new Astro::VO::VOEvent( XML => $scalar ); $equinox = $object->equinox(); =cut sub equinox { my $self = shift; if ( defined $self->{DOCUMENT}->{WhereWhen}->{type} && $self->{DOCUMENT}->{WhereWhen}->{type} eq "simple" ) { return $self->{DOCUMENT}->{WhereWhen}->{Equinox}->{value}; } else { # eSTAR default my $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"coord_system_id"}; # RAPTOR default unless (defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"} ->{"coord_system_id"}; } # new style v1.1 default unless ( defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{"coord_system_id"}; } # Try new style v1.1 default with and # the tags unless ( defined $string ) { $string = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{"coord_system_id"}; } if( $string =~ "FK5" ) { return "2000.0"; } else { return undef; } } } =item B{time} Return the Time of the object as given in the tag $object = new Astro::VO::VOEvent( XML => $scalar ); $time = $object->time(); =cut sub time { my $self = shift; my $time; if ( defined $self->{DOCUMENT}->{WhereWhen}->{type} && $self->{DOCUMENT}->{WhereWhen}->{type} eq "simple" ) { $time = $self->{DOCUMENT}->{WhereWhen}->{Time}->{Value}; } else { # old style eSTAR default $time = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObservationLocation"}-> {"crd:AstroCoords"}->{"crd:Time"}->{"crd:TimeInstant"}->{"crd:ISOTime"}; # RAPTOR default unless ( defined $time ) { $time = $self->{DOCUMENT}->{WhereWhen}->{"stc:ObsDataLocation"} ->{"stc:ObservationLocation"}->{"stc:AstroCoords"} ->{"stc:Time"}->{"stc:TimeInstant"}->{"stc:ISOTime"}; } # new style v1.1 default unless ( defined $time ) { $time = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservationLocation'}->{'AstroCoords'}->{"Time"} ->{"TimeInstant"}->{"ISOTime"}; } # Try new style v1.1 default with and # the tags unless ( defined $time ) { $time = $self->{DOCUMENT}->{WhereWhen}->{'ObsDataLocation'} ->{'ObservatoryLocation'}->{'ObservationLocation'} ->{'AstroCoordSystem'}->{'AstroCoords'} ->{"Time"}->{"TimeInstant"}->{"ISOTime"}; } } # There isn't a (valid?) see if there is a timestamp in # the tag as this might also carry a publication datestamp. unless ( defined $time ) { $time = $self->{DOCUMENT}->{Who}->{Date}; } return $time; } =item B{what} Return the and 's of s in the tag, $object = new Astro::VO::VOEvent( XML => $scalar ); %what = $object->what(); =cut sub what { my $self = shift; if ( defined $self->{DOCUMENT}->{What} ) { return %{$self->{DOCUMENT}->{What}}; } else { return undef; } } # C O N F I G U R E --------------------------------------------------------- =back =head2 General Methods =over 4 =item B Configures the object, takes an options hash as an argument $rtml->configure( %options ); does nothing if the hash is not supplied. =cut 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, DATA_INDENT => 4 ); # CONFIGURE FROM ARGUEMENTS # ------------------------- # return unless we have arguments return undef unless @_; # grab the argument list my %args = @_; # Loop over the allowed keys for my $key (qw / File XML / ) { if ( lc($key) eq "file" && exists $args{$key} ) { $self->_parse( File => $args{$key} ); last; } elsif ( lc($key) eq "xml" && exists $args{$key} ) { $self->_parse( XML => $args{$key} ); last; } } # Nothing to configure... return undef; } # T I M E A T T H E B A R -------------------------------------------- =back =head1 COPYRIGHT Copyright (C) 2002 University of Exeter. All Rights Reserved. This program was written as part of the eSTAR project and is free software; you can redistribute it and/or modify it under the terms of the GNU Public License. =head1 AUTHORS Alasdair Allan Eaa@astro.ex.ac.ukE, =cut # P R I V A T E M E T H O D S ------------------------------------------ =begin __PRIVATE_METHODS__ =head2 Private Methods These methods are for internal use only. =over 4 =item B<_parse> Private method to parse a VOEvent document $object->_parse( File => $file_name ); $object->_parse( XML => $scalar ); this should not be called directly =cut 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} ) { $self->{DOCUMENT} = $xs->XMLin( $args{$key} ); last; } elsif ( lc($key) eq "xml" && exists $args{$key} ) { $self->{DOCUMENT} = $xs->XMLin( $args{$key} ); last; } } #print Dumper( $self->{DOCUMENT} ); return; } # L A S T O R D E R S ------------------------------------------------------ 1;