lib/PublicInbox/MsgTime.pm

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