File Coverage

blib/lib/Astro/App/Satpass2/FormatTime.pm

Criterion	Covered	Total	%
statement	63	69	91.3
branch	15	22	68.1
condition	4	9	44.4
subroutine	14	16	87.5
pod	7	7	100.0
total	103	123	83.7

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

use 5.008;

use strict;
use warnings;

use POSIX ();

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

use Astro::App::Satpass2::Utils qw{ @CARP_NOT };

our $VERSION = '0.051_01';

use constant ROUND_TIME => 1;

my $delegate = eval {
    require Astro::App::Satpass2::FormatTime::DateTime::Strftime;
    require DateTime::TimeZone;
    DateTime::TimeZone->new( name => 'local' );
    '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;
    $self->init( %args );
    return $self;
}

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

{

    my %skip = map { $_ => 1 } qw{ back_end };

    sub copy {
	my ( $self, $copy ) = @_;
	return $self->SUPER::copy( $copy, %skip );
    }
}

{
    my $leader_re = qr{ @{[ __PACKAGE__ ]} :: }smxo;

    sub class_name_of_record {
	my ( $self ) = @_;
	( my $name = ref $self || $self ) =~ s/ \A $leader_re //smx;
	return $name;
    }
}

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

{

    my %cache;

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

	defined $gmt
	    or $gmt = $self->gmt();
	$gmt = $gmt ? 1 : 0;

	my $class = ref $self;

	exists $cache{$class}{$tplt}[$gmt]
	    and return $cache{$class}{$tplt}[$gmt];

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

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

}

sub _format_datetime_width_try {
    my ( $self, $tplt, $time, $gmt, $name, @try ) = @_;
    my $wid;
    my $max_trial;
    foreach my $trial ( @try ) {
	$time = $self->__format_datetime_width_adjust_object(
	    $time, $name, $trial, $gmt );
	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, $gmt );
    return ( $time, $wid );
}

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

    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->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 ( my $round = $self->round_time() ) {
	$time = POSIX::floor( ( $time + $round / 2 ) / $round ) * $round;
    }
    return $time;
}

__PACKAGE__->create_attribute_methods();

1;

__END__