view release on metacpan or  search on metacpan

lib/IDS/DataSource/HTTP/Date.pm  view on Meta::CPAN

	$OK = $self->validate_date($type, $weekday, $day, $month,
	                           $year, $hour, $minute, $second, $TZ);
    } elsif (($weekday, $day, $month, $x, $year, $hour, $minute, $second, $TZ) = ($date =~ m/$invalid1/)) {
	$type = "Invalid1";
#	print STDERR "$invalid1\n";
#	print STDERR "$weekday, $day, $month, $year, $hour, $minute, $second, $TZ\n";
	$OK = $self->validate_date($type, $weekday, $day, $month,
	                           $year, $hour, $minute, $second, $TZ);
    } else {
	my $pmsg = *parse{PACKAGE} .  "::parse: In " .
		 ${$self->{"params"}}{"source"} .
		 " date '$date' does not match date patterns\n";
	$self->warn($pmsg, \@tokens, "!Nomatch date");
	$OK = 0; # not OK
    }

### need to switch to the same scheme used elsewhere for syntax checks
### only
    if ($OK) {
        if (${$self->{"params"}}{"recognize_dates"}) {
	    push @tokens, "Valid $type date";
	} else {
	    # This always puts things in the same order, even though the
	    # original date format may have a different order.  Valid?
# commented out to find out which is sometimes undefined
#	    push @tokens, "Weekday: $weekday", "Day: $day",
#	                  "Month: $month", "Year: $year",
#			  "Hour: $hour", "Minute: $minute",
#			  "Second: $second", "Date type: $type";
	    push @tokens, "Weekday: $weekday";
	    push @tokens, "Day: $day";
	    push @tokens, "Month: $month";
	    push @tokens, "Year: $year";
	    push @tokens, "Hour: $hour";
	    push @tokens, "Minute: $minute";
	    push @tokens, "Second: $second";
	    push @tokens, "Date type: $type";
	}
    } else {
	my $pmsg = *parse{PACKAGE} .  "::parse: In " .
                 ${$self->{"params"}}{"source"} .
                 " invalid value in '$date'\n";
        $self->warn($pmsg, \@tokens, "!Invalid date value");
    }

    $self->mesg(2, *parse{PACKAGE} .  "::parse: tokens\n    ",
                "\n    ", \@tokens);
    $self->{"tokens"} = \@tokens;
}

# Check basic assumptions about the date.  This function could be made
# more accurate by checking the days actually in the month as the max
sub validate_date {
    my $self  = shift;
    my ($type, $weekday, $day, $month,
	$year, $hour, $minute, $second, $TZ) = @_;
    my $level = 0;
    my $name = *parse{PACKAGE} . "::validate_date";
    # Timezones from http://www.timeanddate.com/library/abbreviations/timezones/
    my @timezones = qw(ACDT ACST ADT AEDT AEST AKDT AKST AST AWST BST
                       CDT CDT CEST CET CST CST CXT EDT EDT EEST EET EST
                       EST GMT HAA HAC HADT HAE HAP HAR HAST HAT HAY HNA
                       HNC HNE HNP HNR HNT HNY IST MDT MESZ MEZ MST NDT
                       NFT NST PDT PST UTC WEST WET WST
    );

    my $OK = 1; # assume valid

    map {$OK &= defined($_)} ($type, $weekday, $day, $month, $year, $hour, $minute, $second);
    # verify still OK
    unless ($OK) {
	$self->mesg($level, "$name: undefined value received");
	return 0; # nothing further needed
    }

# This check is covered by the pattern match now
#    if ($type eq "RFC850") { # RFC 850 uses full day names
#        $OK &= $weekday =~ /^(Monday|Tuesday|Wednesday|Thursday|Friday|Saturday|Sunday)$/;
#    } else { # other formats use 3-char day names
#        $OK &= $weekday =~ /^(Mon|Tue|Wed|Thu|Fri|Sat|Sun)$/;
#    }
#    $OK or $self->mesg($level, "$name: bad weekday '$weekday'");

    $OK &= $day =~ /^\d+$/;
    $OK &= $day >= 1 && $day <= 31;
    $self->mesg($level, "$name: bad day '$day'") unless $OK;

    # This check is covered by thte pattern match now
    #$OK &= $month =~ /^(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)$/;
    #$self->mesg($level, "$name: bad month '$month'") unless $OK;

    # year sanity checks?

    $OK &= $hour =~ /^\d+$/ && $hour >= 0 && $hour <= 23;
    $self->mesg($level, "$name: bad hour '$hour'") unless $OK;
    $OK &= $minute =~ /^\d+$/ && $minute >= 0 && $minute <= 59;
    $self->mesg($level, "$name: bad minute '$minute'") unless $OK;
    $OK &= $second =~ /^\d+$/ && $second >= 0 && $second <= 59;
    $self->mesg($level, "$name: bad second '$second'") unless $OK;

    # This check is replaced by the one below
#    if ($type eq "ASCTIME") { # the only one not to use a TZ
#        $OK &= !defined($TZ) || $TZ eq "";
#    } else {
#        $OK &= $TZ eq "GMT";
#    }
    # Be generous in what we accept; if the TZ is defined and non-null
    # (and not "No TZ"), see if it is any of the known world timezones
    if (defined($TZ) && $TZ && $TZ ne "No TZ") {
        my $tzok = 0;
	map { $TZ eq $_ and $tzok = 1 } @timezones;
	$OK &= $tzok
    }
    $self->mesg($level, "$name: bad timezone '$TZ'") unless $OK;

    return $OK;
}

# accessor functions not provided by the superclass

=head1 AUTHOR INFORMATION