Bug 22200: (follow-up) Wrap accountline creation in a transaction
[koha.git] / Koha / SharedContent.pm
blob7145e950c3d54b4b48edcf5be9fc65b01e6a692a
1 package Koha::SharedContent;
3 # Copyright 2016 BibLibre Morgane Alonso
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 3 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 use Modern::Perl;
21 use JSON;
22 use HTTP::Request;
23 use LWP::UserAgent;
25 use Koha::Serials;
26 use Koha::Reports;
27 use C4::Context;
29 =head1 DESCRIPTION
31 Package for accessing shared content via Mana
33 =head2 Package Functions
35 =cut
37 =head3 process_request
39 =cut
41 sub process_request {
42 my $mana_request = shift;
43 my $result;
44 $mana_request->content_type('application/json');
45 my $userAgent = LWP::UserAgent->new;
46 if ( $mana_request->method eq "POST" ){
47 my $content;
48 if ($mana_request->content) {$content = from_json( $mana_request->content )};
49 $content->{securitytoken} = C4::Context->preference("ManaToken");
50 $mana_request->content( to_json($content) );
53 my $response = $userAgent->request($mana_request);
55 eval { $result = from_json( $response->decoded_content, { utf8 => 1} ); };
56 $result->{code} = $response->code;
57 if ( $@ ){
58 $result->{msg} = $@;
60 if ($response->is_error){
61 $result->{msg} = "An error occurred, mana server returned: " . $response->message;
63 return $result ;
66 =head3 increment_entity_value
68 =cut
70 sub increment_entity_value {
71 return process_request(build_request('increment', @_));
74 =head3 send_entity
76 =cut
78 sub send_entity {
79 my ($lang, $loggedinuser, $resourceid, $resourcetype, $content) = @_;
81 unless ( $content ) {
82 $content = prepare_entity_data($lang, $loggedinuser, $resourceid, $resourcetype);
85 my $result = process_request(build_request('post', $resourcetype, $content));
87 if ( $result and ($result->{code} eq "200" or $result->{code} eq "201") ) {
88 my $packages = "Koha::".ucfirst($resourcetype)."s";
89 my $resource = $packages->find($resourceid);
90 eval { $resource->set( { mana_id => $result->{id} } )->store };
92 return $result;
95 =head3 prepare_entity_data
97 =cut
99 sub prepare_entity_data {
100 my ($lang, $loggedinuser, $ressourceid, $ressourcetype) = @_;
101 $lang ||= C4::Context->preference('language');
103 my $mana_email;
104 if ( $loggedinuser ne 0 ) {
105 my $borrower = Koha::Patrons->find($loggedinuser);
106 $mana_email = $borrower->first_valid_email_address
107 || Koha::Libraries->find( C4::Context->userenv->{'branch'} )->branchemail
109 $mana_email = C4::Context->preference('KohaAdminEmailAddress')
110 if ( ( not defined($mana_email) ) or ( $mana_email eq '' ) );
112 my %versions = C4::Context::get_versions();
114 my $mana_info = {
115 language => $lang,
116 kohaversion => $versions{'kohaVersion'},
117 exportemail => $mana_email
120 my $ressource_mana_info;
121 my $packages = "Koha::".ucfirst($ressourcetype)."s";
122 my $package = "Koha::".ucfirst($ressourcetype);
123 $ressource_mana_info = $package->get_sharable_info($ressourceid);
124 $ressource_mana_info = { %$ressource_mana_info, %$mana_info };
126 return $ressource_mana_info;
129 =head3 get_entity_by_id
131 =cut
133 sub get_entity_by_id {
134 return process_request(build_request('getwithid', @_));
137 =head3 search_entities
139 =cut
141 sub search_entities {
142 return process_request(build_request('get', @_));
145 =head3 build_request
147 =cut
149 sub build_request {
150 my $type = shift;
151 my $resource = shift;
152 my $mana_url = get_sharing_url();
154 if ( $type eq 'get' ) {
155 my $params = shift;
156 $params = join '&',
157 map { defined $params->{$_} && $params->{$_} ne '' ? $_ . "=" . $params->{$_} : () }
158 keys %$params;
159 my $url = "$mana_url/$resource.json?$params";
160 return HTTP::Request->new( GET => $url );
163 if ( $type eq 'getwithid' ) {
164 my $id = shift;
165 my $params = shift;
166 $params = join '&',
167 map { defined $params->{$_} && $params->{$_} ne '' ? $_ . "=" . $params->{$_} : () }
168 keys %$params;
170 my $url = "$mana_url/$resource/$id.json?$params";
171 return HTTP::Request->new( GET => $url );
174 if ( $type eq 'post' ) {
175 my $content = shift;
177 my $url = "$mana_url/$resource.json";
178 my $request = HTTP::Request->new( POST => $url );
180 my $json = to_json( $content, { utf8 => 1 } );
181 $request->content($json);
183 return $request;
186 if ( $type eq 'increment' ) {
187 my $id = shift;
188 my $field = shift;
189 my $step = shift;
190 my $param;
192 $param->{step} = $step || 1;
193 $param->{id} = $id;
194 $param->{resource} = $resource;
195 $param = join '&',
196 map { defined $param->{$_} ? $_ . "=" . $param->{$_} : () }
197 keys %$param;
198 my $url = "$mana_url/$resource/$id.json/increment/$field?$param";
199 my $request = HTTP::Request->new( POST => $url );
204 =head3 get_sharing_url
206 =cut
208 sub get_sharing_url {
209 return C4::Context->config('mana_config');