From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

SCHUBIGER / DateTime-Format-Natural-1.20 / lib / DateTime / Format / Natural / Utils.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
—
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

              
package DateTime::Format::Natural::Utils;
use strict;
use warnings;
use base qw(Exporter);
use boolean qw(true false);
our ($VERSION, @EXPORT_OK);
$VERSION = '0.08';
@EXPORT_OK = qw(trim);
sub _valid_date
{
    my $self = shift;
    return $self->_valid(@_,
        { units => [ qw(year month day) ],
          error => '(date is not valid)',
          type  => 'date',
        },
    );
}
sub _valid_time
{
    my $self = shift;
    return $self->_valid(@_,
        { units => [ qw(hour minute second) ],
          error => '(time is not valid)',
          type  => 'time',
        },
    );
}
sub _valid
{
    my $self = shift;
    my $opts = pop;
    my %values = @_;
    delete $values{nanosecond}; # always valid
    my %set = map { $_ => $self->{datetime}->$_ } @{$opts->{units}};
    while (my ($unit, $value) = each %values) {
        $set{$unit} = $value;
    }
    my $checker = '_check' . "_$opts->{type}";
    if ($self->$checker(map $set{$_}, @{$opts->{units}})) {
        return true;
    }
    else {
        $self->_set_failure;
        $self->_set_error($opts->{error});
        return false;
    }
}
sub _trace_string
{
    my $self = shift;
    my ($trace, $modified, $keyword) = map $self->{$_}, qw(trace modified keyword);
    $trace    ||= [];
    $modified ||= {};
    $keyword  ||= '';
    return undef unless (@$trace || %$modified || length $keyword);
    my $i;
    my %order = map { $_ => $i++ } @{$self->{data}->__units('ordered')};
    return join "\n", grep length, $keyword, @$trace,
      map { my $unit = $_; "$unit: $modified->{$unit}" }
      sort { $order{$a} <=> $order{$b} }
      keys %$modified;
}
sub trim
{
    local $_ = ref $_[0] eq 'SCALAR' ? ${$_[0]} : $_[0];
    s/^\s+//;
    s/\s+$//;
    return ref $_[0] eq 'SCALAR' ? do { ${$_[0]} = $_; '' } : $_;
}
1;
__END__
=head1 NAME
DateTime::Format::Natural::Utils - Handy utility functions/methods
=head1 SYNOPSIS
 Please see the DateTime::Format::Natural documentation.
=head1 DESCRIPTION
The C<DateTime::Format::Natural::Utils> class consists of utility functions/methods.
=head1 SEE ALSO
L<DateTime::Format::Natural>
=head1 AUTHOR
Steven Schubiger <schubiger@cpan.org>
=head1 LICENSE
This program is free software; you may redistribute it and/or
modify it under the same terms as Perl itself.
See L<http://dev.perl.org/licenses/>
=cut