[ViewVC] Annotation of: cvs/cvsroot/rxvt-unicode/src/perl/selection-pastebin

#! perl

#:META:X_RESOURCE:%.cmd:string:the command to run create a new pastebin
#:META:X_RESOURCE:%.url:string:the url template for new pastebins

=head1 NAME

   selection-pastebin - automatic pastebin upload

=head1 DESCRPTION

This is a little rarely useful extension that uploads the selection as
textfile to a remote site (or does other things). (The implementation is
not currently secure for use in a multiuser environment as it writes to
F</tmp> directly.).

It listens to the C<selection-pastebin:remote-pastebin> keyboard command,
i.e.

   URxvt.keysym.C-M-e: perl:selection-pastebin:remote-pastebin

Pressing this combination runs a command with C<%> replaced by the name of
the textfile. This command can be set via a resource:

   URxvt.selection-pastebin.cmd: rsync -apP % ruth:/var/www/www.ta-sa.org/files/txt/.

And the default is likely not useful to anybody but the few people around
here :)

The name of the textfile is the hex encoded md5 sum of the selection, so
the same content should lead to the same filename.

After a successful upload the selection will be replaced by the text given
in the C<selection-pastebin-url> resource (again, the % is the placeholder
for the filename):

   URxvt.selection-pastebin.url: http://www.ta-sa.org/files/txt/%

I<Note to xrdb users:> xrdb uses the C preprocessor, which might interpret
the double C</> characters as comment start. Use C<\057\057> instead,
which works regardless of whether xrdb is used to parse the resource file
or not.

=cut

sub upload_paste {
   my ($self) = @_;

   require Digest::MD5;

   my $txt = $self->selection;

   my $filename = $txt;
   utf8::encode $filename;
   $filename = Digest::MD5::md5_hex ($filename) . ".txt";

   my $tmpfile = "/tmp/$filename";

   my $msg = "uploaded as $filename";

   if (open my $o, ">:utf8", $tmpfile) {
      chmod 0644, $tmpfile;
      print $o $txt;
      close $o;
   } else {
      $msg = "couldn't write $tmpfile: $!";
   }

   my $cmd = $self->{pastebin_cmd};
   $cmd =~ s/%/$tmpfile/;

   my $pid = $self->exec_async ($cmd);

   $self->{pw} = urxvt::pw->new->start ($pid)->cb (sub {
      my (undef, $status) = @_;

      delete $self->{pw};

      if ($status) {
         $status >>= 8;
         $msg = "ERROR: command returned status $status";
      } else {
         my $url = $self->{pastebin_url};
         $url =~ s/%/$filename/;

         $self->selection ($url);
      }

      unlink $tmpfile;

      my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
      $ov->set (0, 0, $msg);

      $self->{timer} =
         urxvt::timer
                 ->new
                 ->after (5)
                 ->cb (sub { delete $self->{timer}; undef $ov; });
   });
}

sub on_start {
   my ($self) = @_;

   $self->{pastebin_cmd} = $self->x_resource ("%.cmd")
                           || "rcp -p % ruth:/var/www/www.ta-sa.org/files/txt/";

   $self->{pastebin_url} = $self->x_resource ("%.url")
                           || "http://www.ta-sa.org/files/txt/%";

   push @{ $self->{term}{selection_popup_hook} }, sub {
      ("pastebin upload" => sub { $self->upload_paste })
   };

   ()
}

sub on_user_command {
   my ($self, $cmd) = @_;

   if ($cmd eq "selection-pastebin:remote-pastebin") {
      $self->upload_paste;
   }

   ()
}

Revision:	1.20
Committed:	Sun Jun 10 17:31:53 2012 UTC (14 years, 3 months ago) by root
Branch:	MAIN
Changes since 1.19:	+40 -0 lines
Log Message:	move perl docs to extensions
#	User	Rev	Content
1	elmex	1.1	#! perl
2
3	root	1.18	#:META:X_RESOURCE:%.cmd:string:the command to run create a new pastebin
4			#:META:X_RESOURCE:%.url:string:the url template for new pastebins
5
6	root	1.20	=head1 NAME
7
8			selection-pastebin - automatic pastebin upload
9
10			=head1 DESCRPTION
11
12			This is a little rarely useful extension that uploads the selection as
13			textfile to a remote site (or does other things). (The implementation is
14			not currently secure for use in a multiuser environment as it writes to
15			F</tmp> directly.).
16
17			It listens to the C<selection-pastebin:remote-pastebin> keyboard command,
18			i.e.
19
20			URxvt.keysym.C-M-e: perl:selection-pastebin:remote-pastebin
21
22			Pressing this combination runs a command with C<%> replaced by the name of
23			the textfile. This command can be set via a resource:
24
25			URxvt.selection-pastebin.cmd: rsync -apP % ruth:/var/www/www.ta-sa.org/files/txt/.
26
27			And the default is likely not useful to anybody but the few people around
28			here :)
29
30			The name of the textfile is the hex encoded md5 sum of the selection, so
31			the same content should lead to the same filename.
32
33			After a successful upload the selection will be replaced by the text given
34			in the C<selection-pastebin-url> resource (again, the % is the placeholder
35			for the filename):
36
37			URxvt.selection-pastebin.url: http://www.ta-sa.org/files/txt/%
38
39			I<Note to xrdb users:> xrdb uses the C preprocessor, which might interpret
40			the double C</> characters as comment start. Use C<\057\057> instead,
41			which works regardless of whether xrdb is used to parse the resource file
42			or not.
43
44			=cut
45
46	elmex	1.1	sub upload_paste {
47			my ($self) = @_;
48
49	root	1.2	require Digest::MD5;
50	elmex	1.1
51			my $txt = $self->selection;
52	root	1.16
53			my $filename = $txt;
54			utf8::encode $filename;
55			$filename = Digest::MD5::md5_hex ($filename) . ".txt";
56	elmex	1.1
57			my $tmpfile = "/tmp/$filename";
58
59	root	1.12	my $msg = "uploaded as $filename";
60	elmex	1.1
61	root	1.14	if (open my $o, ">:utf8", $tmpfile) {
62	root	1.6	chmod 0644, $tmpfile;
63	elmex	1.1	print $o $txt;
64			close $o;
65			} else {
66			$msg = "couldn't write $tmpfile: $!";
67			}
68
69	root	1.14	my $cmd = $self->{pastebin_cmd};
70	elmex	1.1	$cmd =~ s/%/$tmpfile/;
71
72	sf-exg	1.17	my $pid = $self->exec_async ($cmd);
73	elmex	1.1
74	root	1.14	$self->{pw} = urxvt::pw->new->start ($pid)->cb (sub {
75			my (undef, $status) = @_;
76	elmex	1.4
77	root	1.14	delete $self->{pw};
78	elmex	1.1
79	root	1.14	if ($status) {
80			$status >>= 8;
81			$msg = "ERROR: command returned status $status";
82			} else {
83			my $url = $self->{pastebin_url};
84			$url =~ s/%/$filename/;
85
86			$self->selection ($url);
87			}
88
89			unlink $tmpfile;
90
91			my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
92			$ov->set (0, 0, $msg);
93
94			$self->{timer} =
95			urxvt::timer
96			->new
97			->after (5)
98			->cb (sub { delete $self->{timer}; undef $ov; });
99			});
100	elmex	1.1	}
101
102	root	1.5	sub on_start {
103			my ($self) = @_;
104	root	1.10
105	root	1.19	$self->{pastebin_cmd} = $self->x_resource ("%.cmd")
106	root	1.14	\|\| "rcp -p % ruth:/var/www/www.ta-sa.org/files/txt/";
107	root	1.5
108	root	1.19	$self->{pastebin_url} = $self->x_resource ("%.url")
109	root	1.14	\|\| "http://www.ta-sa.org/files/txt/%";
110	root	1.5
111	root	1.10	push @{ $self->{term}{selection_popup_hook} }, sub {
112			("pastebin upload" => sub { $self->upload_paste })
113			};
114
115	root	1.5	()
116			}
117
118	root	1.15	sub on_user_command {
119	elmex	1.1	my ($self, $cmd) = @_;
120
121	root	1.5	if ($cmd eq "selection-pastebin:remote-pastebin") {
122			$self->upload_paste;
123			}
124	elmex	1.1
125			()
126			}
127