1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
#
# Lightweight package to retrieve movie/tv programme data from The Movie Database (http://www.themoviedb.org/ )
#
# This is a custom version of the CPAN package :
# WWW::TMDB::API - TMDb API (http://api.themoviedb.org) client
# Version 0.04 (2012)
# Author Maria Celina Baratang, <maria at zambale.com>
# https://metacpan.org/pod/WWW::TMDB::API
#
# Modified for XMLTV use to
# - fix broken methods
# - add methods for TV programmes, and Configuration
# - 'version' changed to be 0.05
#
# Modifications: Geoff Westcott, December 2021
#
package XMLTV::TMDB::API;
# Package changes for XMLTV
# - add new namespace for package Tv.pm and Config.pm
# - remove ID= url parameter (since it's already added to the URL path)
# - add http response to return array
# - add 'soft' param to constructor to return http errors instead of carp
#
use 5.006;
use strict;
use warnings;
use Carp;
our $VERSION = '0.05';
use utf8;
use LWP::UserAgent;
use HTTP::Request;
use JSON;
use URI;
our @namespaces = qw( Person Movie Tv Config );
for (@namespaces) {
my $package = __PACKAGE__ . "::$_";
my $name = "\L$_";
eval qq(
use $package;
sub $name {
my \$self = shift;
if ( \$self->{'_$name'} ) {
return \$self->{'_$name'};
}else{
\$self->{'_$name'} = $package->new( api => \$self );
}
};
package $package;
sub api {
return shift->{api};
};
sub new {
my ( \$class, \%params ) = \@_;
my \$self = bless \\\%params, \$class;
\$self->{api} = \$params{api};
return \$self;
};
1;
);
croak "Cannot create namespace $name: $@\n" if $@;
}
sub send_api {
my ( $self, $command, $params_spec, $params ) = @_;
$self->check_parameters( $params_spec, $params );
my $url = $self->url( $command, $params );
my $request = HTTP::Request->new( GET => $url );
$request->header( 'Accept' => 'application/json' );
my $json_response = $self->{ua}->request($request);
if ( $json_response->is_success ) {
return [ decode_json( $json_response->content() ),
{ 'code' => $json_response->code(),
'msg' => $json_response->status_line,
'url' => $url
} ];
}
elsif ( $json_response->is_error && $self->{soft} ) {
return [ {}, { 'code' => $json_response->code(),
'msg' => $json_response->status_line,
'url' => $url
} ];
}
else {
croak
sprintf( "%s returned by %s", $json_response->status_line, $url );
}
}
# Checks items that will be sent to the API($input)
# $params - an array that identifies valid parameters
# example :
# {'ID' => 1 }, 1- field is required, 0- field is optional
sub check_parameters {
my $self = shift;
my ( $params, $input ) = @_;
foreach my $k ( keys(%$params) ) {
croak "Required parameter $k missing."
if ( $params->{$k} == 1 and !defined $input->{$k} );
}
foreach my $k ( keys(%$input) ) {
croak "Unknown parameter - $k." if ( !defined $params->{$k} );
}
}
sub url {
my $self = shift;
my ( $command, $params ) = @_;
my $url = new URI( $self->{url} );
$url->path_segments( $self->{ver}, @$command );
$params->{api_key} = $self->{api_key};
delete $params->{ID} if defined $params->{ID};
$url->query_form($params);
return $url->as_string();
}
sub new {
my $class = shift;
my (%params) = @_;
croak "Required parameter api_key not provided." unless $params{api_key};
if ( !defined $params{ua} ) {
$params{ua} =
LWP::UserAgent->new( 'agent' => "Perl-WWW-TMDB-API/$VERSION", );
}
else {
croak "LWP::UserAgent expected."
unless $params{ua}->isa('LWP::UserAgent');
}
my $self = {
api_key => $params{api_key},
ua => $params{ua},
ver => '3',
url => 'http://api.themoviedb.org',
soft => (defined $params{soft} ? $params{soft} : 0),
};
bless $self, $class;
return $self;
}
1; # End of XMLTV::TMDB::API
|
