r3456 - in /packages/libemail-date-perl/branches/upstream/current: Changes MANIFEST META.yml Makefile.PL lib/Email/Date.pm t/pod-coverage.t t/pod.t t/test.t

pabs-guest at users.alioth.debian.org pabs-guest at users.alioth.debian.org
Sat Aug 12 08:26:49 UTC 2006


Author: pabs-guest
Date: Sat Aug 12 08:26:48 2006
New Revision: 3456

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3456
Log:
Load /tmp/tmp.VOhqP11037/libemail-date-perl-1.101 into
packages/libemail-date-perl/branches/upstream/current.

Added:
    packages/libemail-date-perl/branches/upstream/current/t/pod-coverage.t
    packages/libemail-date-perl/branches/upstream/current/t/pod.t
Modified:
    packages/libemail-date-perl/branches/upstream/current/Changes
    packages/libemail-date-perl/branches/upstream/current/MANIFEST
    packages/libemail-date-perl/branches/upstream/current/META.yml
    packages/libemail-date-perl/branches/upstream/current/Makefile.PL
    packages/libemail-date-perl/branches/upstream/current/lib/Email/Date.pm
    packages/libemail-date-perl/branches/upstream/current/t/test.t

Modified: packages/libemail-date-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/Changes?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/Changes (original)
+++ packages/libemail-date-perl/branches/upstream/current/Changes Sat Aug 12 08:26:48 2006
@@ -1,3 +1,15 @@
+1.101   2006-08-01
+
+  - fix a bug in testing; tests would only pass in second 2/3 of month
+    (thanks Danial Pearce)
+
+1.10    2006-07-21
+
+  - add format_gmdate
+  - if no date was found, return undef, not the current time
+  - tests
+  - list Email::Abstract as a prereq
+
 1.03    2004-09-23
 
   - Email::Abstract is not required, and is only loaded when needed.

Modified: packages/libemail-date-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/MANIFEST?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/MANIFEST (original)
+++ packages/libemail-date-perl/branches/upstream/current/MANIFEST Sat Aug 12 08:26:48 2006
@@ -4,4 +4,6 @@
 MANIFEST			This list of files
 META.yml
 README
+t/pod-coverage.t
+t/pod.t
 t/test.t

Modified: packages/libemail-date-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/META.yml?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/META.yml (original)
+++ packages/libemail-date-perl/branches/upstream/current/META.yml Sat Aug 12 08:26:48 2006
@@ -1,15 +1,16 @@
 # http://module-build.sourceforge.net/META-spec.html
 #XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
 name:         Email-Date
-version:      1.03
+version:      1.101
 version_from: lib/Email/Date.pm
 installdirs:  site
 requires:
     Date::Parse:                   2.27
+    Email::Abstract:               2.10
     Email::Simple:                 1.9
     Test::More:                    0.47
     Time::Local:                   1.07
     Time::Piece:                   1.08
 
 distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.17
+generated_by: ExtUtils::MakeMaker version 6.30

Modified: packages/libemail-date-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/Makefile.PL?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/Makefile.PL (original)
+++ packages/libemail-date-perl/branches/upstream/current/Makefile.PL Sat Aug 12 08:26:48 2006
@@ -1,15 +1,16 @@
 use ExtUtils::MakeMaker;
 
 WriteMakefile (
-               AUTHOR        => 'Casey West <casey at geeknest.com>',
-               ABSTRACT      => "Find and Format Date Headers",
-               NAME          => 'Email::Date',
-               PREREQ_PM     => {
-                                 'Date::Parse' => '2.27',
-                                 'Email::Simple' => '1.9',
-                                 'Test::More' => '0.47',
-                                 'Time::Local' => '1.07',
-                                 'Time::Piece' => '1.08',
-                                },
-               VERSION_FROM  => 'lib/Email/Date.pm',
-              );
+  AUTHOR        => 'Casey West <casey at geeknest.com>',
+  ABSTRACT      => "Find and Format Date Headers",
+  NAME          => 'Email::Date',
+  PREREQ_PM     => {
+    'Date::Parse'     => '2.27',
+    'Email::Abstract' => '2.10', # ->new method
+    'Email::Simple'   => '1.9',
+    'Test::More'      => '0.47',
+    'Time::Local'     => '1.07',
+    'Time::Piece'     => '1.08',
+  },
+  VERSION_FROM  => 'lib/Email/Date.pm',
+);

Modified: packages/libemail-date-perl/branches/upstream/current/lib/Email/Date.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/lib/Email/Date.pm?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/lib/Email/Date.pm (original)
+++ packages/libemail-date-perl/branches/upstream/current/lib/Email/Date.pm Sat Aug 12 08:26:48 2006
@@ -1,16 +1,16 @@
 package Email::Date;
-# $Id: Date.pm,v 1.3 2004/09/24 00:00:48 cwest Exp $
 use strict;
 
-use vars qw[$VERSION @EXPORT];
-$VERSION = sprintf "%d.%02d", split m/\./, (qw$Revision: 1.3 $)[1];
- at EXPORT  = qw[find_date format_date];
+use vars qw[$VERSION @EXPORT @EXPORT_OK];
+$VERSION = '1.101';
+ at EXPORT    = qw[find_date format_date];
+ at EXPORT_OK = qw[format_gmdate];
 
 use base qw[Exporter];
-use Date::Parse;
+use Date::Parse ();
 use Email::Simple;
-use Time::Piece;
-use Time::Local;
+use Time::Piece ();
+use Time::Local ();
 
 =head1 NAME
 
@@ -46,7 +46,7 @@
 encapsulated in this software. Further, the process of creating RFC
 compliant date strings is also found in this software.
 
-=head2 Functions
+=head2 FUNCTIONS
 
 =over 4
 
@@ -55,30 +55,30 @@
   my $time_piece = find_date $email;
 
 C<find_date> accepts an email message in any format
-L<Email::Abstract|Email::Abstract> can understand. It looks through the
-email message and finds a date, converting it to a
-L<Time::Piece|Time::Piece> object.
+L<Email::Abstract|Email::Abstract> can understand. It looks through the email
+message and finds a date, converting it to a L<Time::Piece|Time::Piece> object.
+
+If it can't find a date, it returns false.
+
+C<find_date> is exported by default.
 
 =cut
 
 sub find_date {
-    my ($email) = _get_simple_object($_[0]);
-    my $date = $email->header('Date')
-                || _find_date_received($email->header('Recieved'))
-                  || $email->header('Resent-Date');
-    Time::Piece->new(str2time $date);
-}
+    require Email::Abstract;
+    my $email = Email::Abstract->new($_[0]);
 
-sub _get_simple_object {
-    my ($email) = @_;
-    return $email if UNIVERSAL::isa($email, 'Email::Simple');
-    return Email::Simple->new($email) if ! ref($email);
-    require Email::Abstract;
-    return Email::Abstract->cast($email, 'Email::Simple');
+    my $date = $email->get_header('Date')
+            || _find_date_received($email->get_header('Received'))
+            || $email->get_header('Resent-Date');
+
+    return unless length $date;
+
+    Time::Piece->new(Date::Parse::str2time $date);
 }
 
 sub _find_date_received {
-    return unless @_;
+    return unless length $_[0];
     my $date = pop;
     $date =~ s/.+;//;
     $date;
@@ -94,32 +94,70 @@
 specified in RFC 2822. If no input value is provided, the current value
 of C<time> is used.
 
+C<format_date> is exported by default.
+
+=item format_gmdate
+
+  my $date = format_gmdate;
+
+C<format_gmdate> is identical to C<format_date>, but it will return a string
+indicating the time in Greenwich Mean Time, rather than local time.
+
+C<format_gmdate> is exported on demand, but not by default.
+
 =cut
 
-sub format_date {
-    my $time = shift || time;
-    my ($sec, $min, $hour, $mday, $mon, $year, $wday) = (localtime $time)[0..6];
-    my $day   = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
-    my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
-    $year += 1900;
-    
+sub _tz_diff {
+    my ($time) = @_;
+
     my $diff  =   Time::Local::timegm(localtime $time)
                 - Time::Local::timegm(gmtime    $time);
+
     my $direc = $diff < 0 ? '-' : '+';
        $diff  = abs $diff;
     my $tz_hr = int( $diff / 3600 );
     my $tz_mi = int( $diff / 60 - $tz_hr * 60 );
-    
-    sprintf "%s, %d %s %d %02d:%02d:%02d %s%02d%02d",
-      $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
 
+    return ($direc, $tz_hr, $tz_mi);
 }
+
+sub _format_date {
+    my ($local) = @_;
+
+    sub {
+        my ($time) = @_;
+        $time = time unless defined $time;
+
+        my ($sec, $min, $hour, $mday, $mon, $year, $wday) =
+          $local ? (localtime $time) : (gmtime $time);
+        my $day   = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
+        my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
+        $year += 1900;
+        
+        my ($direc, $tz_hr, $tz_mi) = $local ? _tz_diff($time)
+                                             : ('+', 0, 0);
+        
+        sprintf "%s, %d %s %d %02d:%02d:%02d %s%02d%02d",
+          $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
+    }
+}
+
+BEGIN {
+  *format_date   = _format_date(1);
+  *format_gmdate = _format_date(0);
+};
 
 1;
 
 __END__
 
 =back
+
+=head1 PERL EMAIL PROJECT
+
+This module is maintained by the Perl Email Project
+
+  L<http://emailproject.perl.org/wiki/Email::Date>
 
 =head1 SEE ALSO
 
@@ -132,6 +170,8 @@
 
 Casey West, <F<casey at geeknest.com>>.
 
+Ricardo SIGNES, <F<rjbs at cpan.org>>.
+
 =head1 COPYRIGHT
 
   Copyright (c) 2004 Casey West.  All rights reserved.

Added: packages/libemail-date-perl/branches/upstream/current/t/pod-coverage.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/t/pod-coverage.t?rev=3456&op=file
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/t/pod-coverage.t (added)
+++ packages/libemail-date-perl/branches/upstream/current/t/pod-coverage.t Sat Aug 12 08:26:48 2006
@@ -1,0 +1,10 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.08";
+plan skip_all => "Test::Pod::Coverage 1.08 required for testing POD coverage"
+  if $@;
+
+all_pod_coverage_ok({
+  coverage_class => 'Pod::Coverage::CountParents'
+});

Added: packages/libemail-date-perl/branches/upstream/current/t/pod.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/t/pod.t?rev=3456&op=file
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/t/pod.t (added)
+++ packages/libemail-date-perl/branches/upstream/current/t/pod.t Sat Aug 12 08:26:48 2006
@@ -1,0 +1,6 @@
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();

Modified: packages/libemail-date-perl/branches/upstream/current/t/test.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libemail-date-perl/branches/upstream/current/t/test.t?rev=3456&op=diff
==============================================================================
--- packages/libemail-date-perl/branches/upstream/current/t/test.t (original)
+++ packages/libemail-date-perl/branches/upstream/current/t/test.t Sat Aug 12 08:26:48 2006
@@ -1,14 +1,101 @@
-use Test::More qw[no_plan];
+use Test::More tests => 14;
 use strict;
 $^W = 1;
 
-BEGIN { use_ok 'Email::Date' }
+BEGIN { use_ok 'Email::Date', qw(format_date format_gmdate find_date) }
 
-use Date::Parse;
-my @date = strptime(format_date);
-cmp_ok $date[-2], '>', 100, 'format_date returned something parsable';
-my $date = find_date(<<__MESSAGE__);
+{
+  my $time = time;
+  my $date = Time::Local::timelocal Date::Parse::strptime format_date($time);
+  cmp_ok($date, '==', $time, 'format_date output was parsed back into input');
+}
+
+
+{ # find in the Date header first:
+  my $date = find_date(<<'__MESSAGE__');
+Resent-Date: Tue, 6 Jul 2004 16:11:06 -0400
+Date: Tue, 6 Jul 2004 16:11:05 -0400
+__MESSAGE__
+
+  isa_ok($date, 'Time::Piece', 'found Date header');
+
+  is($date->epoch, 1089144665, "and it's the right time");
+}
+
+{ # find in the Resent-Date
+  my $date = find_date(<<'__MESSAGE__');
 Resent-Date: Tue, 6 Jul 2004 16:11:06 -0400
 __MESSAGE__
 
-isa_ok $date, 'Time::Piece';
+  isa_ok($date, 'Time::Piece', 'found Resent-Date header');
+
+  is($date->epoch, 1089144666, "and it's the right time");
+}
+
+{ # find in the Date header first:
+  my $date = find_date(<<'__MESSAGE__');
+Received: from cheshirecat.manxome.org (cheshirecat.manxome.org
+  [66.92.232.24]) by zodiac.codesimply.com (Postfix) with SMTP id 4BB082E6060
+  for <rjbs at codesimply.com>; Thu, 20 Jul 2006 18:43:26 +0000 (UTC)        
+Date: Tue, 6 Jul 2004 16:11:05 -0400
+__MESSAGE__
+
+  isa_ok($date, 'Time::Piece', 'found Date header');
+
+  is($date->epoch, 1089144665, "and it's the right time");
+}
+
+{ # find in the Received header:
+  my $date = find_date(<<'__MESSAGE__');
+Received: from cheshirecat.manxome.org (cheshirecat.manxome.org
+  [66.92.232.24]) by zodiac.codesimply.com (Postfix) with SMTP id 4BB082E6060
+  for <rjbs at codesimply.com>; Thu, 20 Jul 2006 18:43:26 +0000 (UTC)
+__MESSAGE__
+
+  isa_ok($date, 'Time::Piece', 'found Received header');
+
+  is($date->epoch, 1153421006, "and it's the right time");
+}
+
+{ # nothing to find!
+  my $date = find_date(<<'__MESSAGE__');
+X-Mail-Stupid: true
+X-Mailer: TheMarsupial!
+Subject: writing test mails can be boring
+
+Dear Mariah:
+
+I miss you.
+
+Love,
+Chuck
+__MESSAGE__
+
+  is($date, undef, "no date to find in this mail");
+}
+
+is(
+  length format_date, # no argument == now
+  (localtime)[3] > 9 ? 31 : 30, # Day > 9 means extra char in the string
+  "constant length",
+);
+
+my $birthday = 1153432704; # no, really!
+
+my $tz = sprintf "%s%02u%02u", Email::Date::_tz_diff(1153432704);
+
+SKIP: {
+    skip "test only useful in US/Eastern, -0400, not $tz", 1 if $tz ne '-0400';
+
+    is(
+        format_date(1153432704),
+        'Thu, 20 Jul 2006 17:58:24 -0400',
+        "rjbs's birthday date format properly",
+    );
+}
+
+is(
+  format_gmdate(1153432704),
+  'Thu, 20 Jul 2006 21:58:24 +0000',
+  "rjbs's birthday date format properly in GMT",
+);




More information about the Pkg-perl-cvs-commits mailing list