File Coverage

lib/Astro/Montenbruck/Ephemeris/Planet.pm
Criterion Covered Total %
statement 53 54 98.1
branch n/a
condition n/a
subroutine 10 11 90.9
pod 3 3 100.0
total 66 68 97.0


line stmt bran cond sub pod time code
1             package Astro::Montenbruck::Ephemeris::Planet;
2 1     1   8 use strict;
  1         2  
  1         34  
3 1     1   6 use warnings;
  1         2  
  1         34  
4              
5 1     1   6 use Readonly;
  1         3  
  1         47  
6 1     1   6 use Math::Trig qw/:pi rad2deg/;
  1         2  
  1         113  
7 1     1   400 use Astro::Montenbruck::MathUtils qw/frac polar/;
  1         3  
  1         263  
8              
9             our $VERSION = 0.02;
10              
11             Readonly our $MO => 'Moon';
12             Readonly our $SU => 'Sun';
13             Readonly our $ME => 'Mercury';
14             Readonly our $VE => 'Venus';
15             Readonly our $MA => 'Mars';
16             Readonly our $JU => 'Jupiter';
17             Readonly our $SA => 'Saturn';
18             Readonly our $UR => 'Uranus';
19             Readonly our $NE => 'Neptune';
20             Readonly our $PL => 'Pluto';
21              
22             Readonly::Array our @PLANETS =>
23             ( $MO, $SU, $ME, $VE, $MA, $JU, $SA, $UR, $NE, $PL );
24              
25 1     1   8 use Exporter qw/import/;
  1         2  
  1         593  
26              
27             our %EXPORT_TAGS = ( ids => [qw/$MO $SU $ME $VE $MA $JU $SA $UR $NE $PL/], );
28              
29             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'ids'} }, '@PLANETS' );
30              
31             sub new {
32 24     24 1 124 my ( $class, %arg ) = @_;
33 24         286 bless { _id => $arg{id}, }, $class;
34             }
35              
36              
37             # from the time derivatives of the polar coordinates (l, b, r)
38             # derive the components of the velocity vector in ecliptic coordinates
39             sub _posvel {
40 36     36   90 my ( $self, $l, $b, $r, $dl, $db, $dr ) = @_;
41 36         68 my $cl = cos($l);
42 36         64 my $sl = sin($l);
43 36         58 my $cb = cos($b);
44 36         67 my $sb = sin($b);
45 36         51 my $x = $r * $cl * $cb;
46 36         83 my $vx = $dr * $cl * $cb - $dl * $r * $sl * $cb - $db * $r * $cl * $sb;
47 36         69 my $y = $r * $sl * $cb;
48 36         72 my $vy = $dr * $sl * $cb + $dl * $r * $cl * $cb - $db * $r * $sl * $sb;
49 36         60 my $z = $r * $sb;
50 36         67 my $vz = $dr * $sb + $db * $r * $cb;
51              
52 36         100 $x, $y, $z, $vx, $vy, $vz;
53             }
54              
55             sub _geocentric {
56 18     18   58 my ( $self, $t, $hpla_ref, $gsun_ref ) = @_;
57              
58 18         59 my $m = pi2 * frac( 0.9931266 + 99.9973604 * $t ); # Sun
59             # calculate the heliocentric velosity vector, which is required
60             # to take account of the various aberration effects.
61 18         48 my $dls = 172.00 + 5.75 * sin($m);
62 18         39 my $drs = 2.87 * cos($m);
63 18         40 my $dbs = 0.0;
64             ###
65 18         60 my ( $dl, $db, $dr ) = $self->_lbr_geo($t);
66              
67             # ecliptic geocentric coordinates of the Sun
68             my ( $xs, $ys, $zs, $vxs, $vys, $vzs ) =
69 18         88 $self->_posvel( $gsun_ref->{l}, $gsun_ref->{b}, $gsun_ref->{r}, $dls, $dbs, $drs );
70             # ecliptic heliocentric coordinates of the planet
71             my ( $xp, $yp, $zp, $vx, $vy, $vz ) =
72 18         52 $self->_posvel( $hpla_ref->{l}, $hpla_ref->{b}, $hpla_ref->{r}, $dl, $db, $dr );
73 18         35 my $x = $xp + $xs;
74 18         32 my $y = $yp + $ys;
75 18         34 my $z = $zp + $zs;
76              
77             # mean heliocentric motion
78 18         34 my $delta0 = sqrt( $x * $x + $y * $y + $z * $z );
79 18         40 my $fac = 0.00578 * $delta0 * 1E-4;
80              
81             # apparent
82 18         34 $x -= $fac * ( $vx + $vxs );
83 18         24 $y -= $fac * ( $vy + $vys );
84 18         63 $z -= $fac * ( $vz + $vzs );
85              
86 18         74 $x, $y, $z # ecliptic geocentric coordinates of the planet
87             }
88              
89             sub position {
90 18     18 1 51 my ( $self, $t, $sun, $nut_func ) = @_;
91 18         62 my ( $l, $b, $r ) = $self->heliocentric($t);
92             # geocentric ecliptic coordinates (light-time corrected)
93 18         140 my ( $rad, $the, $phi ) = polar(
94             $nut_func->(
95             $self->_geocentric( $t, { l => $l, b => $b, r => $r }, $sun )
96             )
97             );
98             # convert to degrees
99 18         93 rad2deg($phi), rad2deg($the), $rad;
100             }
101              
102             sub heliocentric {
103 0     0 1   die "Must be overriden by a descendant";
104             }
105              
106             1;
107             __END__
108              
109             =pod
110              
111             =encoding UTF-8
112              
113             =head1 NAME
114              
115             Astro::Montenbruck::Ephemeris::Planet - Base class for a planet.
116              
117             =head1 SYNOPSIS
118              
119             package Astro::Montenbruck::Ephemeris::Planet::Mercury;
120             use base qw/Astro::Montenbruck::Ephemeris::Planet/;
121             ...
122              
123             sub heliocentric {
124             # implement the method
125             }
126              
127              
128             =head1 DESCRIPTION
129              
130             Base class for a planet. Designed to be extended. Used internally in
131             Astro::Montenbruck::Ephemeris modules. Subclasses must implement B<heliocentric>
132             method.
133              
134             =head1 SUBROUTINES/METHODS
135              
136             =head2 $planet = Astro::Montenbruck::Ephemeris::Planet->new( $id )
137              
138             Constructor. B<$id> is identifier from C<@PLANETS> array (See L</"EXPORTED CONSTANTS">).
139              
140             =head2 $self->position($t, $sun)
141              
142             Geocentric ecliptic coordinates of a planet
143              
144             =head3 Arguments
145              
146             =over
147              
148             =item *
149              
150             B<$t> — time in Julian centuries since J2000: C<(JD-2451545.0)/36525.0>
151              
152             =item *
153              
154             B<$sun> — ecliptic geocentric coordinates of the Sun (hashref with B<'x'>, B<'y'>, B<'z'> keys)
155              
156             =back
157              
158             =head3 Returns
159              
160             Array of geocentric ecliptical coordinates.
161              
162             =over
163              
164             =item * longitude, arc-degrees
165              
166             =item * latitude, arc-degrees
167              
168             =item * distance from Earth, AU
169              
170             =back
171              
172             =head2 $self->heliocentric($t)
173              
174             Given time in centuries since epoch 2000.0, calculate apparent geocentric
175             ecliptical coordinates C<($l, $b, $r)>.
176              
177             =over
178              
179             =item * B<$l> — longitude, radians
180              
181             =item * B<$b> — latitude, radians
182              
183             =item * B<$r> — distance from Earth, A.U.
184              
185             =back
186              
187              
188              
189             =head1 EXPORTED CONSTANTS
190              
191             =over
192              
193             =item * C<$MO> — Moon
194              
195             =item * C<$SU> — Sun
196              
197             =item * C<$ME> — Mercury
198              
199             =item * C<$VE> — Venus
200              
201             =item * C<$MA> — Mars
202              
203             =item * C<$JU> — Jupiter
204              
205             =item * C<$SA> — Saturn
206              
207             =item * C<$UR> — Uranus
208              
209             =item * C<$NE> — Neptune
210              
211             =item * C<$PL> — Pluto
212              
213             =item * C<@PLANETS> — array containing all the ids listed above
214              
215             =back
216              
217             =head1 AUTHOR
218              
219             Sergey Krushinsky, C<< <krushi at cpan.org> >>
220              
221             =head1 COPYRIGHT AND LICENSE
222              
223             Copyright (C) 2009-2019 by Sergey Krushinsky
224              
225             This library is free software; you can redistribute it and/or modify
226             it under the same terms as Perl itself.
227              
228             =cut