File Coverage

blib/lib/Convert/NLS_DATE_FORMAT.pm

Criterion	Covered	Total	%
statement	39	39	100.0
branch	12	14	85.7
condition			n/a
subroutine	7	7	100.0
pod	2	3	66.6
total	60	63	95.2

package Convert::NLS_DATE_FORMAT;

use 5.006;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(oracle2posix posix2oracle) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

our $VERSION = '0.05';

our @formats = (
    [ Q     => '%{quarter}' ], # quarter number
    [ WW    => '%U' ], # week number
    [ IW    => '%V' ], # ISO week number
    [ W     => '' ], # week in month
    [ J     => '' ], # Julian days since 31 Dec 4713BC
    [ YEAR  => '' ], # year spelled out
    [ SYYYY => '%Y' ], # signed year (BC is negative)
    [ YYYY  => '%Y' ], # four digit year
    [ IYYY  => '%G' ], # ISO four digit year
    [ YYY   => '' ], # last three digits of year
    [ IYY   => '' ], # ISO last three digits of year
    [ YY    => '%y' ], # last two digits of year
    [ IY    => '%g' ], # ISO last two digits of year
    [ RR    => '%y' ], # last two digits of year relative to current date
    [ Month => '%B' ], # month spelled out
    [ Mon   => '%b' ], # three-letter abbreviation month
    [ MM    => '%m' ], # month number
    [ RM    => '' ], # roman numeral month XXII
    [ DDD   => '%j' ], # day of year
    [ DD    => '%d' ], # day of month
    [ Day   => '%A' ], # day of week spelled out
    [ Dy    => '%a' ], # three-letter abbreviation day of week
    [ D     => '%u' ], # day of week
    [ HH24  => '%H' ], # hours (24)
    [ HH12  => '%I' ], # hours (12)
    [ HH    => '%I' ], # hours (12)
    [ MI    => '%M' ], # minutes
    [ SSSSS => '' ], # seconds since midnight
    [ SS    => '%S' ], # seconds
    [ AM    => '%p' ], # displays AM or PM
    [ PM    => '%p' ],
    [ 'A.M.'=> '' ], # displays A.M. or P.M.
    [ 'P.M.'=> '' ],
    [ am    => '%P' ], # displays am or pm
    [ pm    => '%P' ],
    [ 'a.m.'=> '' ], # displays a.m. or p.m.
    [ 'p.m.'=> '' ],
    [ BC    => '' ], # displays BC or AD
    [ AD    => '' ],
    [ 'B.C.'=> '' ], # displays B.C. or A.D.
    [ 'A.D.'=> '' ],
    [ XFF9  => '.%9N' ], # special case until X can translate to %{decimal}
    [ XFF6  => '.%6N' ], # special case until X can translate to %{decimal}
    [ XFF3  => '.%3N' ], # special case until X can translate to %{decimal}
    [ XFF   => '.%6N' ], # special case until X can translate to %{decimal}
    [ FF    => '%6N' ],
    [ TZHTZM=> '%z' ], # time zone hour offset from UTC
    [ TZH   => '%z' ],
    [ TZR   => '%Z' ], # time zone name
    [ TH    => '' ], # appends 'st', 'nd', 'rd', 'th'
    [ Y     => '' ], # last digit of year
    [ I     => '' ], # ISO last digit of year
);

my %formats = generate_formats();

sub oracle2posix {
    my ($oracle_format) = @_;
    # quoted strings require separate processing
    return join(
        '',
        map { _convert_oracle2posix($_) }
        split(/(".*?")/, $oracle_format)
    );
}

sub _convert_oracle2posix {
    my ($oracle_format) = @_;

    # return quoted strings as-is, with the quotes removed
    return $1 if $oracle_format =~ m/^"(.*?)"$/;

    my $string = $oracle_format;
    foreach my $pair (@formats) {
        my ($key, $value) = @$pair;

        # all are case insensitive except am/pm
        $key = qr/$key/i unless $key =~ m/^[ap]m$/i;

        # translate formats found in $oracle_format
        if ($string =~ /(?
            if ($value) {
                $string =~ s/(?
            } else {
                my ($format) = $string =~ /(?
                warn "Oracle format '$format' has no POSIX equivalent.\n";
            }
        }
    }
    return $string;
}

sub posix2oracle {
    my ($format) = @_;
    # regex from DateTime
    $format =~ s/
                    (%{\w+})
                /
                    $formats{$1} ? $formats{$1} : "\%$1"
                /sgex;
    # special case for XFF until X can translate to %{decimal}
    $format =~ s/
                    (\.%\d?N)
                /
                    "XFF"
                /sgex;
    # regex from Date::Format
    $format =~ s/
                    (%[%a-zA-Z])
                /
                    $formats{$1} ? $formats{$1} : "\%$1"
                /sgex;
    return $format;
}

sub generate_formats {
    my %f = ();
    foreach my $pair (@formats) {
        my ($nls, $posix_format) = @$pair;
        if ($posix_format) {
            $f{$posix_format} = $nls;
        }
    }
    $f{'%z'} = 'TZHTZM'; # special case
    return %f;
}

1;
__END__