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
   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*(\d+\s+[[:alpha:]]+\s+\d{2,4}\s+
  48                         \d+\D\d+(?:\D\d+)\s+([\+\-]\d+))/sx or next;
  49                 $ts = eval { str2date_zone($1) } and return $ts;
  50                 my $mid = $hdr->header_raw('Message-ID');
  51                 warn "no date in $mid Received: $r\n";
  52         }
  53         undef;
  54 }
  55
  56 sub msg_date_only ($) {
  57         my ($hdr) = @_; # Email::MIME::Header
  58         my @date = $hdr->header_raw('Date');
  59         my ($ts);
  60         foreach my $d (@date) {
  61                 # Y2K problems: 3-digit years
  62                 $d =~ s!([A-Za-z]{3}) (\d{3}) (\d\d:\d\d:\d\d)!
  63                         my $yyyy = $2 + 1900; "$1 $yyyy $3"!e;
  64                 $ts = eval { str2date_zone($d) } and return $ts;
  65                 if ($@) {
  66                         my $mid = $hdr->header_raw('Message-ID');
  67                         warn "bad Date: $d in $mid: $@\n";
  68                 }
  69         }
  70         undef;
  71 }
  72
  73 # Favors Received header for sorting globally
  74 sub msg_timestamp ($) {
  75         my ($hdr) = @_; # Email::MIME::Header
  76         my $ret;
  77         $ret = msg_received_at($hdr) and return time_response($ret);
  78         $ret = msg_date_only($hdr) and return time_response($ret);
  79         wantarray ? (time, '+0000') : time;
  80 }
  81
  82 # Favors the Date: header for display and sorting within a thread
  83 sub msg_datestamp ($) {
  84         my ($hdr) = @_; # Email::MIME::Header
  85         my $ret;
  86         $ret = msg_date_only($hdr) and return time_response($ret);
  87         $ret = msg_received_at($hdr) and return time_response($ret);
  88         wantarray ? (time, '+0000') : time;
  89 }
  90
  91 1;