lib/PublicInbox/MsgTime.pm

   1 # Copyright (C) 2018 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 package PublicInbox::MsgTime;
   4 use strict;
   5 use warnings;
   6 use base qw(Exporter);
   7 our @EXPORT_OK = qw(msg_timestamp msg_datestamp);
   8 use Date::Parse qw(str2time strptime);
   9
  10 sub str2date_zone ($) {
  11         my ($date) = @_;
  12
  13         my $ts = str2time($date);
  14         return undef unless(defined $ts);
  15
  16         # off is the time zone offset in seconds from GMT
  17         my ($ss,$mm,$hh,$day,$month,$year,$off) = strptime($date);
  18         return undef unless(defined $off);
  19
  20         # Compute the time zone from offset
  21         my $sign = ($off < 0) ? '-' : '+';
  22         my $hour = abs(int($off / 3600));
  23         my $min  = ($off / 60) % 60;
  24         my $zone = sprintf('%s%02d%02d', $sign, $hour, $min);
  25
  26         # "-1200" is the furthest westermost zone offset,
  27         # but git fast-import is liberal so we use "-1400"
  28         if ($zone >= 1400 || $zone <= -1400) {
  29                 warn "bogus TZ offset: $zone, ignoring and assuming +0000\n";
  30                 $zone = '+0000';
  31         }
  32         [$ts, $zone];
  33 }
  34
  35 sub time_response ($) {
  36         my ($ret) = @_;
  37         wantarray ? @$ret : $ret->[0];
  38 }
  39
  40 sub msg_received_at ($) {
  41         my ($hdr) = @_; # Email::MIME::Header
  42         my @recvd = $hdr->header_raw('Received');
  43         my ($ts);
  44         foreach my $r (@recvd) {
  45                 $r =~ /\s*(\d+\s+[[:alpha:]]+\s+\d{2,4}\s+
  46                         \d+\D\d+(?:\D\d+)\s+([\+\-]\d+))/sx or next;
  47                 $ts = eval { str2date_zone($1) } and return $ts;
  48                 my $mid = $hdr->header_raw('Message-ID');
  49                 warn "no date in $mid Received: $r\n";
  50         }
  51         undef;
  52 }
  53
  54 sub msg_date_only ($) {
  55         my ($hdr) = @_; # Email::MIME::Header
  56         my @date = $hdr->header_raw('Date');
  57         my ($ts);
  58         foreach my $d (@date) {
  59                 # Y2K problems: 3-digit years
  60                 $d =~ s!([A-Za-z]{3}) (\d{3}) (\d\d:\d\d:\d\d)!
  61                         my $yyyy = $2 + 1900; "$1 $yyyy $3"!e;
  62                 $ts = eval { str2date_zone($d) } and return $ts;
  63                 if ($@) {
  64                         my $mid = $hdr->header_raw('Message-ID');
  65                         warn "bad Date: $d in $mid: $@\n";
  66                 }
  67         }
  68         undef;
  69 }
  70
  71 # Favors Received header for sorting globally
  72 sub msg_timestamp ($) {
  73         my ($hdr) = @_; # Email::MIME::Header
  74         my $ret;
  75         $ret = msg_received_at($hdr) and return time_response($ret);
  76         $ret = msg_date_only($hdr) and return time_response($ret);
  77         wantarray ? (time, '+0000') : time;
  78 }
  79
  80 # Favors the Date: header for display and sorting within a thread
  81 sub msg_datestamp ($) {
  82         my ($hdr) = @_; # Email::MIME::Header
  83         my $ret;
  84         $ret = msg_date_only($hdr) and return time_response($ret);
  85         $ret = msg_received_at($hdr) and return time_response($ret);
  86         wantarray ? (time, '+0000') : time;
  87 }
  88
  89 1;