File Coverage

blib/lib/Mojolicious/Command/nopaste/Service/perlbot.pm
Criterion Covered Total %
statement 14 46 30.4
branch 1 6 16.6
condition 3 6 50.0
subroutine 4 9 44.4
pod 1 4 25.0
total 23 71 32.3


line stmt bran cond sub pod time code
1             package Mojolicious::Command::nopaste::Service::perlbot;
2 1     1   86921 use Mojo::Base 'Mojolicious::Command::nopaste::Service';
  1         229027  
  1         6  
3 1     1   313947 use Mojo::JSON qw/decode_json/;
  1         3  
  1         47  
4              
5 1     1   7 use Getopt::Long;
  1         2  
  1         6  
6              
7             our $VERSION = '0.007';
8              
9             # ABSTRACT: Pastes stuff to https://perl.bot/
10              
11             has name => 'anonymous';
12             has 'irc_handled' => 1;
13             has desc => 'I broke this';
14              
15             has 'service_usage' =>
16             qq{perl.bot specific options:
17              
18             --get-channels Ask the pastebin about what channels it knows, and exit
19             --get-languages Ask the pastebin about what languages it knows, and exit
20             };
21              
22             sub run {
23 0     0 1 0 my ($self, @args) = @_;
24              
25 0         0 my $p = Getopt::Long::Parser->new;
26 0         0 $p->configure("no_ignore_case", "pass_through");
27             $p->getoptionsfromarray( \@args,
28 0     0   0 'get-channels' => sub {$self->display_channels; exit(1)},
  0         0  
29 0     0   0 'get-languages' => sub {$self->display_languages; exit(1)},
  0         0  
30 0         0 );
31              
32 0         0 $self->SUPER::run(@args);
33             }
34              
35             sub display_channels {
36 0     0 0 0 my $self = shift;
37 0         0 my $tx = $self->ua->get( 'https://perl.bot/api/v2/channels');
38            
39 0 0       0 unless ($tx->res->is_success) {
40 0         0 say "Failed to get channels, try again later.";
41 0         0 exit 1;
42             }
43              
44 0         0 my $response = decode_json $tx->res->body;
45              
46 0         0 my $output="Channels supported by perl.bot, all values subject to change.\n-----------------------------------\n";
47 0         0 for my $channel (@{$response->{channels}}) {
  0         0  
48 0         0 $output .= sprintf "%15s %20s\n", $channel->{name}, $channel->{description};
49             }
50              
51 0         0 print $output;
52             }
53              
54             sub display_languages {
55 0     0 0 0 my $self = shift;
56 0         0 my $tx = $self->ua->get( 'https://perl.bot/api/v2/languages');
57            
58 0 0       0 unless ($tx->res->is_success) {
59 0         0 say "Failed to get languages, try again later.";
60             }
61              
62 0         0 my $response = decode_json $tx->res->body;
63              
64 0         0 my $output="Languages supported by perl.bot\n-----------------------------\n";
65 0         0 for my $lang (@{$response->{languages}}) {
  0         0  
66 0         0 $output .= sprintf "%15s %20s\n", $lang->{name}, $lang->{description};
67             }
68              
69 0         0 print $output;
70             }
71              
72             sub paste {
73 1     1 0 695 my $self = shift;
74              
75 1   50     10 my $tx = $self->ua->post( 'https://perl.bot/api/v2/paste', form => {
      50        
      50        
76             paste => $self->text,
77             username => $self->name,
78             language => $self->language || '',
79             channel => $self->channel || '',
80             description => $self->desc || '',
81             });
82            
83 1 50       637006 unless ($tx->res->is_success) {
84 0         0 say "Paste failed, try again later.";
85 0         0 exit 1;
86             }
87              
88 1         46 my $response = decode_json $tx->res->body;
89 1         407 return $response->{url};
90             }
91            
92             1;
93              
94             __END__
95             =head1 NAME
96              
97             Mojolicious::Command::nopaste::Service::perlbot - A Mojo-nopaste service for https://perl.bot/
98              
99             =head1 AUTHOR
100             Ryan Voots L<simcop@cpan.org|mailto:SIMCOP@cpan.org>
101              
102             =head1 CONTRIBUTORS
103              
104             Dan Book
105              
106             =cut