git.maemo.org Git - dh-make-perl/blob - dev/arm/libemail-date-format-perl/libemail-date-format-perl-1.002/lib/Email/Date/Format.pm

   1 use 5.006;
   2 use strict;
   3 use warnings;
   4
   5 package Email::Date::Format;
   6
   7 our $VERSION = '1.002';
   8 our @EXPORT_OK = qw[email_date email_gmdate];
   9
  10 use Exporter;
  11 BEGIN { our @ISA = 'Exporter' }
  12 use Time::Local ();
  13
  14 =head1 NAME
  15
  16 Email::Date::Format - produce RFC 2822 date strings
  17
  18 =head1 SYNOPSIS
  19
  20   use Email::Date::Format qw(email_date);
  21
  22   my $header = email_date($date->epoch);
  23
  24   Email::Simple->create(
  25     header => [
  26       Date => $header,
  27     ],
  28     body => '...',
  29   );
  30
  31 =head1 DESCRIPTION
  32
  33 This module provides a simple means for generating an RFC 2822 compliant
  34 datetime string.  (In case you care, they're not RFC 822 dates, because they
  35 use a four digit year, which is not allowed in RFC 822.)
  36
  37 =head2 FUNCTIONS
  38
  39 =over 4
  40
  41 =item email_date
  42
  43   my $date = email_date; # now
  44   my $date = email_date( time - 60*60 ); # one hour ago
  45
  46 C<email_date> accepts an epoch value, such as the one returned by C<time>.
  47 It returns a string representing the date and time of the input, as
  48 specified in RFC 2822. If no input value is provided, the current value
  49 of C<time> is used.
  50
  51 C<format_date> is exported only if requested.
  52
  53 =item email_gmdate
  54
  55   my $date = email_gmdate;
  56
  57 C<email_gmdate> is identical to C<email_date>, but it will return a string
  58 indicating the time in Greenwich Mean Time, rather than local time.
  59
  60 C<format_gmdate> is exported only if requested.
  61
  62 =cut
  63
  64 sub _tz_diff {
  65   my ($time) = @_;
  66
  67   my $diff  =   Time::Local::timegm(localtime $time)
  68               - Time::Local::timegm(gmtime    $time);
  69
  70   my $direc = $diff < 0 ? '-' : '+';
  71   $diff  = abs $diff;
  72   my $tz_hr = int( $diff / 3600 );
  73   my $tz_mi = int( $diff / 60 - $tz_hr * 60 );
  74
  75   return ($direc, $tz_hr, $tz_mi);
  76 }
  77
  78 sub _format_date {
  79   my ($local) = @_;
  80
  81   sub {
  82     my ($time) = @_;
  83     $time = time unless defined $time;
  84
  85     my ($sec, $min, $hour, $mday, $mon, $year, $wday)
  86       = $local ? (localtime $time) : (gmtime $time);
  87
  88     my $day   = (qw[Sun Mon Tue Wed Thu Fri Sat])[$wday];
  89     my $month = (qw[Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec])[$mon];
  90     $year += 1900;
  91
  92     my ($direc, $tz_hr, $tz_mi) = $local ? _tz_diff($time)
  93       : ('+', 0, 0);
  94
  95     sprintf "%s, %d %s %d %02d:%02d:%02d %s%02d%02d",
  96             $day, $mday, $month, $year, $hour, $min, $sec, $direc, $tz_hr, $tz_mi;
  97   }
  98 }
  99
 100 BEGIN {
 101   *email_date   = _format_date(1);
 102   *email_gmdate = _format_date(0);
 103 };
 104
 105 1;
 106
 107 __END__
 108
 109 =back
 110
 111 =head1 PERL EMAIL PROJECT
 112
 113 This module is maintained by the Perl Email Project
 114
 115 L<http://emailproject.perl.org/wiki/Email::Date::Format>
 116
 117 =head1 AUTHOR
 118
 119 Ricardo SIGNES, <F<rjbs@cpan.org>>.
 120
 121 Adapted from Email::Date, by Casey West.
 122
 123 =head1 COPYRIGHT
 124
 125 Copyright (c) 2007, Ricarod SIGNES.  This module is free software; you can
 126 redistribute it and/or modify it under the same terms as Perl itself.
 127
 128 =cut