File Coverage

blib/lib/App/Nopaste/Service/Gist.pm
Criterion Covered Total %
statement 30 81 37.0
branch 5 28 17.8
condition 2 13 15.3
subroutine 10 14 71.4
pod 3 6 50.0
total 50 142 35.2


line stmt bran cond sub pod time code
1 2     2   80710 use strict;
  2         5  
  2         51  
2 2     2   9 use warnings;
  2         4  
  2         88  
3             package App::Nopaste::Service::Gist;
4             # ABSTRACT: Service provider for GitHub gist - http://gist.github.com/
5              
6             our $VERSION = '1.011';
7              
8 2     2   227 use parent 'App::Nopaste::Service';
  2         216  
  2         9  
9              
10 2     2   383 use JSON::MaybeXS;
  2         4451  
  2         113  
11 2     2   301 use Module::Runtime 'use_module';
  2         1925  
  2         17  
12 2     2   601 use Path::Tiny;
  2         7623  
  2         125  
13 2     2   389 use namespace::clean 0.19;
  2         9747  
  2         12  
14              
15 1     1 0 110 sub available { 1 }
16 1     1 0 7 sub forbid_in_default { 0 }
17              
18             sub nopaste {
19 0     0 1 0 my $self = shift;
20 0         0 $self->run(@_);
21             }
22              
23             sub run {
24 0     0 1 0 my ($self, %arg) = @_;
25 0         0 my $ua = LWP::UserAgent->new;
26              
27             my $content = {
28             public => defined $arg{private} ? JSON->false : JSON->true,
29 0 0       0 defined $arg{desc} ? (description => $arg{desc}) : (),
    0          
30             };
31              
32             my $filename = defined $arg{filename}
33 0 0       0 ? path($arg{filename})->basename
34             : 'nopaste';
35              
36             $content->{files} = {
37             $filename => {
38             content => $arg{text}
39             }
40 0         0 };
41              
42 0         0 $content = encode_json($content);
43              
44 0         0 my %auth = $self->_get_auth;
45              
46 0         0 my $url = 'https://api.github.com/gists';
47              
48 0         0 my $res = do {
49 0 0       0 if ($auth{oauth_token}) {
50 0         0 $ua->post(
51             $url,
52             'Authorization' => "token $auth{oauth_token}",
53             Content => $content,
54             Content_Type => 'application/json',
55             );
56             }
57             else {
58 0         0 use_module('HTTP::Request::Common');
59 0         0 my $req = HTTP::Request::Common::POST($url, Content => $content);
60 0         0 $req->authorization_basic(@auth{qw/username password/});
61 0         0 $ua->request($req);
62             }
63             };
64              
65 0         0 return $self->return($res);
66             }
67              
68             sub _get_auth {
69 4     4   8541 my ($self) = @_;
70              
71 4 100 66     25 if (my $oauth_token = $ENV{GITHUB_OAUTH_TOKEN}) {
    100          
72 1         10 return (oauth_token => $oauth_token);
73             }
74             elsif ($ENV{GITHUB_USER} && $ENV{GITHUB_PASSWORD}) {
75             return (
76             username => $ENV{GITHUB_USER},
77             password => $ENV{GITHUB_PASSWORD},
78 1         9 );
79             }
80             else {
81             # this is also done by the fallback mechanism in Config::Identity::GitHub.
82 2         7 my $github_config = path('~', '.github');
83 2 50       143 if (-f $github_config) {
84 0         0 my $content = $github_config->slurp_utf8;
85 0         0 my ($username) = $content =~ m/\blogin (.+)(?:$|#)/m;
86 0         0 my ($password) = $content =~ m/\bpassword (.+)(?:$|#)/m;
87             return (
88 0 0 0     0 username => $username,
89             password => $password,
90             ) if $username and $password;
91             }
92             }
93              
94 2         37 die join("\n",
95             "Export GITHUB_OAUTH_TOKEN first. For example:",
96             " perl -MApp::Nopaste::Service::Gist -e 'App::Nopaste::Service::Gist->create_token'",
97             "",
98             "OR you can export GITHUB_USER and GITHUB_PASSWORD.",
99             "OR you can set 'login' and 'password' in ~/.github.",
100             ) . "\n";
101             }
102              
103             sub create_token {
104 0     0 0   my ($self) = @_;
105              
106 0           local $| = 1;
107 0           print "Username: ";
108 0           chomp(my $username = <>);
109 0           print "Password: ";
110 0           chomp(my $password = <>);
111 0           print "\n\n";
112              
113 0 0 0       exit unless $username && $password;
114              
115 0           my $parameters = {
116             scopes => ["gist"],
117             note => "App::Nopaste",
118             note_url => "https://metacpan.org/module/App::Nopaste",
119             };
120              
121 0           my $ua = LWP::UserAgent->new;
122              
123 0           my $request = HTTP::Request->new(POST => 'https://api.github.com/authorizations');
124 0           $request->authorization_basic($username, $password);
125 0           $request->content(encode_json($parameters));
126              
127 0           my $response = $ua->request($request);
128              
129 0           my $response_content = decode_json($response->decoded_content);
130              
131 0 0         if ($response_content->{token} ) {
132 0           print "GITHUB_OAUTH_TOKEN=$response_content->{token}\n";
133             }
134             else {
135 0   0       print $response_content->{message} || "Unspecified error", "\n";
136             }
137             }
138              
139             sub return {
140 0     0 1   my ($self, $res) = @_;
141              
142 0 0         if ($res->is_error) {
143 0           my $text = $res->status_line;
144 0 0         if ($res->code == 401) {
145 0           $text .= "\nYou may need to authorize $0. See `perldoc " . __PACKAGE__ . "`";
146             }
147 0           return (0, "Failed: " . $text);
148             }
149              
150 0 0 0       if (($res->header('Client-Warning') || '') eq 'Internal response') {
151 0           return (0, "LWP Error: " . $res->content);
152             }
153              
154 0           my $id = decode_json($res->content)->{id};
155              
156 0 0         return (0, "Could not find paste link.") if !$id;
157 0           return (1, "https://gist.github.com/$id");
158             }
159              
160             1;
161              
162             __END__