line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
#!/usr/bin/perl |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
949
|
use strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
24
|
|
4
|
1
|
|
|
1
|
|
4
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
18
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
29
|
use WWW::Shopify; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
WWW::Shopify::Public - Main object representing public app access to a particular Shopify store. |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=cut |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 DESCRIPTION |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
Inherits all methods from L, provides additional mechanisms to modify the used access_token, user-agent and url handler. |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
package WWW::Shopify::Public; |
21
|
|
|
|
|
|
|
use parent 'WWW::Shopify'; |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
=head1 METHODS |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=head2 new($url, $api_key, $access_token) |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
Creates a new WWW::Shopify::Public object, which allows you to make calls via the shopify public app interface. |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
You can see an overview of the authentication workflow for a public app here: L<< http://api.shopify.com/authentication.html >> |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=cut |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
sub new { |
34
|
|
|
|
|
|
|
my $class = shift; |
35
|
|
|
|
|
|
|
my ($shop_url, $api_key, $access_token) = @_; |
36
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Can't create a shop without an api key.") unless $api_key; |
37
|
|
|
|
|
|
|
my $self = $class->SUPER::new($shop_url); |
38
|
|
|
|
|
|
|
$self->api_key($api_key); |
39
|
|
|
|
|
|
|
$self->access_token($access_token); |
40
|
|
|
|
|
|
|
$self->ua->default_header("X-Shopify-Access-Token" => $access_token); |
41
|
|
|
|
|
|
|
return $self; |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head2 api_key([$api_key]) |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
Gets/sets the app's access token. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
=cut |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
sub api_key { $_[0]->{_api_key} = $_[1] if defined $_[1]; return $_[0]->{_api_key}; } |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head2 access_token([$access_token]) |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
Gets/sets the app's access token. |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
=cut |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub access_token { $_[0]->{_access_token} = $_[1] if defined $_[1]; return $_[0]->{_access_token}; } |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
sub is_valid { my $self = shift; $self->SUPER::is_valid(@_); return $self->{_access_token}; } |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head2 authorize_url(@$scope, $redirect) |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
When the shop doesn't have an access_token, this is what you should be redirecting your client to. Inputs should be your scope, as an array, and the url you want to redirect to. |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
=cut |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
use URI::Escape; |
69
|
|
|
|
|
|
|
sub authorize_url { |
70
|
|
|
|
|
|
|
my ($self, $scope, $redirect) = (@_); |
71
|
|
|
|
|
|
|
my $hostname = $self->shop_url; |
72
|
|
|
|
|
|
|
my %parameters = ( |
73
|
|
|
|
|
|
|
'client_id' => $self->api_key, |
74
|
|
|
|
|
|
|
'scope' => join(",", @$scope), |
75
|
|
|
|
|
|
|
'redirect_uri' => $redirect |
76
|
|
|
|
|
|
|
); |
77
|
|
|
|
|
|
|
return "https://$hostname/admin/oauth/authorize?" . join("&", map { "$_=" . uri_escape($parameters{$_}) } keys(%parameters)); |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head2 scope_compare(@$scope1, @$scope2) |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
Determines whether scope1 is more or less permissive than scope2. If the scopes cannot be compared easily |
83
|
|
|
|
|
|
|
(e.g. [write_orders, read_products], [read_products, write_script_tag]), then undef is returned. If scopes |
84
|
|
|
|
|
|
|
can be compared, returns -1, 0 or 1 as appropriate. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
use Exporter 'import'; |
89
|
|
|
|
|
|
|
our @EXPORT_OK = qw(scope_compare); |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
sub scope_compare { |
92
|
|
|
|
|
|
|
my ($scope1, $scope2) = @_; |
93
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Invalid scopes passed to compare.") unless ref($scope1) && ref($scope2) && ref($scope1) eq "ARRAY" && ref($scope2) eq "ARRAY"; |
94
|
|
|
|
|
|
|
# If scope2 has more permission settings than scope1, we've jumped up in permissions. |
95
|
|
|
|
|
|
|
return 1 if int(@$scope1) < int(@$scope2); |
96
|
|
|
|
|
|
|
return -1 if (int(@$scope1) > int(@$scope2)); |
97
|
|
|
|
|
|
|
# Here, we should have exactly equal amounts of scopes in both arrays, sorted. So they should be the same types down. |
98
|
|
|
|
|
|
|
$scope1 = [sort(@$scope1)]; |
99
|
|
|
|
|
|
|
$scope2 = [sort(@$scope2)]; |
100
|
|
|
|
|
|
|
for (0..int(@$scope1)-1) { |
101
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Invalid scope: $_") unless $scope1->[$_] =~ m/(read|write)_(\w+)/; |
102
|
|
|
|
|
|
|
my ($scope1_permission, $scope1_type) = ($1, $2); |
103
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Invalid scope: $_") unless $scope2->[$_] =~ m/(read|write)_(\w+)/; |
104
|
|
|
|
|
|
|
my ($scope2_permission, $scope2_type) = ($1, $2); |
105
|
|
|
|
|
|
|
# If we have not the same type, that means we've got some weird permissions going on, so we return undef, because it's |
106
|
|
|
|
|
|
|
# neither less nor more permissive, necessarily, just different. |
107
|
|
|
|
|
|
|
return undef unless $scope1_type eq $scope2_type; |
108
|
|
|
|
|
|
|
# When we've jumped down to a read in our second scope, we're less permissive. |
109
|
|
|
|
|
|
|
return -1 if $scope2_permission eq "read" && $scope1_permission eq "write"; |
110
|
|
|
|
|
|
|
# When we've jumped up to a write in our |
111
|
|
|
|
|
|
|
return 1 if $scope1_permission eq "read" && $scope2_permission eq "write"; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
return 0; |
114
|
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=head2 exchange_token($shared_secret, $code) |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
When you have a temporary code, which you should get from authorize_url's redirect and you want to exchange it for a token, you call this. |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
=cut |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
sub exchange_token { |
123
|
|
|
|
|
|
|
my ($self, $shared_secret, $code) = (@_); |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
my $req = HTTP::Request->new(POST => "https://" . $self->shop_url . "/admin/oauth/access_token"); |
126
|
|
|
|
|
|
|
$req->content_type('application/x-www-form-urlencoded'); |
127
|
|
|
|
|
|
|
my %parameters = ( |
128
|
|
|
|
|
|
|
'client_id' => $self->api_key, |
129
|
|
|
|
|
|
|
'client_secret' => $shared_secret, |
130
|
|
|
|
|
|
|
'code' => $code |
131
|
|
|
|
|
|
|
); |
132
|
|
|
|
|
|
|
$req->content(join("&", map { "$_=" . uri_escape($parameters{$_}) } keys(%parameters))); |
133
|
|
|
|
|
|
|
my $res; |
134
|
|
|
|
|
|
|
# If you go through the install too fast, Shopify will give you an access denied thing. So in that case, let's repeat until |
135
|
|
|
|
|
|
|
my $success = undef; |
136
|
|
|
|
|
|
|
for (my $i = 0; $i < 5 && !$success; ++$i) { |
137
|
|
|
|
|
|
|
$res = $self->ua->request($req); |
138
|
|
|
|
|
|
|
$success = $res->is_success(); |
139
|
|
|
|
|
|
|
sleep 1 unless $success; |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Unable to reach server for https://" . $self->shop_url . "/admin/oauth/access_token: " . $res->code() . ".\n" . $res->content) unless $res->is_success(); |
142
|
|
|
|
|
|
|
my $decoded = JSON::decode_json($res->content); |
143
|
|
|
|
|
|
|
die new WWW::Shopify::Exception("Unable to retrieve access token.") unless defined $decoded->{access_token}; |
144
|
|
|
|
|
|
|
return $decoded->{access_token}; |
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
|
|
|
|
|
|
=head1 SEE ALSO |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
L, L |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=head1 AUTHOR |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Adam Harrison (adamdharrison@gmail.com) |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 LICENSE |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
See LICENSE in the main directory. |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
1; |