File Coverage

blib/lib/WWW/PlCloud.pm
Criterion Covered Total %
statement 21 61 34.4
branch 0 16 0.0
condition 0 6 0.0
subroutine 7 13 53.8
pod 0 4 0.0
total 28 100 28.0


line stmt bran cond sub pod time code
1             package WWW::PlCloud;
2              
3 1     1   14746 use 5.006;
  1         3  
  1         35  
4 1     1   8 use strict;
  1         1  
  1         32  
5 1     1   4 use warnings;
  1         4  
  1         41  
6              
7             =head1 NAME
8              
9             WWW::PlCloud - The great new WWW::PlCloud!
10              
11             =head1 VERSION
12              
13             Version 0.01
14              
15             =cut
16              
17             our $VERSION = '0.01';
18              
19 1     1   473 use Moo;
  1         11215  
  1         5  
20              
21 1     1   8669 use LWP::UserAgent;
  1         58118  
  1         35  
22 1     1   773 use JSON qw/to_json from_json/;
  1         9862  
  1         4  
23 1     1   757 use Data::Dumper;
  1         5805  
  1         553  
24              
25             has sessionid => (
26             is => 'rw',
27             );
28              
29             has csrftoken => (
30             is => 'rw',
31             );
32              
33             has ua => (
34             is => 'rw',
35             );
36              
37             has user => (
38             is => 'rw', required => 1,
39             );
40              
41             has pass => (
42             is => 'rw', required => 1,
43             );
44              
45              
46              
47             =head1 SYNOPSIS
48              
49             Quick summary of what the module does.
50              
51             Perhaps a little code snippet.
52              
53             use WWW::PlCloud;
54              
55             my $foo = WWW::PlCloud->new();
56              
57              
58             =head1 SUBROUTINES/METHODS
59             =cut
60              
61             sub run_api {
62 0     0 0   my ( $self, $api, @o_args ) = @_;
63 0           my $uri = "https://console.plcloud.com/api/";
64              
65             # Build
66 0 0         my %post = @o_args ? @o_args : ();
67 0           $post{ action } = $api;
68              
69 0           my $req = HTTP::Request->new( 'POST', $uri );
70 0           $req->header( 'Content-Type' => 'application/json' );
71              
72             # 必须加额外的这个垃圾头
73 0           $req->header( 'x-csrftoken' => $self->csrftoken );
74 0           $req->content( to_json( \%post ) );
75              
76 0           my $res = $self->ua->request( $req );
77 0 0 0       if ( $res && $res->is_success ) {
78 0           my $json = from_json( $res->content );
79             # 输出数据
80 0           print_result( $json );
81             }
82             }
83              
84              
85             sub login {
86 0     0 0   my $self = shift;
87 0           my $uri = 'https://console.plcloud.com/auth/login/';
88              
89 0           my $post = {
90             csrfmiddlewaretoken => $self->csrftoken,
91             username => $self->user,
92             password => $self->pass,
93             region => 'http://58.67.194.89:5001/v2.0',
94             };
95              
96 0           my $res = $self->ua->post( $uri, $post );
97              
98 0 0 0       return 1 if $res && $res->code == 302;
99 0           return 0;
100             }
101              
102              
103             # init PlCloud Object
104             sub BUILD {
105 0     0 0   my ( $self ) = @_;
106              
107 0           $self->ua( LWP::UserAgent->new( cookie_jar => {} ) );
108 0           $self->ua->max_redirect( 9 );
109              
110             # 初始化 csrftoken
111 0           $self->__init_csrftoken();
112              
113 0           return $self;
114             }
115              
116             sub __init_csrftoken {
117 0     0     my $self = shift;
118              
119 0           my $uri = 'https://console.plcloud.com/api/';
120 0           my $res = $self->ua->get( $uri );
121              
122 0 0         if ( $res->is_success ) {
123 0           my $cookie = $self->ua->cookie_jar;
124             $cookie->scan( sub {
125 0 0   0     $self->csrftoken( $_[2] ) if $_[1] eq 'csrftoken';
126 0 0         $self->sessionid( $_[2] ) if $_[1] eq 'sessionid';
127 0           } );
128              
129             }else {
130 0           die "Can't get CSRFtoken\n";
131             }
132              
133 0           return $self;
134             }
135              
136             sub print_result {
137 0     0 0   my ( $json, $shift ) = @_;
138              
139 0           foreach my $k ( sort keys %$json ) {
140 0 0         if ( ref $json->{ $k } eq 'HASH' ) {
141 0           print "$k:\n";
142 0           print_result( $json->{ $k }, 1 );
143             } else {
144 0 0         print "\t" if $shift;
145 0           print "$k: $json->{ $k }\n";
146             }
147             }
148             }
149              
150             1;
151              
152             =head1 AUTHOR
153              
154             MC Cheung, C<< >>
155              
156             =head1 BUGS
157              
158             Please report any bugs or feature requests to C, or through
159             the web interface at L. I will be notified, and then you'll
160             automatically be notified of progress on your bug as I make changes.
161              
162              
163              
164              
165             =head1 SUPPORT
166              
167             You can find documentation for this module with the perldoc command.
168              
169             perldoc WWW::PlCloud
170              
171              
172             You can also look for information at:
173              
174             =over 4
175              
176             =item * RT: CPAN's request tracker (report bugs here)
177              
178             L
179              
180             =item * AnnoCPAN: Annotated CPAN documentation
181              
182             L
183              
184             =item * CPAN Ratings
185              
186             L
187              
188             =item * Search CPAN
189              
190             L
191              
192             =back
193              
194              
195             =head1 ACKNOWLEDGEMENTS
196              
197              
198             =head1 LICENSE AND COPYRIGHT
199              
200             Copyright 2015 MC Cheung.
201              
202             This program is free software; you can redistribute it and/or modify it
203             under the terms of the the Artistic License (2.0). You may obtain a
204             copy of the full license at:
205              
206             L
207              
208             Any use, modification, and distribution of the Standard or Modified
209             Versions is governed by this Artistic License. By using, modifying or
210             distributing the Package, you accept this license. Do not use, modify,
211             or distribute the Package, if you do not accept this license.
212              
213             If your Modified Version has been derived from a Modified Version made
214             by someone other than you, you are nevertheless required to ensure that
215             your Modified Version complies with the requirements of this license.
216              
217             This license does not grant you the right to use any trademark, service
218             mark, tradename, or logo of the Copyright Holder.
219              
220             This license includes the non-exclusive, worldwide, free-of-charge
221             patent license to make, have made, use, offer to sell, sell, import and
222             otherwise transfer the Package with respect to any patent claims
223             licensable by the Copyright Holder that are necessarily infringed by the
224             Package. If you institute patent litigation (including a cross-claim or
225             counterclaim) against any party alleging that the Package constitutes
226             direct or contributory patent infringement, then this Artistic License
227             to you shall terminate on the date that such litigation is filed.
228              
229             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
230             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
231             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
232             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
233             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
234             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
235             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
236             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
237              
238              
239             =cut
240              
241             1; # End of WWW::PlCloud