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