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