ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection-pastebin
Revision: 1.18
Committed: Wed Jun 6 15:06:41 2012 UTC (11 years, 11 months ago) by root
Branch: MAIN
Changes since 1.17: +3 -0 lines
Log Message:
*** empty log message ***

File Contents

# Content
1 #! perl
2
3 #: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 sub upload_paste {
7 my ($self) = @_;
8
9 require Digest::MD5;
10
11 my $txt = $self->selection;
12
13 my $filename = $txt;
14 utf8::encode $filename;
15 $filename = Digest::MD5::md5_hex ($filename) . ".txt";
16
17 my $tmpfile = "/tmp/$filename";
18
19 my $msg = "uploaded as $filename";
20
21 if (open my $o, ">:utf8", $tmpfile) {
22 chmod 0644, $tmpfile;
23 print $o $txt;
24 close $o;
25 } else {
26 $msg = "couldn't write $tmpfile: $!";
27 }
28
29 my $cmd = $self->{pastebin_cmd};
30 $cmd =~ s/%/$tmpfile/;
31
32 my $pid = $self->exec_async ($cmd);
33
34 $self->{pw} = urxvt::pw->new->start ($pid)->cb (sub {
35 my (undef, $status) = @_;
36
37 delete $self->{pw};
38
39 if ($status) {
40 $status >>= 8;
41 $msg = "ERROR: command returned status $status";
42 } else {
43 my $url = $self->{pastebin_url};
44 $url =~ s/%/$filename/;
45
46 $self->selection ($url);
47 }
48
49 unlink $tmpfile;
50
51 my $ov = $self->overlay (-1, 0, $self->strwidth ($msg), 1, urxvt::OVERLAY_RSTYLE, 0);
52 $ov->set (0, 0, $msg);
53
54 $self->{timer} =
55 urxvt::timer
56 ->new
57 ->after (5)
58 ->cb (sub { delete $self->{timer}; undef $ov; });
59 });
60 }
61
62 sub on_start {
63 my ($self) = @_;
64
65 $self->{pastebin_cmd} = $self->x_resource ("selection-pastebin.cmd")
66 || "rcp -p % ruth:/var/www/www.ta-sa.org/files/txt/";
67
68 $self->{pastebin_url} = $self->x_resource ("selection-pastebin.url")
69 || "http://www.ta-sa.org/files/txt/%";
70
71 push @{ $self->{term}{selection_popup_hook} }, sub {
72 ("pastebin upload" => sub { $self->upload_paste })
73 };
74
75 ()
76 }
77
78 sub on_user_command {
79 my ($self, $cmd) = @_;
80
81 if ($cmd eq "selection-pastebin:remote-pastebin") {
82 $self->upload_paste;
83 }
84
85 ()
86 }
87