view release on metacpan or  search on metacpan

lib/Astro/Coords.pm  view on Meta::CPAN

The cache is per-object.

=over 4

=item B<_cache_write>

Add the supplied values to the cache. Values can be provided in a hash.
The choice of key names is up to the caller.

  $c->_cache_write( AZ => $az, EL => $el );

Nothing is stored if the date stored in the object is not fixed.

=cut

sub _cache_write {
  my $self = shift;
  my %add = @_;

  my $primary = $self->_cache_key;
  return () unless defined $primary;

  my $C = $self->_cache_ref;

  if (!exists $C->{$primary}) {
    $C->{$primary} = {};
  }

  my $local = $C->{$primary};

  for my $key (keys %add) {
    $local->{$key} = $add{$key};
  }
  return;
}

=item B<_cache_read>

Retrieve value(s) from the cache. Returns undef if no value is available.

  ($az, $el) = $c->_cache_read( "AZ", "EL" );

In scalar context, returns the first value.

=cut

sub _cache_read {
  my $self = shift;
  my @keys = @_;

  my $primary = $self->_cache_key;
  return () unless defined $primary;

  my $C = $self->_cache_ref;

  return () unless exists $C->{$primary};
  my $local = $C->{$primary};
  return () unless defined $local;

  my @answer =  map { $local->{$_} } @keys;
#  print "Caller: ". join(":", caller() ) ."\n";
#  print "Getting cache values for ". join(":",@keys) ."\n";
#  print "Getting cache values for ". join(":",@answer) ."\n";
  return (wantarray() ? @answer : $answer[0] );
}

=item B<_calc_cache_key>

Internal (to the cache system) function for calculating the cache
key for the current epoch.

  $key = $c->_calc_cache_key;

Use the _cache_key() method to return the result.

Caching is disabled if C<datetime_is_unsafe>, C<usenow> or no
DateTime object is available.

=cut

sub _calc_cache_key {
  my $self = shift;
#  return; # This will disable caching

  # if we have a floating clock we do not want to cache
  if (!$self->has_datetime || $self->usenow || $self->datetime_is_unsafe) {
    $self->_cache_key( undef );
    return;
  }

  # The cache key currently uses the time and the telescope name
  my $dt = $self->datetime;
  my $tel = $self->telescope;
  my $telName = (defined $tel ? $tel->name : "NONE" );

  print "# Calculating cache key using $telName and ". $dt->epoch ."\n"
    if $DEBUG;

  # usually epoch is quicker to generate than ISO date but we have to
  # be careful about fractional seconds in DateTime (Time::Piece can
  # not do it)

  my $addendum = "";
  $addendum = $dt->nanosecond if $dt->can("nanosecond");

  # Use date + telescope name as key
  $self->_cache_key($telName . "_" . $dt->epoch. $addendum);
}

=item B<_cache_key>

Retrieve the current key suitable for caching results.
The key should have been calculated using _calc_cache_key().
Can be undef if caching is disabled.

  $key = $c->_cache_key;

=cut

sub _cache_key {
  my $self = shift;