File Coverage

blib/lib/XML/Loy/Date/RFC3339.pm

Criterion	Covered	Total	%
statement	65	70	92.8
branch	39	52	75.0
condition	17	32	53.1
subroutine	9	9	100.0
pod	5	5	100.0
total	135	168	80.3

package XML::Loy::Date::RFC3339;
use strict;
use warnings;

use overload '""' => sub { shift->to_string }, fallback => 1;

our $VERSION = '0.03';

require Time::Local;

# rfc3339 timestamp
my $RFC3339_RE = qr/^(\d{4})          # year
                     (?:-(\d?\d)      # year and month
                      (?:-(\d?\d)     # complete date
                       (?:[^\d](\d?\d) # + hour and minutes
                         :(\d?\d)
                        (?::(\d?\d)   # + hour, minutes and seconds
                         (?:\.\d*)?   # + hour, minutes, seconds and a
                        )?            #   decimal fraction of a second
                        ([zZ]|[\-\+]\d?\d(?::?\d?\d)?) # Offset
                       )?
                      )?
                     )?$/x;

# Timestamp offset
my $OFFSET_RE = qr/^([-\+])(\d?\d)(?::(\d?\d))?$/;

# Constructor
sub new {
  my $self = bless {}, (ref $_[0] ? ref shift : shift);

  # Set granularity
  $self->granularity(0);

  # Parse string
  $self->parse(@_);
  return $self;
};


# Parse date value
sub parse {
  my ($self, $date) = @_;

  # No date defined
  return $self unless defined $date;

  # Epoch date
  if ($date =~ /^[\d_]+$/ && $date > 5000) {
    $self->epoch($date);
    $self->granularity(0);
  }

  # String date
  elsif (my ($year, $month, $mday,
	     $hour, $min, $sec,
	     $offset) = ($date =~ $RFC3339_RE)) {
    my $epoch;

    # Check for granularity
    my $gran = 0;

    # No seconds defined
    unless (defined $sec) {
      $gran = 1, $sec = 0;

      # No hours defined
      unless (defined $hour) {
	$gran++, $hour = $min = 0;

	# No monthday defined
	unless (defined $mday) {
	  $gran++, $mday = 1;

	  # No month defined
	  unless (defined $month) {
	    $gran++, $month = 1;
	  };
	};
      };
      $offset ||= 'Z';
    };

    # Begin counting with 0
    $month--;

    # Set granularity
    $self->granularity($gran);

    eval {
      $epoch = Time::Local::timegm(
	$sec, $min, $hour, $mday, $month, $year
      );
    };

    return if $@;

    # Calculate offsets
    if (uc $offset ne 'Z' && (
      my ($os_dir, $os_hour, $os_min) = ($offset =~ $OFFSET_RE))
      ) {

      # Negative offset
      if ($os_dir eq '-') {
	$epoch += ($os_hour * 60 * 60) if $os_hour;
	$epoch += ($os_min * 60)       if $os_min;
      }

      # Positive offset
      else {
	$epoch -= ($os_hour * 60 * 60) if $os_hour;
	$epoch -= ($os_min * 60)       if $os_min;
      };
    };

    # Positive epoch
    if ($epoch > 0) {
      $self->epoch($epoch) and return $epoch;
    };
  }

  # No valid datetime
  else {
    return;
  };

  return $self;
};


# return string
sub to_string {
  my $self  = shift;
  my $level = $_[0] // $self->granularity;

  # Take the current time if no time given
  my $epoch = $self->epoch // time;

  # Get gmtime
  my ($sec, $min, $hour, $mday, $month, $year) = gmtime $epoch;

  # Format
  my $s = '%04d';
  my @a = ($year + 1900);
  $s .= '-%02d'      and push(@a, $month + 1)  if $level < 4;
  $s .= '-%02d'      and push(@a, $mday)       if $level < 3;
  $s .= 'T%02d:%02d' and push(@a, $hour, $min) if $level < 2;
  $s .= ':%02d'      and push(@a, $sec)        if $level < 1;
  $s .= 'Z' if $level < 2;

  return sprintf($s, @a);
};


# Epoch datetime
sub epoch {
  my $self = shift;

  # Get epoch
  return $self->{epoch} unless @_;

  # Set epoch if valid
  if ($_[0] && $_[0] =~ /^[_\d]+$/) {

    # Fine to set
    $self->{epoch} = shift;
    return 1;
  };

  # Fail to set
  return;
};


# Granularity
sub granularity {
  my $self = shift;

  # Get granularity
  return $self->{granularity} unless @_;

  # Set granularity if valid
  if (defined $_[0] && grep { $_[0] == $_ } 0 .. 4) {

    # Fine to set
    $self->{granularity} = shift;
    return 1;
  };

  # Fail to set
  return;
};


1;


__END__