File Coverage

blib/lib/App/Photobear.pm
Criterion Covered Total %
statement 36 115 31.3
branch 7 60 11.6
condition 0 6 0.0
subroutine 9 14 64.2
pod 5 7 71.4
total 57 202 28.2


line stmt bran cond sub pod time code
1             #ABSTRACT: Photobear API client
2             package App::Photobear;
3 1     1   944 use v5.18;
  1         3  
4 1     1   4 use warnings;
  1         2  
  1         23  
5 1     1   5 use Carp;
  1         2  
  1         78  
6 1     1   777 use HTTP::Tiny;
  1         49704  
  1         39  
7 1     1   619 use Data::Dumper;
  1         6279  
  1         59  
8 1     1   721 use JSON::PP;
  1         13860  
  1         128  
9              
10             # Define version
11             our $VERSION = '0.1.2';
12              
13             # Define constants
14             our $PHOTOBEAR_URL = 'https://photobear.io/api/public/submit-photo';
15             our @MODES = split / /, "background_removal vectorization super_resolution compress";
16             our $TESTMODE = $ENV{"PHOTOBEAR_TEST"} || 0;
17              
18             # Export MODES
19 1     1   8 use Exporter qw(import);
  1         2  
  1         1547  
20             our @EXPORT_OK = qw(loadconfig saveconfig url_exists curl photobear url_type @MODES);
21             our $TEST_ANSWER = q({"status":"success","data":{"result_url":"https://res.cloudinary.com/dy4s1umzd/image/upload/e_vectorize:colors:20:detail:0.7:corners:20/v1688570702/svg_inp/aia14r/core-people.svg"}});
22              
23             sub loadconfig {
24 1     1 1 608 my $filename = shift;
25 1 50       24 if (! -e "$filename") {
26 0         0 return {};
27             }
28 1 50       42 open my $fh, '<', $filename or Carp::croak "Can't open $filename: $!";
29 1         4 my $config = {};
30 1         78 while (my $line = readline($fh)) {
31 2         9 chomp $line;
32 2 100       18 next if $line =~ /^[#[]/;
33 1         5 my ($key, $value) = split /=/, $line;
34 1         7 $config->{"$key"} = $value;
35             }
36 1         24 return $config;
37             }
38              
39             sub writeconfig {
40 0     0 0 0 my ($filename, $config) = @_;
41 0 0       0 open my $fh, '>', $filename or Carp::croak "Can't open $filename: $!";
42 0         0 say $fh '[photobear]';
43 0         0 foreach my $key (keys %$config) {
44 0         0 print $fh "$key=$config->{$key}\n";
45             }
46             }
47              
48             sub url_exists {
49 2     2 1 1587 my ($url) = @_;
50              
51             # Create an HTTP::Tiny object
52 2         13 my $http = HTTP::Tiny->new;
53              
54             # Send a HEAD request to check the URL
55 2         283 my $response = $http->head($url);
56            
57             # If the response status is success (2xx), the URL exists
58 2 100       1011707 if ($response->{success}) {
    50          
59 1         38 return 1;
60             } elsif ($response->{status} == 599) {
61             # Try anothe method: SSLeay 1.49 or higher required
62            
63 0         0 eval {
64 0         0 require LWP::UserAgent;
65 0         0 my $ua = LWP::UserAgent->new;
66 0         0 $ua->ssl_opts(verify_hostname => 0); # Disable SSL verification (optional)
67 0         0 my $response = $ua->get($url);
68            
69 0 0       0 if ($response->is_success) {
70 0         0 return 1;
71             } else {
72 0         0 return 0;
73             }
74             };
75 0 0       0 if ($@) {
76 0         0 my $cmd = qq(curl --silent -L -I $url);
77 0         0 my @output = `$cmd`;
78 0         0 for my $line (@output) {
79 0         0 chomp $line;
80 0 0 0     0 if ($line =~ /^HTTP/ and $line =~ /200/) {
81 0         0 return 1;
82             }
83             }
84             }
85              
86             } else {
87 1         16 return 0;
88             }
89             }
90              
91             sub url_type {
92 0     0 0   my $url = shift;
93 0           my $cmd = qq(curl --silent -L -I $url);
94 0 0         if ($? == -1) {
    0          
    0          
95 0           Carp::croak("[url_type] ", "Failed to execute: $!\n");
96             } elsif ($? & 127) {
97 0 0         Carp::croak("[url_type] ", sprintf("Child died with signal %d, %s coredump\n"),
98             ($? & 127), ($? & 128) ? 'with' : 'without');
99             } elsif ($? >> 8) {
100 0           Carp::croak("[url_type] ", sprintf("Child exited with value %d\n", $? >> 8));
101             }
102 0           my @output = `$cmd`;
103 0           for my $line (@output) {
104 0           chomp $line;
105 0 0         if ($line =~ /^content-type/i) {
106             # Strip color codes
107 0           $line =~ s/\e\[[\d;]*[a-zA-Z]//g;
108 0           my ($type) = $line =~ /Content-Type: (.*)/i;
109 0           return $type;
110             }
111             }
112 0           return undef;
113             }
114              
115             sub curl {
116 0     0 1   my ($url) = @_;
117            
118              
119 0           eval {
120 0           require LWP::UserAgent;
121            
122             # Create a UserAgent object
123 0           my $ua = LWP::UserAgent->new;
124 0           $ua->ssl_opts(verify_hostname => 0); # Disable SSL verification (optional)
125            
126             # Send the initial GET request
127 0           my $response = $ua->get($url);
128            
129             # Follow redirects if any
130 0           while ($response->is_redirect) {
131 0           my $redirect_url = $response->header('Location');
132 0           $response = $ua->get($redirect_url);
133             }
134            
135 0           return $response->decoded_content;
136             };
137            
138 0 0         if ($@) {
139             # Fallback to system curl command
140 0           eval {
141 0           my $output = `curl --silent -L $url`;
142 0           return $output;
143             };
144 0 0         if ($@) {
145 0           die "Can't get content of $url: $@";
146             }
147             }
148             }
149              
150             sub photobear {
151 0     0 1   my ($api_key, $mode, $url) = @_;
152              
153             # If $mode is not in $MODES, then die
154 0 0         if (! grep { $_ eq $mode } @MODES) {
  0            
155 0           Carp::croak("Invalid mode: $mode (must be one of @MODES)");
156             }
157              
158             # If no API key, then die
159 0 0 0       if (! $api_key or length($api_key) == 0) {
160 0           Carp::croak "No API key provided";
161             }
162 0           my $cmd = qq(curl --location --silent --request POST '$PHOTOBEAR_URL' \
163             --header 'x-api-key: $api_key' \
164             --header 'Content-Type: application/json' \
165             --data-raw '{
166             "photo_url":"$url",
167             "mode":"$mode"
168             }');
169 0           $cmd =~ s/\n//g;
170            
171 0 0         if ($ENV{'DEBUG'}) {
172 0           say STDERR "[DEBUG] $cmd";
173             }
174              
175 0 0         my $output = $ENV{'DEBUG'} ? $TEST_ANSWER : `$cmd`;
176 0 0         if ($? == -1) {
    0          
    0          
177 0           Carp::croak("[photobear]", "Failed to execute: $!\n");
178             } elsif ($? & 127) {
179 0 0         Carp::croak("[photobear]", sprintf("Child died with signal %d, %s coredump\n"),
180             ($? & 127), ($? & 128) ? 'with' : 'without');
181             } elsif ($? >> 8) {
182 0           Carp::croak("[photobear]", sprintf("Child exited with value %d\n", $? >> 8));
183             }
184            
185 0           my $decoded_content = decode_json($output);
186 0           return $decoded_content;
187              
188             }
189              
190             sub download {
191 0     0 1   my ($url, $dest) = @_;
192             # Use curl
193 0           my $cmd = qq(curl -L -o "$dest" "$url");#
194            
195 0 0         if ($TESTMODE) {
196 0           return 1;
197             }
198 0           my $output = `$cmd`;
199 0 0         if ($? == -1) {
    0          
    0          
    0          
200 0           Carp::croak("[download] ", "Failed to execute: $!\n");
201             } elsif ($? & 127) {
202 0 0         Carp::croak("[download] ", sprintf("Child died with signal %d, %s coredump\n"),
203             ($? & 127), ($? & 128) ? 'with' : 'without');
204             } elsif ($? >> 8) {
205 0           Carp::croak("[download] ", sprintf("Child exited with value %d\n", $? >> 8));
206             } elsif ($? == 0) {
207 0           return 1;
208             } else {
209 0           return 0;
210             }
211              
212             }
213              
214             1;
215              
216             __END__