File Coverage

blib/lib/Mojolicious/Command/nopaste/Service.pm
Criterion Covered Total %
statement 12 94 12.7
branch 0 24 0.0
condition 0 12 0.0
subroutine 4 24 16.6
pod 1 5 20.0
total 17 159 10.6


line stmt bran cond sub pod time code
1             package Mojolicious::Command::nopaste::Service;
2 1     1   7 use Mojo::Base 'Mojolicious::Command';
  1         2  
  1         12  
3              
4 1     1   525 use Mojo::UserAgent;
  1         135144  
  1         8  
5 1     1   36 use Mojo::Util qw/decode monkey_patch/;
  1         3  
  1         46  
6 1     1   5 use Getopt::Long qw(GetOptionsFromArray :config no_ignore_case); # no_auto_abbrev
  1         2  
  1         12  
7              
8             our $USAGE = <
9             USAGE:
10              
11             $0 command SERVICE [OPTIONS] [FILES]
12              
13             OPTIONS:
14             Note that not all options are relevant for all services.
15              
16             --channel, -c The channel for the service's pastebot or to post via Mojo::IRC
17             e.g. perl, #perl, irc://irc.perl.org:6667/perl
18             --copy, -x Copy the resulting URL to the clipboard (requires Clipboard.pm)
19             --description, -d Description or title of the nopaste
20             --name, -n Your name or nick, used for the pastebin and/or IRC
21             --language, -l Language for syntax highlighting, defaults to 'perl'
22             --open, -o Open a browser to the url (requires Browser::Open)
23             --paste, -p Read contents from clipboard (requires Clipboard.pm)
24             --private, -P Mark the paste as private (note: silently ignored if not relevant for service)
25             --token, -t A file containing an access token, or else the token string itself
26             --update, -u Update a paste of a given id
27              
28             END
29              
30             has usage => sub {
31             my $self = shift;
32             my $usage = $USAGE;
33             if (my $add = $self->service_usage) {
34             $usage .= "\n$add";
35             }
36             return $usage;
37             };
38              
39             has [qw/channel name desc service_usage token update/];
40             has [qw/copy open private irc_handled/] => 0;
41             has clip => sub {
42             die "Clipboard module not available. Do you need to install it?\n"
43             unless eval 'use Clipboard; 1';
44             monkey_patch 'Clipboard::Xclip',
45             copy => \&_xclip_copy,
46             paste => \&_xclip_paste;
47             return 'Clipboard';
48             };
49             has files => sub { [] };
50             has language => 'perl';
51             has text => sub { shift->slurp };
52             has ua => sub { Mojo::UserAgent->new->max_redirects(10) };
53              
54             sub run {
55 0     0 1   my ($self, @args) = @_;
56             GetOptionsFromArray( \@args,
57 0     0     'channel|c=s' => sub { $self->channel($_[1]) },
58 0     0     'copy|x' => sub { $self->copy($_[1]) },
59 0     0     'description|d=s' => sub { $self->desc($_[1]) },
60 0     0     'name|n=s' => sub { $self->name($_[1]) },
61 0     0     'language|l=s' => sub { $self->language($_[1]) },
62 0     0     'open|o' => sub { $self->open($_[1]) },
63 0     0     'paste|p' => sub { $self->text($self->clip->paste) },
64 0     0     'private|P' => sub { $self->private($_[1]) },
65 0     0     'token|t=s' => sub { $self->add_token($_[1]) },
66 0     0     'update|u=s' => sub { $self->update($_[1]) },
67 0           );
68 0           $self->files(\@args);
69 0 0         my $url = $self->paste or return;
70 0           say $url;
71 0 0         $self->clip->copy($url) if $self->copy;
72 0 0         if ($self->open) {
73             die "Browser::Open module not available. Do you need to install it?\n"
74 0 0         unless eval { require Browser::Open; 1 };
  0            
  0            
75 0           Browser::Open::open_browser($url);
76             }
77 0 0 0       if ($self->channel and not $self->irc_handled) {
78 0           $self->post_to_irc($url);
79             }
80             }
81              
82             sub add_token {
83 0     0 0   my ($self, $token) = @_;
84 0 0         if (-e $token) {
85 0           $token = $self->slurp($token);
86             }
87 0           chomp $token;
88 0           $self->token($token);
89             }
90              
91 0     0 0   sub paste { die 'Not implemented' }
92              
93             sub slurp {
94 0     0 0   my ($self, @files) = @_;
95 0 0         @files = @{ $self->files } unless @files;
  0            
96              
97 0           my $content = do {
98 0           local $/;
99 0           local @ARGV = @files;
100 0           decode 'UTF-8', <>;
101             };
102              
103             # Remove trailing newline as some sites won't do it for us
104 0           chomp $content;
105 0           return $content;
106             }
107              
108             sub post_to_irc {
109 0     0 0   my ($self, $paste) = @_;
110             die "This service requires Mojo::IRC to post to IRC, but it is not available. Do you need to install it?\n"
111 0 0         unless eval { require Mojo::IRC; 1 };
  0            
  0            
112 0           require Mojo::IOLoop;
113 0           require Mojo::URL;
114              
115 0           my $url = Mojo::URL->new($self->channel);
116 0   0       my $chan = $url->fragment || $url->path->[-1];
117 0 0         die "Could not parse IRC channel\n" unless $chan;
118 0   0       my $server = $url->host_port || 'irc.perl.org:6667';
119 0           my $irc = Mojo::IRC->new(server => $server, nick => 'MojoNoPaste', user => 'MojoNoPaste');
120 0           $irc->register_default_event_handlers;
121              
122 0   0       my $name = $self->name || 'someone';
123              
124 0           my $err;
125 0     0     my $catch = sub { $err = $_[1]; Mojo::IOLoop->stop };
  0            
  0            
126 0           $irc->on(error => $catch);
127 0           $irc->on(irc_error => $catch);
128              
129             $irc->on(irc_join => sub {
130 0     0     my ($irc, $message) = @_;
131 0           my $chan = $message->{params}[0];
132             my $delay = Mojo::IOLoop->delay(
133 0           sub { $irc->write( privmsg => $chan, ":$name pasted $paste", shift->begin ) },
134 0           sub { $irc->disconnect( shift->begin ) },
135 0           sub { Mojo::IOLoop->stop },
136 0           );
137 0           $delay->on(error => $catch);
138 0           });
139              
140             $irc->connect(sub{
141 0     0     my ($irc, $err) = @_;
142 0 0         die $err if $err;
143 0           say 'Connected to IRC';
144 0           $irc->write(join => "#$chan");
145 0           });
146              
147 0           Mojo::IOLoop->start;
148            
149 0 0         die $err if $err;
150             }
151              
152             sub _xclip_copy {
153 0     0     my ($self, $input) = @_;
154 0           eval { $self->copy_to_selection($_, $input) } for $self->all_selections();
  0            
155             }
156              
157             sub _xclip_paste {
158 0     0     my $self = shift;
159 0           my $data;
160 0           for my $sel ($self->all_selections) {
161 0           $data = eval { $self->paste_from_selection($sel) };
  0            
162 0 0         last if $data;
163             }
164 0   0       return decode 'UTF-8', $data || '';
165             }
166              
167             1;
168