File Coverage

blib/lib/DateTime/Format/LDAP.pm

Criterion	Covered	Total	%
statement	64	65	98.4
branch	38	44	86.3
condition	4	6	66.6
subroutine	8	8	100.0
pod	3	3	100.0
total	117	126	92.8

package DateTime::Format::LDAP;
$DateTime::Format::LDAP::VERSION = '0.002';
use 5.8.0;
use strict;
use warnings;

use DateTime;

use Params::Validate qw( validate_with SCALAR );

sub new
{
    my $class = shift;
    my $self;
    %$self = @_;

    return bless $self, $class;
}

# key is string length
my %valid_formats =
    ( 14 =>
      { params => [ qw( year month day hour minute second ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/,
      },
      12 =>
      { params => [ qw( year month day hour minute ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/,
      },
      10 =>
      { params => [ qw( year month day hour ) ],
        regex  => qr/^(\d\d\d\d)(\d\d)(\d\d)(\d\d)$/,
      },
    );

sub parse_datetime
{
    my ( $self, $date ) = @_;

    $self = {} unless ref $self;
    my $asn1 = defined $self->{asn1} ? $self->{asn1} : 0;

    # save for error messages
    my $original = $date;

    my %p;
    if ( $date =~ s/Z$// )
    {
        $p{time_zone} = 'UTC';
    }
    elsif ( $date =~ s/([+-]([01]\d|2[0-3])[0-5]\d)$// )
    {
        $p{time_zone} = $1;
    }
    elsif ( $asn1 )
    {
        $p{time_zone} = 'floating';
    }
    else
    {
        die "Invalid LDAP datetime string ($original)\n";
    }

    my $fraction;
    if ( $date =~ s/[.,](\d+)// ) {
        $fraction = "0.$1";
    }

    my $format = $valid_formats{ length $date }
        or die "Invalid LDAP datetime string ($original)\n";

    @p{ @{ $format->{params} } } = $date =~ /$format->{regex}/;

    # If  is omitted, then  represents a fraction of an
    # hour; otherwise, if  and  are omitted, then
    #  represents a fraction of a minute; otherwise,
    # represents a fraction of a second.
    if (defined $fraction )
    {
        if ( exists $p{second} )
        {
            $p{nanosecond} = int($fraction * 1000**3 + 0.5);
        }
        elsif ( exists $p{minute} )
        {
            $p{second} = int($fraction * 60);
            $fraction = $fraction * 60 - $p{second};
            if ( $fraction )
            {
                $p{nanosecond} = int($fraction * 1000**3 + 0.5);
            }
        }
        else
        {
            $p{minute} = int($fraction * 60);
            $fraction = $fraction * 60 - $p{minute};
            if ( $fraction )
            {
                $p{second} = int($fraction * 60);
                $fraction = $fraction * 60 - $p{second};
                if ( $fraction )
                {
                    $p{nanosecond} = int($fraction * 1000**3 + 0.5);
                }
            }
        }
    }
    return DateTime->new(%p);
}

sub format_datetime
{
    my ( $self, $dt ) = @_;

    $self = {} unless ref $self;
    my $asn1 = defined $self->{asn1} ? $self->{asn1} : 0;
    my $offset = defined $self->{offset} ? $self->{offset} : 0;

    my $tz = $dt->time_zone;

    die 'LDAP datetime cannot be floating' if $tz->is_floating and !$asn1;

    unless ( $offset )
    {
        unless ( $tz->is_utc || $tz->is_floating )
        {
            $dt = $dt->clone->set_time_zone('UTC');
            $tz = $dt->time_zone;
        }
    }

    my $base =
        sprintf( '%04d%02d%02d%02d%02d%02d',
                 $dt->year, $dt->month, $dt->day,
                 $dt->hour, $dt->minute, $dt->second );

    $base .= substr sprintf( '%.9g', $dt->nanosecond / 1000**3 ), 1 if $dt->nanosecond;

    return $base if $tz->is_floating;

    return $base . 'Z' if $tz->is_utc;

    return $base . $tz->offset_as_string($dt->offset);
}

1;

__END__