implemented perl:selection:remote-pastebin, documentation still missing

diff --git a/Changes b/Changes
index 0920306..c7ed78c 100644 (file)
--- a/Changes
+++ b/Changes
@@ -13,6 +13,7 @@ WISH: just for fun, do shade and tint with XRender.
 WISH: support tex fonts
 
 9.0
+        - implemented perl:selection:remote-pastebin command in perl/selection
        - use the scrollback buffer even when the scroll region doesn't
           span the whole screen, as long as it starts at row 0.
         - swap the environment in some more cases. This hopefully fixes

diff --git a/src/perl/selection b/src/perl/selection
index ca71f9c..c090e7e 100644 (file)
--- a/src/perl/selection
+++ b/src/perl/selection
@@ -1,4 +1,57 @@
 #! perl
+use Digest::MD5 qw/md5_hex/;
+
+my $timers = {};
+my $pastebin_cmd;
+my $pastebin_url;
+
+sub on_start {
+   my ($self) = @_;
+   $pastebin_cmd =
+      (urxvt::untaint $self->x_resource ("selection-pastebin-cmd"))
+      or "scp -p % ruth:/var/www/www.ta-sa.org/files/txt/";
+
+   $pastebin_url = 
+      (urxvt::untaint $self->x_resource ("selection-pastebin-url"))
+      or "http://www.ta-sa.org/files/txt/";
+   ();
+}
+
+sub upload_paste {
+   my ($self) = @_;
+
+   my $txt = $self->selection;
+   my $h = md5_hex ($txt);
+
+   my $fn = "/tmp/$h.txt";
+
+   my $msg = "uploaded $h.txt";
+
+   if (open my $o, ">" . $fn) {
+      print $o $txt;
+      close $o;
+   } else {
+      $msg = "couldn't write $fn: $!";
+   }
+
+   my $cmd = $pastebin_cmd;
+   $cmd =~ s/%/$fn/;
+   unless (system ($cmd) == 0) {
+      $msg = "couldn't upload, '$cmd' failed";
+   }
+
+   $self->selection ($pastebin_url . "$h.txt");
+
+   my $ov = $timers->{ov} = $self->overlay (-1, 0, length ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
+   $ov->set (0, 0, $msg);
+
+   $timers->{t1} =
+      urxvt::timer
+              ->new
+              ->start ((int urxvt::NOW) + 5) # make sure we update "on" the second
+              ->interval (1)
+              ->cb (sub { delete $timers->{ov}; delete $timers->{t1}; });
+}
 
 sub on_keyboard_command {
    my ($self, $cmd) = @_;
@@ -6,6 +59,9 @@ sub on_keyboard_command {
    $cmd eq "selection:rot13"
       and $self->selection (map { y/A-Za-z/N-ZA-Mn-za-m/; $_ } $self->selection);
 
+   $cmd eq "selection:remote-pastebin"
+      and upload_paste ($self);
+
    ()
 }