#! /usr/local/bin/perl -w

use strict;
use warnings;

use Getopt::Std;

use Net::Twitter;
use DateTime::Format::Strptime;
use Data::Dumper;

binmode STDERR, ":utf8";
binmode STDOUT, ":utf8";

# Sanity check to avoid creating a mess
my $checkdirfile = ".twitposts";
stat($checkdirfile) or die "Please run this script from the directory containing $checkdirfile (or create it)";

# Get options
my %opts;
getopts("i:s:", \%opts);
# -i <ids>: retrieve specific tweets (comma separated list)
# -s <id>: retrieve tweets starting with specified ID (overriding .lastid file)

my $lookuplist;
if ( defined($opts{i}) ) {
    die "Badly formed argument to -s" unless $opts{i} =~ m/^[0-9]+(?:\,[0-9]+)*$/;
    $lookuplist = [ split(/,/, $opts{i}) ];
}

# Retrieve last id known to program (delete this file to start from scratch)
my $lastidfile = ".lastid";
my $lastid;
if ( defined($opts{s}) ) {
    die "Badly formed argument to -s" unless $opts{s} =~ m/^([0-9]+)$/;
    $lastid = $1;
} elsif ( open my $lastidf, "<", $lastidfile ) {
    $_ = <$lastidf>;
    chomp $_;
    die "Badly formed .lastid file" unless $_ =~ m/^([0-9]+)$/;
    $lastid = $1;
    printf STDERR "Last id before run is %s\n", $lastid;
    close $lastidf;
}

# Read authentication file
my $keyfname = $ENV{"HOME"}."/.twitterkeys";
my %keyfdata;
open my $keyf, "<", $keyfname or die "Can't open $keyfname: $!";
while (<$keyf>) {
    s/\#.*//;
    next if m/^\s+$/;
    die "Bad key file format: $_" unless m/^\s*([A-Za-z][A-Za-z0-9\-]*)\:\s+(\S+)\s*$/;
    print STDERR "Read auth data \[$1\]=$2\n";
    $keyfdata{$1} = $2;
}
close $keyf;
my $consumer_key = $keyfdata{"API-Key"} or die "Didn't find API-Key in key file";
my $consumer_secret = $keyfdata{"API-Key-Secret"} or die "Didn't find API-Key-Secret in key file";
my $access_token = $keyfdata{"Access-Token"} or die "Didn't find Access-Token in key file";
my $access_token_secret = $keyfdata{"Access-Token-Secret"} or die "Didn't find Access-Token-Secret in key file";
die "Badly formed Access-Token" unless $access_token =~ m/^([0-9]+)\-/;
my $self_id = $1;

# Open the Twitter connection.
my $nt = Net::Twitter->new(
    traits => [qw/API::RESTv1_1/],
    consumer_key => $consumer_key,
    consumer_secret => $consumer_secret,
    access_token => $access_token,
    access_token_secret => $access_token_secret,
);

die "Couldn't open Twitter connection" unless $nt;

my $datetime_parser = DateTime::Format::Strptime->new(
    pattern => "%a %b %d %T %z %Y", time_zone => "UTC", locale => "C",
    on_error => "croak");

# Get self screen name
print STDERR "Getting information on self...\n";
my $slf = $nt->lookup_users({user_id => $self_id});
die "lookup_user didn't return exactly one user" unless scalar(@{$slf})==1;
die "Missing screen name" unless defined($slf->[0]->{"screen_name"});
my $self_screen_name = $slf->[0]->{"screen_name"};
my $self_name = $slf->[0]->{"name"};

# Read existing HTML archive
print STDERR "Reading HTML dump...\n";
my $htmldumpfile = "tweets.daml";
my $html_preface = "";  my $html_postface = "";
my %html_dump;
if ( ! open my $htmldumpf, "<:utf8", $htmldumpfile ) {
    $html_preface = "\<\!-- \@\@BEGIN\@\@ --\>\n";
    $html_postface = "\<\!-- \@\@END\@\@ --\>\n";
} else {
    my $state = 0;
    while (<$htmldumpf>) {
	if ( $state == 0 ) {
	    $html_preface .= $_;
	    if ($_ =~ m/\<\!\-\- \@\@BEGIN\@\@ \-\-\>/) {
		$state = 1;
	    }
	} elsif ( $state == 1 ) {
	    if ($_ =~ m/\<\!\-\- \@\@END\@\@ \-\-\>/) {
		$state = 2;
		$html_postface .= $_;
	    } else {
		$html_dump{$1} = $_ if $_ =~ m/^\<dt id\=\"tweet-([0-9]+)\"/;
		# Simply ignore and delete any other line!
	    }
	} elsif ( $state == 2 ) {
	    $html_postface .= $_;
	}
    }
    close $htmldumpf;
}

# Retrieve timeline from Twitter
print STDERR "Getting timeline...\n";
my %paramdict;
my $timeline;
if ( defined($lookuplist) ) {
    %paramdict = (trim_user => 1, tweet_mode => "extended");
    $paramdict{id} = $lookuplist;
    $timeline = $nt->lookup_statuses(\%paramdict);
} else {
    %paramdict = (count => 100, include_rts => 1, trim_user => 1, tweet_mode => "extended");
    $paramdict{since_id} = $lastid if defined($lastid);
    $timeline = $nt->user_timeline(\%paramdict);
}
# print Dumper $timeline;

# The following function performs a set of substitutions on a string
# (correctly adjusting the position of each subsequent substitution to
# take into account earlier ones).
sub substitute_in_string {
    my $str = shift;
    my @subs = sort { $a->[0] <=> $b->[0] } @{ shift() };
    # Each entry of @subs is an array reference:
    # [0]: first character of substring to modify
    # [1]: length of substring to modify
    # [2]: undefined, or substring itself, to check for consistency
    # [3]: undefined, or substring to substitute
    # [4]: undefined, or substring to insert before
    # [5]: undefined, or substring to insert at end
    my $corr = 0;
    my $minbar = 0;
    for my $sb ( @subs ) {
	my $idx0 = $sb->[0] + $corr;
	die "Attempting to overlap substitutions" unless $idx0>=$minbar;
	my $len = $sb->[1];
	if ( defined($sb->[2]) ) {
	    die(sprintf("Bad calibration: expecting \"%s\", got \"%s\"\n", $sb->[2], substr($str, $idx0, $len))) unless substr($str, $idx0, $len) eq $sb->[2];
	}
	my $repl = ($sb->[4] // "") . ($sb->[3] // substr($str, $idx0, $len)) . ($sb->[5] // "");
	my $newlen = length($repl);
	# printf STDERR "str: %s\nsubstituting (%d,%d) \"%s\"->\"%s\"\n", $str, $idx0, $len, substr($str, $idx0, $len), $repl;
	substr($str, $idx0, $len) = $repl;
	# printf STDERR "str: %s\n", $str;
	$corr += ($newlen - $len);
	$minbar = $idx0 + $newlen;
    }
    return $str;
}

sub html_quote {
    my $str = shift;
    $str =~ s/\&/\&amp;/g;
    $str =~ s/\</\&lt;/g;
    $str =~ s/\>/\&gt;/g;
    $str =~ s/\"/\&quot;/g;
    return $str;
}

# Now scan through timeline
for my $st ( @{$timeline} ) {
    die "Missing id from timeline entry" unless defined($st->{"id"});
    die "Bad id from timeline entry" unless $st->{"id"} =~ /^[0-9]+$/;
    my $created_at = $datetime_parser->parse_datetime($st->{"created_at"});
    my $timestamp = $created_at->strftime("%Y%m%d%H%M%S");
    my $html_timestamp = $created_at->strftime("%Y-%m-%dT%H:%M:%S+00:00");
    my $id = $st->{"id"};
    if ( !defined($lastid) || $id ge $lastid ) {
	$lastid = $id;
    }
    printf STDERR "%s-%s\n", $timestamp, $id;
    my $fname = $timestamp . "-" . $id . ".txt";
    my $user_id = $st->{"user"}->{"id"};
    my $user_screen_name = $user_id eq $self_id ? $self_screen_name : $st->{"user"}->{"screen_name"};
    die "Didn't get user screen name" unless defined($user_screen_name);
    my $permalink = sprintf("https://twitter.com/%s/status/%s", $user_screen_name, $id);
    my $fulltext = $st->{"full_text"};
    my $fulltext_html = $fulltext;
    die "Text contains unescaped HTML" if $fulltext =~ m/[\<\>]|\&(?!(?:lt|gt|amp|apos|quot|\#(?:x[0-9A-Fa-f]+|[0-9]+))\;)/;
    my @substitutions = ();
    my @substitutions_html = ();
    if ( $fulltext =~ m/\ART/ && defined($st->{"retweeted_status"}) ) {
	push @substitutions_html, [0, 2, "RT", undef, sprintf("<a href=\"https://twitter.com/statuses/%s\">", $st->{"retweeted_status"}->{"id"}), "</a>"];
    }
    for my $ent ( @{$st->{"entities"}->{"hashtags"}} ) {
	my $idx0 = $ent->{"indices"}->[0];
	my $idx1 = $ent->{"indices"}->[1];
	push @substitutions_html, [$idx0, $idx1-$idx0, "\#".$ent->{"text"}, undef, "<a href=\"https://twitter.com/hashtag/".$ent->{"text"}."\">", "</a>"];
    }
    for my $ent ( @{$st->{"entities"}->{"user_mentions"}} ) {
	my $idx0 = $ent->{"indices"}->[0];
	my $idx1 = $ent->{"indices"}->[1];
	push @substitutions_html, [$idx0, $idx1-$idx0, undef, undef, "<a href=\"https://twitter.com/".$ent->{"screen_name"}."\">", "</a>"];
    }
    for my $ent ( @{$st->{"entities"}->{"urls"}} ) {
	my $idx0 = $ent->{"indices"}->[0];
	my $idx1 = $ent->{"indices"}->[1];
	push @substitutions, [$idx0, $idx1-$idx0, $ent->{"url"}, $ent->{"expanded_url"}];
	push @substitutions_html, [$idx0, $idx1-$idx0, $ent->{"url"}, html_quote($ent->{"display_url"}), "<a href=\"".html_quote($ent->{"expanded_url"})."\">", "</a>"];
    }
    for my $ent ( @{$st->{"entities"}->{"media"}} ) {
	my $idx0 = $ent->{"indices"}->[0];
	my $idx1 = $ent->{"indices"}->[1];
	push @substitutions, [$idx0, $idx1-$idx0, $ent->{"url"}, $ent->{"display_url"}];
	push @substitutions_html, [$idx0, $idx1-$idx0, $ent->{"url"}, html_quote($ent->{"display_url"}), "<a href=\"".html_quote($ent->{"expanded_url"})."\">", "</a>"];
    }
    $fulltext = substitute_in_string $fulltext, \@substitutions;
    $fulltext_html = substitute_in_string $fulltext_html, \@substitutions_html;
    die "HTML fulltext contains unescaped HTML: $fulltext_html" if $fulltext_html =~ m/\&(?!(?:lt|gt|amp|apos|quot|\#(?:x[0-9A-Fa-f]+|[0-9]+))\;)/;
    $fulltext_html =~ s/\n/\<span class=\"br\"\>\&#x2424;\<\/span\>/g;
    # HTML-escape astral characters
    $fulltext_html =~ s/([^\x{0020}-\x{ffff}])/sprintf("\&\#x%x\;",ord($1))/ge;
    # Save text archive in a file
    open my $f, ">:utf8", $fname or die "Cannot open $fname";
    print $f "$timestamp\n$id ($user_id)\n$permalink\n\n$fulltext\n";
    close $f;
    # Now save HTML archive in a hash
    my $userlink = $user_id == $self_id ? "" : sprintf(" <a href=\"%s\">\@%s</a>", "https://twitter.com/".$user_screen_name, $user_screen_name);
    # my $userlink = sprintf(" <a href=\"%s\">\@%s</a>", "https://twitter.com/".$user_screen_name, $user_screen_name);
    my $lang = $st->{"lang"};
    my $langattr = defined($lang) && $lang ne "und" ? " xml:lang=\"$lang\"" : "";
    # my $langattr = " xml:lang=\"$lang\"";
    my $replying = "";
    if ( defined($st->{"in_reply_to_status_id"}) ) {
	$replying = sprintf " <a href=\"https://twitter.com/%s/status/%s\">\x{2709}</a>", $st->{"in_reply_to_screen_name"}, $st->{"in_reply_to_status_id"};
    }
    $html_dump{$id} = sprintf "\<dt id=\"tweet-%s\"%s\><a href=\"%s\"><time>%s</time></a>%s%s</dt><dd>%s</dd>\n", $id, $langattr, $permalink, $html_timestamp, $userlink, $replying, $fulltext_html;
}

open my $htmldumpf, ">:utf8", $htmldumpfile or die "Failed to open $htmldumpfile: $!";
print $htmldumpf $html_preface;
print $htmldumpf "<dl>\n";
foreach my $id ( sort {$b cmp $a} keys(%html_dump) ) {
    print $htmldumpf $html_dump{$id};
}
print $htmldumpf "</dl>\n";
print $htmldumpf $html_postface;
close $htmldumpf;

if ( defined($lastid) && ! defined($lookuplist) ) {
    printf STDERR "Last id after run is %s\n", $lastid;
    open my $lastidf, ">", $lastidfile;
    print $lastidf "$lastid\n";
    close $lastidf;
}
