package DateTime::Format::Bork;
use strict;
use vars qw( $VERSION );
$VERSION = '0.02';
use DateTime::Format::Builder(
parsers => {
debork => [
{
regex => qr/^
( -? (?:Bork\s*){0,9} , (?:Bork\s*){0,9}
, (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
- ( (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
- ( (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
T ( (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
: ( (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
: ( (?:Bork\s*){0,9} , (?:Bork\s*){0,9} )
$/ix,
params => [ qw( year month day hour minute second ) ],
postprocess => \&_unbork,
extra => { time_zone => 'UTC' },
},
],
}
);
sub bork {
my( $self, $dt ) = @_;
$dt = $dt->clone->set_time_zone( 'UTC' );
my $borking;
$borking .= _bork( sprintf( "%04d", $dt->year ) ) . "-";
$borking .= _bork( sprintf( "%02d", $dt->month ) ) . "-";
$borking .= _bork( sprintf( "%02d", $dt->day ) ) . "T";
$borking .= _bork( sprintf( "%02d", $dt->hour ) ) . ":";
$borking .= _bork( sprintf( "%02d", $dt->minute ) ) . ":";
$borking .= _bork( sprintf( "%02d", $dt->second ) );
return $borking;
}
sub _unbork {
my %p = @_;
foreach my $key ( keys %{ $p{ parsed } } ) {
$p{ parsed }{ $key } = _count_bork( $p{ parsed }{ $key } );
}
return 1;
}
sub _count_bork {
my $borked = shift;
my $neg;
if ( $borked =~ s/-// ) {
$neg = 1;
}
my @digits = split( /,/, $borked );
my $n;
foreach ( @digits ) {
$n .= my @count = $_ =~ /(Bork)/ig;
}
if( $neg ) {
$n *= -1;
}
if ( defined $n ) {
return $n;
} else {
return 0;
}
}
sub _bork {
my $prebork = shift;
my $neg;
if ( $prebork =~ s/-// ) {
$neg = "-";
}
my @digits = split( //, $prebork );
my( $postbork, $i ) = $neg;
foreach ( @digits ) {
if ( $_ ) {
$postbork .= "Bork " x ( $_ - 1 ) . "Bork";
}
$i++;
} continue {
if ( $i < @digits ) {
$postbork .= ",";
}
}
return $postbork;
}
1;
__END__