package Astro::App::Satpass2::FormatTime;

use 5.008;

use strict;
use warnings;

use POSIX ();

use base qw{ Astro::App::Satpass2::Copier };

our $VERSION = '0.023';

use constant ROUND_TIME => 1;

my $delegate = eval {
    require Astro::App::Satpass2::FormatTime::DateTime::Strftime;
    'Astro::App::Satpass2::FormatTime::DateTime::Strftime';
} || do {
    require Astro::App::Satpass2::FormatTime::POSIX::Strftime;
    'Astro::App::Satpass2::FormatTime::POSIX::Strftime';
};

sub new {
    my ( $class, @args ) = @_;
    ref $class and $class = ref $class;

    __PACKAGE__ eq $class and $class = $delegate;

    my $self = {
	round_time	=> ROUND_TIME,
    };
    bless $self, $class;
    return $self;
}

sub attribute_names {
    return ( qw{ gmt tz } );
}

sub format_datetime {	## no critic (RequireFinalReturn)
    my ( $self ) = @_;
    # ->weep() throws an exception.
    $self->warner()->weep(
	'Method format_datetime() must be overridden' );
}

{

    my %cache;

    sub format_datetime_width {
	my ( $self, $tplt ) = @_;

	my $class = ref $self;

	exists $cache{$class}{$tplt}
	    and return $cache{$class}{$tplt};

	my ( $time, $wid ) = $self->_format_datetime_width_try( $tplt, undef,
	    year => 2100 );
	( $time, $wid ) = $self->_format_datetime_width_try( $tplt, $time,
	    month => 1 .. 12 );
	( $time, $wid ) = $self->_format_datetime_width_try( $tplt, $time,
	    day => 1 .. 7 );
	( $time, $wid ) = $self->_format_datetime_width_try( $tplt, $time,
	    hour => 6, 18 );

	return ( $cache{$class}{$tplt} = $wid );
    }

}

sub _format_datetime_width_try {
    my ( $self, $tplt, $time, $name, @try ) = @_;
    my $wid;
    my $max_trial;
    foreach my $trial ( @try ) {
	$time = $self->__format_datetime_width_adjust_object(
	    $time, $name, $trial );
	my $size = length $self->format_datetime( $tplt, $time );
	defined $wid and $size <= $wid and next;
	$wid = $size;
	$max_trial = $trial;
    }
    $time = $self->__format_datetime_width_adjust_object( $time, $name, $max_trial );
    return ( $time, $wid );
}

{
    my %valid = (
	hour	=> 3600,
	minute	=> 60,
	second	=> 1,
    );

    sub round_time {
	my ( $self, @arg ) = @_;
	if ( @arg ) {
	    my $val = $arg[0];
	    if ( defined $val && $val =~ m/ [^0-9] /smx ) {
		exists $valid{$val}
		    or $self->warner()->wail( "Invalid rounding spec '$val'" );
		$val = $valid{$val}
	    }
	    $self->{round_time} = $val;
	    return $self;
	} else {
	    return $self->{round_time};
	}
    }
}

sub __round_time_value {
    my ( $self, $time ) = @_;
    ref $time
	and return $time;
    if ( defined( my $round = $self->round_time() ) ) {
	$time = POSIX::floor( ( $time + $round / 2 ) / $round ) * $round;
    }
    return $time;
}

__PACKAGE__->create_attribute_methods();


1;

__END__

=head1 NAME

Astro::App::Satpass2::FormatTime - Format time for output.

=head1 SYNOPSIS

 use Astro::App::Satpass2::FormatTime;
 my $ft = Astro::App::Satpass2::FormatTime->new();
 print 'The time is ', $ft->format_datetime( '%H:%M:%S', time );

=head1 NOTICE

This class and its subclasses are private to the
L<Astro::App::Satpass2|Astro::App::Satpass2> package. The author reserves the right to
add, change, or retract functionality without notice.

=head1 DETAILS

This class abstracts time formatting for Astro::App::Satpass2.

=head1 METHODS

This class supports the following public methods in addition to those
inherited from L<Astro::App::Satpass2::Copier|Astro::App::Satpass2::Copier>.

=head2 new

 my $ft = Astro::App::Satpass2::FormatTime->new();

This method instantiates a time formatter object.

=head2 gmt

 $ft->gmt ( 1 );
 print 'The gmt attribute is ', $ft->gmt() ? "true\n" : "false\n";

This method is both accessor and mutator for the C<gmt> attribute. This
boolean attribute provides a default for the C<gmt> argument of
L<format_datetime()|/format_datetime>.

If called with an argument, the argument becomes the new value of the
C<gmt> attribute. The object is returned to allow call chaining.

If called without an argument, the current value of the C<gmt> attribute
is returned.

=head2 format_datetime

 print 'Time now: ', $ft->format_datetime( '%H:%M:%S', time, 0 ), "\n";

This attribute uses the format passed in the first argument to format
the Perl time passed in the second argument. The third argument, if
defined, overrides the L<gmt|/gmt> attribute, forcing the time to be GMT
if true, or local if false.

The string representing the formatted time is returned.

This method C<must> be overridden by the subclass. The override C<may>
use the value of the L<tz|/tz> attribute to format the local time in the
given zone, provided the value of L<tz|/tz> is defined and not C<''>.
The override C<may> accept times in formats other than Perl epoch, but
it need not document or support these.

=head2 format_datetime_width

 my $wid = $ft->format_datetime_width( '%H:%M:%S' );

This method computes the maximum width required to display a time in the
given format. This is done by assuming only the month, day, and meridian
might affect the width, and then trying each and returning the width of
the widest.

=head2 __format_datetime_width_adjust_object

 my $ref = $self->__format_datetime_width_adjust_object( undef, year => 2100 );

This method B<must> be overridden by the subclass.  It exists to support
L<format_datetime_width()|/format_datetime_width>, and should not be
called directly.  It is not itself supported, in the sense that the
author reserves the right to change or revoke it without notice. Though
since this whole mess is unsupported in that sense, this statement is
redundant.

This method takes as its arguments a time in any format supported by the
L<format_datetime()|/format_datetime> method, the name of a component
(C<year>, C<month>, C<day>, C<hour>, C<minute>, or C<second>), and a
value for that component. The time is returned with the given component
set to the given value. If the time is C<undef>, a new time representing
C<01-Jan-2100 00:00:00> is constructed, adjusted, and returned.

=head2 round_time

 $ft->round_time( 60 );
 print 'Time rounded to ', $ft->round_time(), ' seconds';

This method is both accessor and mutator for the time rounding
specification maintained on behalf of the subclass. If the subclass
overrides this, it B<must> call SUPER::round_time with the same
arguments.

If called with an argument, the argument becomes the new rounding
specification, in seconds. The argument must be an integer number of
seconds, the special-cased strings C<'second'>, C<'minute'> or C<'hour'>
(which specify C<1>, C<60> and C<3600> respectively), or C<undef> to
turn off rounding. Be aware that if rounding is turned off the time
formatter may truncate the time.

If called without an argument, the current value of the C<round_time>
attribute is returned. This will always be an integer.

The default value is C<1>.

=head2 __round_time_value

 $time = $ft->__round_time_value( $time );

This method exists to support the rounding of time values by subclasses,
and should not be called directly. It is not itself supported, in the
sense that the author reserves the right to change or revoke it without
notice.

This method takes as its argument an epoch time, and returns it rounded
to the precision specified by C<< $ft->round_time() >>.

=head2 tz

 $ft->tz( 'mst7mdt' );
 print 'Current zone: ', $ft->tz(), "\n";

This method is both accessor and mutator for the time zone, maintained
on behalf of the subclass. If the subclass overrides this, it B<must>
call SUPER::tz with the same arguments.

If called with an argument, the argument becomes the new zone, with
either C<''> or C<undef> representing the default zone. The object is
returned to allow call chaining.

If called without an argument, the current value of the C<tz> attribute
is returned.

=head1 SUPPORT

Support is by the author. Please file bug reports at
L<http://rt.cpan.org>, or in electronic mail to the author.

=head1 AUTHOR

Thomas R. Wyant, III F<wyant at cpan dot org>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010-2014 by Thomas R. Wyant, III

This program is free software; you can redistribute it and/or modify it
under the same terms as Perl 5.10.0. For more details, see the full text
of the licenses in the directory LICENSES.

This program is distributed in the hope that it will be useful, but
without any warranty; without even the implied warranty of
merchantability or fitness for a particular purpose.

=cut

# ex: set textwidth=72 :