HTTP::WebTest::Plugin::DateTest - Evaluate the "age" of embedded date strings in response body

 Version 1.01 - $Revision: 1.8 $

  s(econds) - default
  m(inutes)
  h(ours)
  d(ays)
  w(eeks)

 date_locale = 'French'

 "Mar 19 Mars 2002, 17:25"
   => "19 Mars 2002, 17:25"
   => "19 Mar 2002, 17:25"

 "Mar 19, 2002 17:25"
   => "19, 2002 17:25"
   => (not parsable)

# $Id: DateTest.pm,v 1.8 2003/05/16 08:11:47 joezespak Exp $
package HTTP::WebTest::Plugin::DateTest;
use strict;
use Date::Parse;
use Date::Language::English;
use base qw(HTTP::WebTest::Plugin);

use vars qw($VERSION);
$VERSION = '1.01';

sub param_types {
    return q(
                          date_start    list
                          date_end      list
                          date_maxage   list
                          date_locale   scalar
                          );
}

sub check_response {
    my $self = shift;

    # response content
    my $content = $self->webtest->current_response->content;

    $self->validate_params(qw(date_start date_end date_maxage date_locale));

    # test results
    my @results = ();
    my @ret = ();

    # store current time
    my $now = time();

    # check for date strings
    my @tests = @{$self->test_param('date_start', [])};
    my $locale = $self->test_param('date_locale', '');
    for (my $i=0; $i < @tests; $i++) {
        my $maxage = ${$self->test_param('date_maxage', [])}[$i];
        my $start = $tests[$i];
        my $end = ${$self->test_param('date_end', [])}[$i];
        my $pgdate;
        my $datestr = 'unknown';
	if ($content =~ /\Q$start\E\s*(.+?)\s*\Q$end\E/) {
            $datestr = $1;
            $pgdate = &_str2time_locale($datestr, $locale);
        }
        my $age = ($pgdate) ? $now - $pgdate : 'unknown';
        my ($maxsecs, $units) = &_str2seconds($maxage);
        my $ok = ($age ne 'unknown') && ($age < $maxsecs);

	push @results,
          $self->test_result($ok,
            sprintf("Wanted max %s and got %s (%s)",
                    $maxage, &_seconds2str($age, $units), $datestr)
          );
    }

    push @ret, ['Max. age of date string', @results] if @results;
    return @ret;
}

sub TIMETAB {
  my $units = shift || '';
  my $tt = {
      s => 1,
      m => 60,
      h => 3600,
      d => 86400,
      w => 604800,
  };
  return $tt->{$units};
}

# look for trailing characters and interprete them as time unit
sub _str2seconds {
    my $date = shift;
    my $units = '';
    if ($date =~ /^\s*([\-+0-9.]+)\s*([smhdwSMHDW]).*/) {
       $units = lc($2);
       $date = $1 * &TIMETAB($units);
    } else { 
      $date =~ s/^\s*([\-+0-9.]+)\s*.*$/$1/g;
    }
    $date = 0 unless ($date =~ /^[\-+0-9.]/);
    return wantarray ? ($date, $units) : $date;
}

# convert seconds into time string
sub _seconds2str {
    my ($date, $units) = @_;
    return 'unknown' unless ($date =~ /^[+-]?[\d\.]+$/);
    if (&TIMETAB($units)) {
      return ($units eq 's') ? "$date s"
                             : sprintf("%4.2f %s", $date/&TIMETAB($units), $units);
    }
    my $str = '';
    my $frag = 0;
    if ($frag = int($date / &TIMETAB('w'))) {
      $str .= "${frag}w ";
      $date -= $frag * &TIMETAB('w');
    }
    if ($frag = int($date / &TIMETAB('d'))) {
      $str .= "${frag}d ";
      $date -= $frag * &TIMETAB('d');
    }
    $frag = int($date / &TIMETAB('h'));
    $str .= sprintf "%02d:", $frag;
    $date -= $frag * &TIMETAB('h');
    $frag = int($date / &TIMETAB('m'));
    $str .= sprintf "%02d:", $frag;
    $date -= $frag * &TIMETAB('m');
    $str .= sprintf "%02d", $date;
    return $str;
}

sub _str2time_locale {
  my $date = shift;
  my $locale = ucfirst(lc(shift)) || 'English';
  # return if date is, well, empty...
  return if ($date =~ /^\s*$/sg);
  return str2time $date if ($locale eq 'English');

  # normalize spaces, incl. multiple lines
  $date =~ s/\s+/ /sg;

  # NOTE: "mar" (Mardi) and "mars" (French) would break.
  # Assume we have a weekday name prefix if
  # date string does not start with digits.
  # Strip up to 1st digit:
  $date =~ s/^[^0-9]+//g;

  # strip leading/trailing spaces
  $date =~ s/^\s*(.+)\s*$/$1/g;

  eval "require Date::Language::$locale";
  warn $@ if $@;
  my @MoY = eval "\@Date::Language::${locale}::MoY";
  my $MoY_EN = \@Date::Language::English::MoY;

  my $nwdate = '';
  foreach my $token (split(/(\s|-|:|\/)/, $date)) {
    if ($token =~ /^[0-9,-:\/\s]+$/) {
      $nwdate .= $token;
    } else {
      # match token with full month name.
      for (my $i = 0; $i < @MoY; $i++) {
        if ($MoY[$i] =~ /^\Q$token\E.*/i) {
          $nwdate .= $MoY_EN->[$i];
        }
      }
    }
  }
  # explicitly return for empty or '0' date string
  return unless $nwdate;
  return str2time $nwdate;
}

1;