File Coverage

blib/lib/WebService/Pixela/Graph.pm
Criterion Covered Total %
statement 83 89 93.2
branch 40 52 76.9
condition 11 21 52.3
subroutine 14 15 93.3
pod 8 10 80.0
total 156 187 83.4


line stmt bran cond sub pod time code
1             package WebService::Pixela::Graph;
2 6     6   209162 use 5.010001;
  6         27  
3 6     6   30 use strict;
  6         13  
  6         127  
4 6     6   31 use warnings;
  6         15  
  6         167  
5 6     6   31 use Carp qw/croak/;
  6         13  
  6         6880  
6              
7             our $VERSION = "0.01";
8              
9             sub new {
10 43     43 0 8384 my ($class,$pixela_client) = @_;
11 43         137 return bless +{
12             client => $pixela_client,
13             }, $class;
14             }
15              
16              
17             sub client {
18 24     24 0 3733 my $self = shift;
19 24         69 return $self->{client};
20             }
21              
22             sub id {
23 47     47 1 8059 my $self = shift;
24 47 100       118 if (@_){
25 15         32 $self->{id} = shift;
26 15         51 return $self;
27             }
28 32         101 return $self->{id};
29             }
30              
31             sub create {
32 8     8 1 5020 my ($self,%args) = @_;
33 8         17 my $params = {};
34              
35             #check id
36 8   66     28 $params->{id} = $args{id} // $self->id();
37 8 100       242 croak 'require id' unless $params->{id};
38              
39             #check name unit
40 7   66     15 map { $params->{$_} = $args{$_} // croak "require $_" } (qw/name unit/);
  13         182  
41              
42             # check type
43 5 100       82 croak 'require type' unless $args{type};
44             map {
45 4 100       8 if ( $args{type} =~ /^$_$/i){
  8         95  
46 3         17 $params->{type} = lc($args{type});
47             }
48             } (qw/int float/);
49              
50 4 100       86 croak 'invalid type' unless $params->{type};
51              
52             # check color
53 3 100       77 croak 'require color' unless $args{color};
54 2         7 $params->{color} = _color_validate($args{color});
55 2 100       96 croak 'invalid color' unless $params->{color};
56              
57             #no check timezone...
58 1 50       3 $params->{timezone} = $args{timezone} if $args{timezone};
59              
60 1         4 my $path = 'users/'.$self->client->username.'/graphs';
61 1         13 $self->id($params->{id});
62 1         2 return $self->client->request_with_xuser_in_header('POST',$path,$params);
63             }
64              
65              
66             sub get {
67 2     2 1 8 my $self = shift;
68 2         5 my $res = $self->client->request_with_xuser_in_header('GET',('users/'.$self->client->username.'/graphs'));
69 2 100       22 return $self->client->decode() ? $res->{graphs} : $res;
70             }
71              
72              
73             sub get_svg {
74 4     4 1 1621 my ($self, %args) = @_;
75 4   100     43 my $id = $args{id} // $self->id;
76 4 100       86 croak 'require graph id' unless $id;
77              
78 3         6 my $query = {};
79 3 100       10 $query->{date} = $args{date} if $args{date};
80 3 100       8 $query->{mode} = $args{mode} if $args{mode};
81              
82 3         8 my $path = 'users/'.$self->client->username.'/graphs/'.$id;
83              
84 3         19 return $self->client->query_request('GET',$path,$query);
85             }
86              
87             sub update {
88 2     2 1 49 my ($self,%arg) = @_;
89 2         6 my $client = $self->client;
90              
91 2   66     11 my $id = $arg{id} // $self->id;
92 2 100       81 croak 'require graph id' unless $id;
93              
94 1         2 my $params = {};
95 1 100       4 map { $params->{$_} = $arg{$_} if $arg{$_} } (qw/name unit timezone/);
  3         15  
96              
97             #color invalid -> croak
98 1 50       13 if ($arg{color}){
99 1         5 $params->{color} = _color_validate($arg{color});
100 1 50       4 croak 'invalid color' unless $params->{color};
101             }
102              
103 1 50       4 if ($arg{purge_cache_urls}){
104 1 50       5 if (ref($arg{purge_cache_urls}) ne 'ARRAY'){
105 0         0 croak 'invalid types for purge_cache_urls';
106             }
107 1         3 $params->{purgeCacheURLs} = $arg{purge_cache_urls};
108             }
109              
110 1 50       4 $params->{selfSufficient} = $arg{self_sufficient} if defined $arg{self_sufficient};
111              
112 1         5 return $client->request_with_xuser_in_header('PUT',('users/'.$client->username.'/graphs/'.$id),$params);
113             }
114              
115             sub delete {
116 0     0 1 0 my ($self,$id) = @_;
117 0         0 my $client = $self->client;
118              
119 0   0     0 $id //= $self->id;
120 0 0       0 croak 'require graph id' unless $id;
121              
122 0         0 return $client->request_with_xuser_in_header('DELETE',('users/'.$client->username.'/graphs/'.$id));
123             }
124              
125             sub html {
126 1     1 1 6 my ($self,$id) = @_;
127              
128 1         4 my $client = $self->client;
129              
130 1   33     7 $id //= $self->id;
131 1 50       4 croak 'require graph id' unless $id;
132              
133 1         4 return $client->base_url . 'v1/users/'.$client->username.'/graphs/'.$id.'.html';
134             }
135              
136             sub pixels {
137 2     2 1 14 my ($self,%args) = @_;
138              
139 2   33     7 my $id = $args{id} // $self->id;
140 2 50       7 croak 'require id' unless $id;
141              
142 2         3 my $params = {};
143 2 50       9 $params->{to} = $args{to} if $args{to};
144 2 50       6 $params->{from} = $args{from} if $args{from};
145              
146 2         6 my $path = 'users/'.$self->client->username.'/graphs/'.$id.'/pixels';
147 2         14 my $res = $self->client->request_with_xuser_in_header('GET',$path,$params);
148              
149 2 100       12 return $self->client->decode() ? $res->{pixels} : $res;
150             }
151              
152             sub _color_validate {
153 3     3   6 my $check_color = shift;
154             map {
155 3 100       7 if ($check_color =~ /^$_$/i){
  12         101  
156 2         10 return lc($check_color);
157             }
158             } (qw/shibafu momiji sora ichou ajisai kuro/);
159 1         4 return undef;
160             }
161              
162             1;
163             __END__