# Please note this script requires a patched Irssi. (Hopefully the patch will
# be included with future versions.)
# A copy can be found at http://dgl.cx/irssi/irssi-paste-signal.patch against Irssi
# 0.8.12 svn. Also see http://bugs.irssi.org/?do=details&task_id=531
use Irssi 20070826.0000 qw<settings_get_str settings_get_bool signal_add active_win>;
use vars qw<$VERSION %IRSSI>;

$VERSION = "1.0";
%IRSSI = (
  authors     => "David Leadbeater",
  contact     => "dgl\@dgl.cx",
  name        => "pastie",
  description => "Offer to automatically send pastes to a web based paste site",
  url         => "http://dgl.cx/irssi/",
);

use strict;
use LWP::UserAgent();
use HTTP::Request::Common();
use POSIX();

# The site to use (name from the sites hash)
Irssi::settings_add_str($IRSSI{name}, "pastie_site", "pastie");
# How the URL should be inserted
# say: Say in the channel using the defined format
# insert: Insert into the prompt
# print: Just print
Irssi::settings_add_str($IRSSI{name}, "pastie_method", "say");
# Format for the line (%s is replaced by the URL, % should be double escaped).
Irssi::settings_add_str($IRSSI{name}, "pastie_format", "Pasted at %s");

my $in_progress = 0;

# Add paste sites here, please email me with additions.
my %sites = (
  pastie => {
    # The URL where the paste should be POSTed.
    submit => "http://pastie.caboo.se/pastes/create",
    # Code reference that should return a hash ref with the parameters to pass
    # to the page.
    format => sub {
      my($item, $text) = @_;

      return {
        "paste[body]" => $text,
        "paste[parser]" => "plaintext",
      };
    },
    # Code reference that is passed the resulting HTTP::Response object, should
    # return the URL the paste is located at.
    get_paste_url => sub {
      my($res) = @_;
      return $res->header("Location");
    },
    # Run before the paste request in a subprocess, is passed the constructed
    # paste object.  Useful to defeat validation where another page needs to be
    # requested first.. ;)
    pre_paste => sub {
      my($req) = @_;

      my $res = LWP::UserAgent->new->get("http://pastie.caboo.se/pastes/create");
      my $auth =
        ($res->content =~ /\Q$('paste_authorization').value='\E([^']+)'/m)[0];

      $req->add_content("&paste%5Bauthorization%5D=$auth");
      $req->header("Content-Length" => length $req->content);
    },
  },
  rafb => { #XXX: this doesn't work, I think rafb is blocking bots somehow
    submit => "http://rafb.net/paste/paste.php",
    format => sub {
      my($item, $text) = @_;
      return {
        lang => "plaintext",
        nick => $item->{server}->{nick},
        text => $text
      };
    },
    get_paste_url => sub {
      my($res) = @_;
      return $res->header("Location");
    }
  }
);

signal_add "gui paste detected" => sub {
  my $site = settings_get_str("pastie_site");
  active_win->print("To paste to \2$site\2 press Ctrl-P.");
};

signal_add "gui paste flush" => sub {
  my($key, $text) = @_;

  # Store the active window, in case it changes
  my $win = active_win;

  if($in_progress) {
    $win->print("Paste already in progress, aborted");
    return;
  }

  my $site = settings_get_str("pastie_site");
  $site = $sites{$site};

  if(!$site) {
    $win->print("Site not found, please /set pastie_site to a valid name (one of: " .
      join(", ", keys %sites) . ")");
    return;
  }

  my $format = $site->{format}->($win->{active}, $text);

  my $req = HTTP::Request::Common::POST($site->{submit}, $format);

  fork_wrapper(
    sub { # Child
      my($fh) = @_;

      $site->{pre_paste}->($req) if defined $site->{pre_paste};

      my $res = LWP::UserAgent->new->request($req);
      my $url = ($res->code == 200 || $res->code == 302)
        ? $site->{get_paste_url}->($res) : "";

      syswrite $fh, $res->code . " " . $url;
    },
    sub { # Parent
      my($line) = @_;
      my($code, $url) = split / /, $line;

      if($code == 200 || $code == 302) {
        my $text = sprintf(settings_get_str("pastie_format"), $url);

        my $method = settings_get_str("pastie_method");

        if($method eq 'say') {
          $win->{active}->command("say $text");
        } elsif($method eq 'insert') {
          Irssi::gui_input_set($text);
        } else {
          active_win->print("Pasted at $url");
        }
      } else {
        active_win->print("Paste error: $line");
      }
    }
  );
};

# Based on scriptassist.
sub fork_wrapper {
  my($child, $parent) = @_;

  pipe(my $rfh, my $wfh);

  my $pid = fork;
  $in_progress = 1;

  return unless defined $pid;

  if($pid) {
    close $wfh;
    Irssi::pidwait_add($pid);
    my $pipetag;
    my @args = ($rfh, \$pipetag, $parent);
    $pipetag = Irssi::input_add(fileno($rfh), INPUT_READ, \&pipe_input, \@args);
  } else {
    eval {
      $child->($wfh);
    };
    syswrite $wfh, "0 $@" if $@;
    POSIX::_exit(1);
  }
}

sub pipe_input {
  my ($rfh, $pipetag, $parent) = @{$_[0]};
  my $line = <$rfh>;
  close($rfh);
  Irssi::input_remove($$pipetag);
  $in_progress = 0;
  $parent->($line);
}

1;