The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Games::Lacuna::Task::Utils;

use strict;
use warnings;

our $VERSION = $Games::Lacuna::Task::VERSION;

use Unicode::Normalize qw(decompose);
use Scalar::Util qw(blessed);
use Time::Local qw(timegm);

use base qw(Exporter);
our @EXPORT_OK = qw(
    class_to_name
    name_to_class
    normalize_name
    clean_name
    distance 
    pretty_dump
    parse_ship_type
    parse_date
    format_date
); 

sub class_to_name {
    my ($class) = @_;
    
    $class = ref($class)
        if ref($class);
    $class =~ s/^.+::([^:]+)$/$1/;
    $class =~ s/(\p{Lower})(\p{Upper}\p{Lower})/$1_$2/g;
    $class = lc($class);
    return $class;
}

sub name_to_class {
    my ($name) = @_;
    
    return 
        unless defined $name;
    
    my @parts = map { ucfirst(lc($_)) } 
        split (/[_ ]/,$name);
    
    my $class = 'Games::Lacuna::Task::Action::'.join ('',@parts);
    
    return $class;
}

sub normalize_name {
    my ($name) = @_;
    
    return
        unless defined $name;
    
    return uc(clean_name($name));
}

sub clean_name {
    my ($name) = @_;
    
    return
        unless defined $name;
    
    my $name_simple = decompose($name); 
    $name_simple =~ s/\p{NonSpacingMark}//g;
    
    $name_simple =~ s/^\s+//g;
    $name_simple =~ s/\s+$//g;
    
    return $name_simple;
}

sub distance {
    my ($x1,$y1,$x2,$y2) = @_;
    
    return int(sqrt( ($x1 - $x2)**2 + ($y1 - $y2)**2 ));
}

sub pretty_dump {
    my ($value) = @_;
    
    return $value
        unless ref $value;
    return $value->stringify
        if blessed($value) && $value->can('stringify');
    return $value->message
        if blessed($value) && $value->can('message');
    my $dump = Data::Dumper::Dumper($value);
    chomp($dump);
    $dump =~ s/^\$VAR1\s=\s(.+);$/$1/s;
    return $dump;
}

sub parse_ship_type {
    my ($name) = @_;
    
    return
        unless defined $name;
    
    $name = lc($name);
    $name =~ s/\s+/_/g;
    $name =~ s/(vi)$/6/i;
    $name =~ s/(iv)$/4/i;
    $name =~ s/(v)$/5/i;
    $name =~ s/(i{1,3})$/length($1)/ei;
    $name =~ s/_([1-6])$/$1/;
    
    return $name;
}

sub parse_date {
    my ($date) = @_;
    
    return
        unless defined $date;
    
    if ($date =~ m/^
        (?<day>\d{2}) \s
        (?<month>\d{2}) \s
        (?<year>20\d{2}) \s
        (?<hour>\d{2}) :
        (?<minute>\d{2}) :
        (?<second>\d{2}) \s
        \+(?<timezoneoffset>\d{4})
        $/x) {
        
        warn('Unexpected timezone offset '.$+{timezoneoffset})
            if $+{timezoneoffset} != 0;
            
        my @params = map { $+{$_} } qw(second minute hour day month year);
        $params[4]--; #month index
        
        return timegm(@params);
    }
    
    return;
}

sub format_date {
    my ($date) = @_;
    
    return
        unless defined $date && $date =~ m/^\d+$/;
    
    my ($sec,$min,$hour,$mday,$mon,$year) = gmtime($date);
    $year += 1900;
    $mon++;
    
    return sprintf('%04i.%02i.%02i %02i:%02i',$year,$mon,$mday,$hour,$min);
}

1;

=encoding utf8

=head1 NAME

Games::Lacuna::Task::Utils - Helper functions for Games::Lacuna::Task

=head1 SYNOPSIS

    use Games::Lacuna::Task::Utils qw(class_to_name);

=head1 FUNCTIONS

No functions are exported by default.

=head3 class_to_name

Class name to moniker (lowercase, uderscore separated)

=head3 name_to_class

Moniker to class name (camel case, prefixed with Games::Lacuna::Task::Action::)

=head3 distance

 my $dist = distance($x1,$y1,$x2,$y2);

Calculates map distance

=head3 pretty_dump

 say pretty_dump($value);

Stringifies any value

=head3 normalize_name

Removes diacritic marks and uppercases a string for better compareability

=head3 parse_ship_type

 my $ship_type = parse_ship_type($human_type);

Converts a human ship name into the ship type

=head2 parse_date

Returns a epoch timestamp for the given timestamp from the api response

=head2 format_date

Formats an epoch timestamp

=cut