ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/rxvt-unicode/src/perl/selection-pastebin
Revision: 1.16
Committed: Fri Mar 10 21:36:16 2006 UTC (18 years, 2 months ago) by root
Branch: MAIN
CVS Tags: before_dynamic_fontidx, rel-7_8, rel-7_9, rel-9_11, rel-9_10, rel-8_1, rel-9_12, rel-8_5a, rel-8_2, rel-8_9, rel-8_8, dynamic_fontidx, rel-8_0, rel-8_4, rel-9_0, rel-8_3, rel-8_6, rel-8_7, rel-9_09, rel-9_02, rel-9_01, rel-9_06, rel-9_07, rel-9_05
Changes since 1.15: +4 -1 lines
Log Message:
*** empty log message ***

File Contents

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