1# Copyrights 2008-2015 by [Mark Overmeer].
2#  For other contributors see ChangeLog.
3# See the manual pages for details on the licensing terms.
4# Pod stripped from pm file by OODoc 2.01.
5use warnings;
6use strict;
7
8package Geo::EOP;
9use vars '$VERSION';
10$VERSION = '0.50';
11
12use base 'Geo::GML';
13
14use Geo::EOP::Util;   # all
15use Geo::GML::Util  qw/:gml311/;
16
17use Log::Report 'geo-eop', syntax => 'SHORT';
18use XML::Compile::Util  qw/unpack_type pack_type type_of_node/;
19use Math::Trig          qw/rad2deg deg2rad/;
20
21# map namespace always to the newest implementation of the protocol
22my %ns2version =
23  ( &NS_HMA_ESA => '1.0'
24  , &NS_EOP_ESA => '1.2.1'
25  );
26
27# list all available versions
28# It is a pity that not all schema use the same prefixes... sometimes,
29# the dafault prefix is used... therefore, we have to configure all that
30# manually.
31
32my @stdprefs =   # will be different in the future
33 ( sar => NS_SAR_ESA
34 , atm => NS_ATM_ESA
35 , gml => NS_GML_311
36 );
37
38my %info =
39  ( '1.0'     =>
40      { prefixes    => {hma => NS_HMA_ESA, ohr => NS_OHR_ESA, @stdprefs}
41      , eop_schemas => [ 'hma1.0/{eop,sar,opt,atm}.xsd' ]
42      , gml_schemas => [ 'eop1.1/gmlSubset.xsd' ]
43      , gml_version => '3.1.1eop'
44      }
45
46  , '1.1'     =>
47      { prefixes    => {eop => NS_EOP_ESA, opt => NS_OPT_ESA, @stdprefs}
48      , eop_schemas => [ 'eop1.1/{eop,sar,opt,atm}.xsd' ]
49      , gml_schemas => [ 'eop1.1/gmlSubset.xsd' ]
50      , gml_version => '3.1.1eop'
51      }
52
53  , '1.2beta' =>
54      { prefixes    => {eop => NS_EOP_ESA, opt => NS_OPT_ESA, @stdprefs}
55      , eop_schemas => [ 'eop1.2beta/{eop,sar,opt,atm}.xsd' ]
56      , gml_schemas => [ 'eop1.1/gmlSubset.xsd' ]
57      , gml_version => '3.1.1eop'
58      }
59
60  , '1.2.1' =>
61      { prefixes    => {eop => NS_EOP_ESA, opt => NS_OPT_ESA, @stdprefs}
62      , eop_schemas => [ 'eop1.2.1/{eop,sar,opt,atm}.xsd' ]
63      , gml_schemas => [ 'eop1.2.1/gmlSubset.xsd' ]
64      , gml_version => '3.1.1eop'
65      }
66
67# , '2.0' =>
68#     { eop_schemas => [ 'eop2.0/*.xsd' ]
69#     , gml_version => '3.2.1'
70#     }
71
72  );
73
74my %measure =
75  ( rad_deg   => sub { rad2deg $_[0] }
76  , deg_rad   => sub { deg2rad $_[0] }
77  , '%_float' => sub { $_[0] / 100 }
78  , 'float_%' => sub { sprintf "%.2f", $_[0] / 100 }
79  );
80sub _convert_measure($@);
81
82# This list must be extended, but I do not know what people need.
83my @declare_always = ();
84
85
86sub new($@) { my $class = shift; $class->SUPER::new('RW', @_) }
87
88sub init($)
89{   my ($self, $args) = @_;
90    $args->{allow_undeclared} = 1
91        unless exists $args->{allow_undeclared};
92
93    my $version  =  $args->{eop_version}
94        or error __x"EOP object requires an explicit eop_version";
95
96    unless(exists $info{$version})
97    {   exists $ns2version{$version}
98            or error __x"EOP version {v} not recognized", v => $version;
99        $version = $ns2version{$version};
100    }
101    $self->{GE_version} = $version;
102    my $info            = $info{$version};
103
104    $args->{version}    = $info->{gml_version};
105    if($info->{gml_schemas})  # using own GML 3.1.1 subset
106    {   $self->_register_gml_version($info->{gml_version} => {});
107    }
108
109    $self->SUPER::init($args);
110
111    $self->addPrefixes($info->{prefixes});
112
113    (my $xsd = __FILE__) =~ s!\.pm!/xsd!;
114    my @xsds    = map {glob "$xsd/$_"}
115       @{$info->{eop_schemas} || []}, @{$info->{gml_schemas} || []};
116
117    $self->importDefinitions(\@xsds);
118
119    my $units = delete $args->{units};
120    if($units)
121    {   if(my $a = $units->{angle})
122        {   $self->addHook(type => 'gml:AngleType'
123              , after => sub { _convert_measure $a, @_} );
124        }
125        if(my $d = $units->{distance})
126        {   $self->addHook(type => 'gml:MeasureType'
127              , after => sub { _convert_measure $d, @_} );
128        }
129        if(my $p = $units->{percentage})
130        {   $self->addHook(path => qr/Percentage/
131              , after => sub { _convert_measure $p, @_} );
132        }
133    }
134
135    $self;
136}
137
138sub declare(@)
139{   my $self = shift;
140
141    my $direction = $self->direction;
142
143    $self->declare($direction, $_)
144        for @_, @declare_always;
145
146    $self;
147}
148
149
150sub from($@)
151{   my ($thing, $data, %args) = @_;
152    my $xml = XML::Compile->dataToXML($data);
153
154    my $product = type_of_node $xml;
155    my $version = $xml->getAttribute('version');
156    defined $version
157        or error __x"no version attribute in root element";
158
159    my $self;
160    if(ref $thing)   # instance method
161    {   $self = $thing;
162    }
163    else             # class method
164    {   exists $info{$version}
165            or error __x"EOP version {version} not (yet) supported.  Upgrade Geo::EOP or inform author"
166                , version => $version;
167
168        $self    = $thing->new(eop_version => $version);
169    }
170
171    my $r       = $self->reader($product, %args);
172    defined $r
173        or error __x"do not understand root node {type}", type => $product;
174
175    ($product, $r->($xml));
176}
177
178#---------------------------------
179
180
181sub eopVersion() {shift->{GE_version}}
182
183#--------------
184
185
186sub printIndex(@)
187{   my $self = shift;
188    my $fh   = @_ % 2 ? shift : select;
189    $self->SUPER::printIndex($fh
190      , kinds => 'element', list_abstract => 0, @_);
191}
192
193# This code will probaby move to Geo::GML
194sub _convert_measure($@)   # not $$$$ for right context
195{   my ($to, $node, $data, $path) = @_;
196    ref $data eq 'HASH'  or return $data;
197    my ($val, $from) = @$data{'_', 'uom'};
198    defined $val && $from or return $data;
199
200    return $val if $from eq $to;
201    my $code = $measure{$from.'_'.$to} or return $data;
202    $code->($val);
203}
204
205#----------------------
206
207
2081;
209