View | Details | Raw Unified | Return to bug 6679
Collapse All | Expand All

(-)a/C4/Dates.pm (-12 / +13 lines)
Lines 79-85 our @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); Link Here
79
79
80
our @days = qw(Sun Mon Tue Wed Thu Fri Sat);
80
our @days = qw(Sun Mon Tue Wed Thu Fri Sat);
81
81
82
sub regexp ($;$) {
82
sub regexp {
83
    my $self   = shift;
83
    my $self   = shift;
84
    my $delim  = qr/:?\:|\/|-/;                                                                  # "non memory" cluster: no backreference
84
    my $delim  = qr/:?\:|\/|-/;                                                                  # "non memory" cluster: no backreference
85
    my $format = (@_) ? _recognize_format(shift) : ( $self->{'dateformat'} || _prefformat() );
85
    my $format = (@_) ? _recognize_format(shift) : ( $self->{'dateformat'} || _prefformat() );
Lines 97-111 sub regexp ($;$) { Link Here
97
    return qr/^(\d{1,2})$delim(\d{1,2})$delim(\d{4})(?:\s{1}(\d{1,2})\:?(\d{1,2})\:?(\d{1,2}))?/;    # everything else
97
    return qr/^(\d{1,2})$delim(\d{1,2})$delim(\d{4})(?:\s{1}(\d{1,2})\:?(\d{1,2})\:?(\d{1,2}))?/;    # everything else
98
}
98
}
99
99
100
sub dmy_map ($$) {
100
sub dmy_map {
101
    my $self    = shift;
101
    my $self    = shift;
102
    my $val     = shift or return undef;
102
    my $val     = shift or return;
103
    my $dformat = $self->{'dateformat'} or return undef;
103
    my $dformat = $self->{'dateformat'} or return;
104
    my $re      = $self->regexp();
104
    my $re      = $self->regexp();
105
    my $xsub    = $dmy_subs{$dformat};
105
    my $xsub    = $dmy_subs{$dformat};
106
    $debug and print STDERR "xsub: $xsub \n";
106
    $debug and print STDERR "xsub: $xsub \n";
107
    if ( $val =~ /$re/ ) {
107
    if ( $val =~ /$re/ ) {
108
        my $aref = eval $xsub;
108
        my $aref = eval {$xsub};
109
        if ($dformat eq 'rfc822') {
109
        if ($dformat eq 'rfc822') {
110
            $aref = _abbr_to_numeric($aref, $dformat);
110
            $aref = _abbr_to_numeric($aref, $dformat);
111
            pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet
111
            pop(@{$aref}); #pop off tz offset because we are not setup to handle tz conversions just yet
Lines 123-129 sub dmy_map ($$) { Link Here
123
sub _abbr_to_numeric {
123
sub _abbr_to_numeric {
124
    my $aref    = shift;
124
    my $aref    = shift;
125
    my $dformat = shift;
125
    my $dformat = shift;
126
    my ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
126
127
    my ($month_abbr, $day_abbr); # keep perlcritic happy ;)
128
    ($month_abbr, $day_abbr) = ($aref->[4], $aref->[3]) if $dformat eq 'rfc822';
127
129
128
    for( my $i = 0; $i < scalar(@months); $i++ ) {
130
    for( my $i = 0; $i < scalar(@months); $i++ ) {
129
        if ( $months[$i] =~ /$month_abbr/ ) {
131
        if ( $months[$i] =~ /$month_abbr/ ) {
Lines 171-177 sub new { Link Here
171
    return $self->init(@_);
173
    return $self->init(@_);
172
}
174
}
173
175
174
sub init ($;$$) {
176
sub init {
175
    my $self = shift;
177
    my $self = shift;
176
    my $dformat;
178
    my $dformat;
177
    $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat();
179
    $self->{'dateformat'} = $dformat = ( scalar(@_) >= 2 ) ? $_[1] : _prefformat();
Lines 181-207 sub init ($;$$) { Link Here
181
    return $self;
183
    return $self;
182
}
184
}
183
185
184
sub output ($;$) {
186
sub output {
185
    my $self = shift;
187
    my $self = shift;
186
    my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
188
    my $newformat = (@_) ? _recognize_format(shift) : _prefformat();
187
    return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
189
    return ( eval { POSIX::strftime( $posix_map{$newformat}, @{ $self->{'dmy_arrayref'} } ) } || undef );
188
}
190
}
189
191
190
sub today ($;$) {    # NOTE: sets date value to today (and returns it in the requested or current format)
192
sub today {    # NOTE: sets date value to today (and returns it in the requested or current format)
191
    my $class = shift;
193
    my $class = shift;
192
    $class = ref($class) || $class;
194
    $class = ref($class) || $class;
193
    my $format = (@_) ? _recognize_format(shift) : _prefformat();
195
    my $format = (@_) ? _recognize_format(shift) : _prefformat();
194
    return $class->new()->output($format);
196
    return $class->new()->output($format);
195
}
197
}
196
198
197
sub _recognize_format($) {
199
sub _recognize_format {
198
    my $incoming = shift;
200
    my $incoming = shift;
199
    ( $incoming eq 'syspref' ) and return _prefformat();
201
    ( $incoming eq 'syspref' ) and return _prefformat();
200
    ( scalar grep ( /^$incoming$/, keys %format_map ) == 1 ) or croak "The format you asked for ('$incoming') is unrecognized.";
202
    ( scalar grep ( /^$incoming$/, keys %format_map ) == 1 ) or croak "The format you asked for ('$incoming') is unrecognized.";
201
    return $incoming;
203
    return $incoming;
202
}
204
}
203
205
204
sub DHTMLcalendar ($;$) {    # interface to posix_map
206
sub DHTMLcalendar {    # interface to posix_map
205
    my $class = shift;
207
    my $class = shift;
206
    my $format = (@_) ? shift : _prefformat();
208
    my $format = (@_) ? shift : _prefformat();
207
    return $posix_map{$format};
209
    return $posix_map{$format};
208
- 

Return to bug 6679