#!/usr/bin/perl
#
# NOTE This script uses parts of the following 3 scripts, with modifications,
# and all their relevant licenses apply:
#
# name        => 'urlgrab',
# authors     => 'David Leadbeater',
# contact     => 'dgl@dgl.cx',
# license     => 'GNU GPLv2 or later',
#
# name        => "HiliteUrl",
# authors     => "Stefan Heinemann",
# contact     => "stefan.heinemann\@codedump.ch",
# license     => "GPL",
#
# name        => "OpenURL",
# authors     => "Stefan 'tommie' Tomanek",
# contact     => "stefan\@pico.ruhr.de",
# license     => "GPLv2",
#
# Settings:
#
#  url_cmd
#    Irssi command to execute to process URLs. %s is replaced by URL.
#    Default: ^exec xdg-open '%s'
#
#  colour_urls
#    whether to colour URLs or not.
#    Default: 1
#
#  url_colour
#
#   mirc colour, from:
#
#    0 white
#    1 black
#    2 blue
#    3 green
#    4 light red
#    5 red
#    6 magenta
#    7 orange
#    8 yellow orange
#    9 light green
#    10 cyan
#    11 light cyan
#    12 light blue
#    13 light magenta
#    14 gray
#    15 light gray
#
#    Default: 3
#
#  url_number_colour
#    URL number colour as above.
#    Default: 12
#
#  max_urls
#    Number at which URLs cycle back to 1.
#    Default: 50
#
# Commands:
#
#   /url <N> <#channel|refnum>       Open a URL N using url_cmd.  N<1: count
#                                    back from end of log.  Without N, opens
#                                    last in current buffer or <#channel>.
#
#   /list_urls <N> <#channel|refnum> Print last N URLs in log.
#
#   /clear_urls                      Reset URL list in mem, but not log.
#
# refnum is the window number.

use strict;
use warnings;
use Irssi;
use vars qw($VERSION %IRSSI);

$VERSION = "1.0.0";
%IRSSI   = (
    authors     => "dive",
    contact     => "dave\@tty1.uk",
    name        => "urlmachine2",
    changed     => "$VERSION",
    commands    => "url, list_urls, clear_urls",
    description => "Logs and hilights URLs.  Adds /url command to open them.",
    license     => "GPL, GNU GPLv2 or later, and BSD. See comments.",
    url         => "http://tty1.uk",
);

sub init {
    Irssi::settings_add_str( "urlmachine", "url_cmd", "/^exec xdg-open '%s'" );
    Irssi::settings_add_int( "urlmachine", "url_colour",        "12" );
    Irssi::settings_add_int( "urlmachine", "url_number_colour", "9" );
    Irssi::settings_add_int( "urlmachine", "max_urls", 50 );
    Irssi::settings_add_bool( "urlmachine", "colour_urls", 1 );
    Irssi::settings_add_bool( "urlmachine", "debug_urls",  0 );

    Irssi::command_bind( "url",        "url_command" );
    Irssi::command_bind( "list_urls",  "list_urls" );
    Irssi::command_bind( "clear_urls", "clear_urls" );

    Irssi::signal_add_first( "message irc action",     "url_public" );
    Irssi::signal_add_first( "message irc own_action", 'hilite_urls' );
    Irssi::signal_add_first( "message irc notice",     "url_public" );
    Irssi::signal_add_first( "message irc own_notice", 'hilite_urls' );
    Irssi::signal_add_first( "message private",        "url_private" );
    Irssi::signal_add_first( "message own_private",    'hilite_urls' );
    Irssi::signal_add_first( "message public",         "url_public" );
    Irssi::signal_add_first( "message own_public",     'hilite_urls' );
    Irssi::signal_add_first( "channel topic changed",  "hilite_topic" );
    # Irssi::signal_add( "message topic",          "hilite_topic" );
}

init();
my @urls;
my $lasturl = "";

# All protocols listed in https://www.ietf.org/rfc/rfc1738.txt + https
# It's far simpler to disallow unsafe characters than look for legitimate ones
# TODO Add support for www. etc.
# TODO protocol-specific commands with url_cmd as a default.
my $protocols = 'ftp|https?|git|gopher|mailto|news|nntp|rsync';
$protocols .= '|telnet|wais|file|prospero';
my $urlstr    = '(' . $protocols . ')://[^\s<>"\'\017\003]+';
my $urlreg    = qr{$urlstr}i;

sub hilite_topic {
    my ($data)   = @_;
    my $server   = $data->{server};
    my $text     = $data->{topic};
    my $channel  = $data->{name};
    my $nick     = $channel;
    my $hostmask = "";
    my $witem;

    if ($text && $data->{topic_time} > 0) {
        my @links = grep { /$urlreg/ } ( split /($urlreg)/i, $text );
        if (@links) {
            $text = parse_urls( $server, join ("\n", @links) , $nick, $hostmask, $channel );
            
            if ($server) {
                $witem = $server->window_item_find($channel);
            }
            else {
                $witem = Irssi::window_item_find($channel);
            }

            if ($witem) {
                $witem->print( $text, MSGLEVEL_CLIENTCRAP );
            }
        }
    }
    Irssi::signal_continue($data);
}

sub hilite_urls {
    my ( $server, $text, $hostmask ) = @_;
    if ( $text =~ /$urlreg/ && Irssi::settings_get_bool('colour_urls') ) {
        my $ucolour =
          sprintf( "\003%02d", Irssi::settings_get_int('url_colour') );
        my $endcolour =  sprintf( "%s", "\017" );

        # Add Colours
        $text =~ s`($urlreg)`$ucolour$1$endcolour`ig;
    }

    ## Let it flow
    Irssi::signal_continue( $server, $text, $hostmask );
}

sub find_urls {
    my $text = shift;
    my @links = grep { /$urlreg/ } ( split /($urlreg)/i, $text );
    return @links if @links;
    return ();
}

sub parse_urls {
    my ( $server, $text, $nick, $hostmask, $channel ) = @_;
    $server = $server->{tag};
    my @links = find_urls($text);
    return $text unless @links;
    my $index;
    my $ucolour =
          sprintf( "\003%02d", Irssi::settings_get_int('url_colour') );
    my $ncolour =
      sprintf( "\003%02d", Irssi::settings_get_int('url_number_colour') );
    my $endcolour =  sprintf( "%s", "\017" );

    if ( Irssi::settings_get_bool('colour_urls') ) {
        $text =~ s`($urlreg)`$ucolour$1`ig;
     }

    foreach (@links) {

        #debug_log("\$_: $_");
        $index = url_log( $server, $channel, $nick, $_ );
        return $text if $index == 0;

        $text =~ s`\Q$_\E`$_ $ncolour\[$index\]$endcolour`;
    }
    return "$text";
}

sub url_public {
    my ( $server, $text, $nick, $hostmask, $channel ) = @_;
    if ($text) {
        $text = parse_urls( $server, $text, $nick, $hostmask, $channel );
    }
    Irssi::signal_continue( $server, $text, $nick, $hostmask, $channel );
}

sub url_private {
    my ( $server, $text, $nick, $hostmask ) = @_;
    if ($text) {
        $text = parse_urls( $server, $text, $nick, $hostmask, $nick );
    }
    Irssi::signal_continue( $server, $text, $nick, $hostmask );
}

sub url_command {
    my ( $arg, $server, $channel ) = find_server_channel(@_);
    return unless @urls;
    return unless $channel and $server;
    my $url;

    my @url_list;
    @url_list =
      grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;

    return unless @url_list;
    return if abs($arg) > scalar @url_list;

    if ( $arg > 0 ) {
        my @twat = grep { $_->{index} == $arg } @url_list;
        $url = $twat[0]->{url} if $twat[0];
    }
    else {
        $url = $url_list[$arg]->{url};
    }

    return unless $url;

    print CLIENTCRAP "" if Irssi::settings_get_bool('debug_urls');
    debug_log( "\$arg: " . $arg ) if $arg;
    debug_log( "\$server: " . $server )   if $server;
    debug_log( "\$channel: " . $channel ) if $channel;
    Irssi::command( sprintf( Irssi::settings_get_str("url_cmd"), $url ) );
}

sub url_log {
    my ( $server, $channel, $nick, $url ) = @_;

    # get rid of any colour codes and unprintables
    $url =~ s`\e\[[[:digit:]]+m}``g;
    $url =~ s`(\x03[0-9,]+|\x02)?(\Q$_\E)`$2`g;
    $url =~ s`[^[:print:]]+}``g;
    chomp($url);
    return 0 unless $url;

    my @url_list;
    my $max = Irssi::settings_get_int('max_urls');

    @url_list =
      grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;
    @urls =
      grep { $_->{server} ne $server || $_->{channel} ne $channel } @urls;

    my $index = scalar @url_list + 1;

    if ( $index > $max ) {
        $index = $url_list[0]->{index};
        shift @url_list;
    }

    push @urls, @url_list;
    push @urls,
      {
        index   => $index,
        server  => $server,
        channel => $channel,
        nick    => $nick,
        url     => $url,
      };

    debug_log(
            scalar @urls . ' '
          . $urls[-1]->{index} . ' '
          . $urls[-1]->{server} . ' '
          . $urls[-1]->{channel} . ' '
          . $urls[-1]->{nick} . ' '
          . $urls[-1]->{url} );
    return $index;
}

sub clear_urls {
    return unless @urls;
    @urls = ();
    Irssi::command("/echo URL list cleared\n");
}

sub find_server_channel {
    my ( $mitem, $server, $channel ) = @_;
    my $arg = 0;
    my $name;
    my ( $refnum, $buffer );
    ( $arg, $name ) = split ' ', $mitem;

    if ($server) {
        $server = $server->{tag};
    }
    else {
        $server = Irssi::active_win->{'active'}->{'server'}->{'tag'};
    }
    if ($channel) {
        $channel = $channel->{name};
    }
    else {
        $channel = Irssi::active_win->{'active'}->{'name'};
    }

    $channel = Irssi::active_win->{name} unless $channel;
    $refnum = do { no warnings "numeric"; int($name) } if $name;
    $arg = -1 unless $arg;

    if ( not $name and abs($arg) =~ /\D+/ ) {
        $name = $arg;
        $arg  = -1;
    }

    if ($name) {
        if ($refnum) {
            $buffer = Irssi::window_find_refnum($refnum);
        }
        else {
            $buffer = Irssi::window_find_closest( $name, 0 );
        }
    }
    if ($buffer) {
        $channel = $buffer->get_active_name;
        $server  = $buffer->{active_server}->{'tag'};
    }

    $arg = int($arg);
    return ( $arg, $server, $channel );
}

# Below here mostly useful for debugging
sub list_urls {
    my ( $arg, $server, $channel ) = find_server_channel(@_);
    return unless @urls;
    return unless $channel and $server;

    my @url_list;
    @url_list =
      grep { $_->{server} eq $server && $_->{channel} eq $channel } @urls;

    my $nurls = @url_list;
    return unless $nurls;

    if ( int($arg) < 0 ) {
        for ( my $cnt = -1 ; $cnt >= $arg && $nurls + $cnt >= 0 ; $cnt-- ) {
            print_log_entry( \@url_list, $cnt, $nurls + $cnt );
        }
    }
    elsif ( int($arg) > 0 ) {
        for ( my $cnt = 1 ; $cnt <= $arg && $cnt <= $nurls ; $cnt++ ) {
            print_log_entry( \@url_list, $cnt, $cnt - 1 );
        }
    }
}

sub whoami  { ( caller(1) )[3] }
sub whowasi { ( caller(2) )[3] }

sub debug_log {
    return if Irssi::settings_get_bool('debug_urls') == 0;
    my $data = ( join ' ', @_ ) =~ s{%}{%%}gr;
    my @sub = split '::', whowasi();
    print CLIENTCRAP "$sub[2]::$sub[3]: $data";
}

sub print_log_entry {
    my ( $list, $cnt, $idx ) = @_;
    my @url_list = @{$list};
    my $string =
        "$cnt" . ' '
      . $url_list[$idx]->{server} . ' '
      . $url_list[$idx]->{channel} . ' '
      . $url_list[$idx]->{nick} . ' '
      . $url_list[$idx]->{url} . ' '
      . "[$url_list[$idx]->{index}]";

    Irssi::command("/echo -- $string\n");
}

# vim: expandtab tabstop=4 softtabstop=4 shiftwidth=4