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 |