|
Line 0
Link Here
|
|
|
1 |
package Koha::ILL::Backend::Standard; |
| 2 |
|
| 3 |
# Copyright PTFS Europe 2023 |
| 4 |
# |
| 5 |
# This file is part of Koha. |
| 6 |
# |
| 7 |
# Koha is free software; you can redistribute it and/or modify it |
| 8 |
# under the terms of the GNU General Public License as published by |
| 9 |
# the Free Software Foundation; either version 3 of the License, or |
| 10 |
# (at your option) any later version. |
| 11 |
# |
| 12 |
# Koha is distributed in the hope that it will be useful, but |
| 13 |
# WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 |
# GNU General Public License for more details. |
| 16 |
# |
| 17 |
# You should have received a copy of the GNU General Public License |
| 18 |
# along with Koha; if not, see <http://www.gnu.org/licenses>. |
| 19 |
|
| 20 |
use Modern::Perl; |
| 21 |
use DateTime; |
| 22 |
use File::Basename qw( dirname ); |
| 23 |
use C4::Installer; |
| 24 |
|
| 25 |
use Koha::ILL::Requests; |
| 26 |
use Koha::ILL::Request::Attribute; |
| 27 |
use C4::Biblio qw( AddBiblio ); |
| 28 |
use C4::Charset qw( MarcToUTF8Record ); |
| 29 |
|
| 30 |
=head1 NAME |
| 31 |
|
| 32 |
Koha::ILL::Backend::Standard - Koha ILL Backend: Standard |
| 33 |
|
| 34 |
=head1 SYNOPSIS |
| 35 |
|
| 36 |
Koha ILL implementation for the "Standard" backend . |
| 37 |
|
| 38 |
=head1 DESCRIPTION |
| 39 |
|
| 40 |
=head2 Overview |
| 41 |
|
| 42 |
We will be providing the Abstract interface which requires we implement the |
| 43 |
following methods: |
| 44 |
- create -> initial placement of the request for an ILL order |
| 45 |
- confirm -> confirm placement of the ILL order (No-op in Standard) |
| 46 |
- cancel -> request an already 'confirm'ed ILL order be cancelled |
| 47 |
- status_graph -> return a hashref of additional statuses |
| 48 |
- name -> return the name of this backend |
| 49 |
- metadata -> return mapping of fields from requestattributes |
| 50 |
|
| 51 |
=head2 On the Standard backend |
| 52 |
|
| 53 |
The Standard backend is a simple backend that is supposed to act as a |
| 54 |
fallback. It provides the end user with some mandatory fields in a form as |
| 55 |
well as the option to enter additional fields with arbitrary names & values. |
| 56 |
|
| 57 |
=head1 API |
| 58 |
|
| 59 |
=head2 Class Methods |
| 60 |
|
| 61 |
=cut |
| 62 |
|
| 63 |
=head3 new |
| 64 |
|
| 65 |
my $backend = Koha::ILL::Backend::Standard->new; |
| 66 |
|
| 67 |
=cut |
| 68 |
|
| 69 |
sub new { |
| 70 |
|
| 71 |
# -> instantiate the backend |
| 72 |
my ( $class, $other ) = @_; |
| 73 |
my $framework = |
| 74 |
defined $other->{config}->{configuration}->{raw_config}->{framework} |
| 75 |
? $other->{config}->{configuration}->{raw_config}->{framework} |
| 76 |
: 'FA'; |
| 77 |
my $self = { framework => $framework }; |
| 78 |
bless( $self, $class ); |
| 79 |
return $self; |
| 80 |
} |
| 81 |
|
| 82 |
=head3 name |
| 83 |
|
| 84 |
Return the name of this backend. |
| 85 |
|
| 86 |
=cut |
| 87 |
|
| 88 |
sub name { |
| 89 |
return "Standard"; |
| 90 |
} |
| 91 |
|
| 92 |
=head3 capabilities |
| 93 |
|
| 94 |
$capability = $backend->capabilities($name); |
| 95 |
|
| 96 |
Return the sub implementing a capability selected by NAME, or 0 if that |
| 97 |
capability is not implemented. |
| 98 |
|
| 99 |
=cut |
| 100 |
|
| 101 |
sub capabilities { |
| 102 |
my ( $self, $name ) = @_; |
| 103 |
my ($query) = @_; |
| 104 |
my $capabilities = { |
| 105 |
|
| 106 |
# Get the requested partner email address(es) |
| 107 |
get_requested_partners => sub { _get_requested_partners(@_); }, |
| 108 |
|
| 109 |
# Set the requested partner email address(es) |
| 110 |
set_requested_partners => sub { _set_requested_partners(@_); }, |
| 111 |
|
| 112 |
# Migrate |
| 113 |
migrate => sub { $self->migrate(@_); }, |
| 114 |
|
| 115 |
# Return whether we can create the request |
| 116 |
# i.e. the create form has been submitted |
| 117 |
can_create_request => sub { _can_create_request(@_) }, |
| 118 |
|
| 119 |
# This is required for compatibility |
| 120 |
# with Koha versions prior to bug 33716 |
| 121 |
should_display_availability => sub { _can_create_request(@_) }, |
| 122 |
|
| 123 |
# View and manage a request |
| 124 |
illview => sub { illview(@_); }, |
| 125 |
|
| 126 |
provides_batch_requests => sub { return 1; }, |
| 127 |
|
| 128 |
# We can create ILL requests with data passed from the API |
| 129 |
create_api => sub { $self->create_api(@_) } |
| 130 |
}; |
| 131 |
return $capabilities->{$name}; |
| 132 |
} |
| 133 |
|
| 134 |
=head3 metadata |
| 135 |
|
| 136 |
Return a hashref containing canonical values from the key/value |
| 137 |
illrequestattributes store. We may want to ignore certain values |
| 138 |
that we do not consider to be metadata |
| 139 |
|
| 140 |
=cut |
| 141 |
|
| 142 |
sub metadata { |
| 143 |
my ( $self, $request ) = @_; |
| 144 |
my $attrs = $request->illrequestattributes; |
| 145 |
my $metadata = {}; |
| 146 |
my @ignore = ( 'requested_partners', 'type', 'type_disclaimer_value', 'type_disclaimer_date' ); |
| 147 |
my $core_fields = _get_core_fields(); |
| 148 |
while ( my $attr = $attrs->next ) { |
| 149 |
my $type = $attr->type; |
| 150 |
if ( !grep { $_ eq $type } @ignore ) { |
| 151 |
my $name; |
| 152 |
$name = $core_fields->{$type} || ucfirst($type); |
| 153 |
$metadata->{$name} = $attr->value; |
| 154 |
} |
| 155 |
} |
| 156 |
return $metadata; |
| 157 |
} |
| 158 |
|
| 159 |
=head3 status_graph |
| 160 |
|
| 161 |
This backend provides no additional actions on top of the core_status_graph. |
| 162 |
|
| 163 |
=cut |
| 164 |
|
| 165 |
sub status_graph { |
| 166 |
return { |
| 167 |
MIG => { |
| 168 |
prev_actions => [ 'NEW', 'REQ', 'GENREQ', 'REQREV', 'QUEUED', 'CANCREQ', ], |
| 169 |
id => 'MIG', |
| 170 |
name => 'Switched provider', |
| 171 |
ui_method_name => 'Switch provider', |
| 172 |
method => 'migrate', |
| 173 |
next_actions => [], |
| 174 |
ui_method_icon => 'fa-search', |
| 175 |
}, |
| 176 |
EDITITEM => { |
| 177 |
prev_actions => ['NEW'], |
| 178 |
id => 'EDITITEM', |
| 179 |
name => 'Edited item metadata', |
| 180 |
ui_method_name => 'Edit item metadata', |
| 181 |
method => 'edititem', |
| 182 |
next_actions => [], |
| 183 |
ui_method_icon => 'fa-edit', |
| 184 |
}, |
| 185 |
|
| 186 |
}; |
| 187 |
} |
| 188 |
|
| 189 |
=head3 create |
| 190 |
|
| 191 |
my $response = $backend->create({ params => $params }); |
| 192 |
|
| 193 |
We just want to generate a form that allows the end-user to associate key |
| 194 |
value pairs in the database. |
| 195 |
|
| 196 |
=cut |
| 197 |
|
| 198 |
sub create { |
| 199 |
my ( $self, $params ) = @_; |
| 200 |
my $other = $params->{other}; |
| 201 |
my $stage = $other->{stage}; |
| 202 |
my $core_fields = _get_core_string(); |
| 203 |
if ( !$stage || $stage eq 'init' ) { |
| 204 |
|
| 205 |
# First thing we want to do, is check if we're receiving |
| 206 |
# an OpenURL and transform it into something we can |
| 207 |
# understand |
| 208 |
if ( $other->{openurl} ) { |
| 209 |
|
| 210 |
# We only want to transform once |
| 211 |
delete $other->{openurl}; |
| 212 |
$params = _openurl_to_ill($params); |
| 213 |
} |
| 214 |
|
| 215 |
# We simply need our template .INC to produce a form. |
| 216 |
return { |
| 217 |
cwd => dirname(__FILE__), |
| 218 |
error => 0, |
| 219 |
status => '', |
| 220 |
message => '', |
| 221 |
method => 'create', |
| 222 |
stage => 'form', |
| 223 |
value => $params, |
| 224 |
core => $core_fields |
| 225 |
}; |
| 226 |
} elsif ( $stage eq 'form' ) { |
| 227 |
|
| 228 |
# We may be recieving a submitted form due to an additional |
| 229 |
# custom field being added or deleted, or the material type |
| 230 |
# having been changed, so check for these things |
| 231 |
if ( !_can_create_request($other) ) { |
| 232 |
if ( defined $other->{'add_new_custom'} ) { |
| 233 |
my ( $custom_keys, $custom_vals ) = |
| 234 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 235 |
push @{$custom_keys}, '---'; |
| 236 |
push @{$custom_vals}, '---'; |
| 237 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 238 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 239 |
} elsif ( defined $other->{'custom_delete'} ) { |
| 240 |
my $delete_idx = $other->{'custom_delete'}; |
| 241 |
my ( $custom_keys, $custom_vals ) = |
| 242 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 243 |
splice @{$custom_keys}, $delete_idx, 1; |
| 244 |
splice @{$custom_vals}, $delete_idx, 1; |
| 245 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 246 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 247 |
} elsif ( defined $other->{'change_type'} ) { |
| 248 |
|
| 249 |
# We may be receiving a submitted form due to the user having |
| 250 |
# changed request material type, so we just need to go straight |
| 251 |
# back to the form, the type has been changed in the params |
| 252 |
delete $other->{'change_type'}; |
| 253 |
} |
| 254 |
return { |
| 255 |
cwd => dirname(__FILE__), |
| 256 |
status => "", |
| 257 |
message => "", |
| 258 |
error => 0, |
| 259 |
value => $params, |
| 260 |
method => "create", |
| 261 |
stage => "form", |
| 262 |
core => $core_fields |
| 263 |
}; |
| 264 |
} |
| 265 |
|
| 266 |
# Received completed details of form. Validate and create request. |
| 267 |
## Validate |
| 268 |
my ( $brw_count, $brw ) = |
| 269 |
_validate_borrower( $other->{'cardnumber'} ); |
| 270 |
my $result = { |
| 271 |
cwd => dirname(__FILE__), |
| 272 |
status => "", |
| 273 |
message => "", |
| 274 |
error => 1, |
| 275 |
value => {}, |
| 276 |
method => "create", |
| 277 |
stage => "form", |
| 278 |
core => $core_fields |
| 279 |
}; |
| 280 |
my $failed = 0; |
| 281 |
if ( !$other->{'type'} ) { |
| 282 |
$result->{status} = "missing_type"; |
| 283 |
$result->{value} = $params; |
| 284 |
$failed = 1; |
| 285 |
} elsif ( !$other->{'branchcode'} ) { |
| 286 |
$result->{status} = "missing_branch"; |
| 287 |
$result->{value} = $params; |
| 288 |
$failed = 1; |
| 289 |
} elsif ( !Koha::Libraries->find( $other->{'branchcode'} ) ) { |
| 290 |
$result->{status} = "invalid_branch"; |
| 291 |
$result->{value} = $params; |
| 292 |
$failed = 1; |
| 293 |
} elsif ( $brw_count == 0 ) { |
| 294 |
$result->{status} = "invalid_borrower"; |
| 295 |
$result->{value} = $params; |
| 296 |
$failed = 1; |
| 297 |
} elsif ( $brw_count > 1 ) { |
| 298 |
|
| 299 |
# We must select a specific borrower out of our options. |
| 300 |
$params->{brw} = $brw; |
| 301 |
$result->{value} = $params; |
| 302 |
$result->{stage} = "borrowers"; |
| 303 |
$result->{error} = 0; |
| 304 |
$failed = 1; |
| 305 |
} |
| 306 |
return $result if $failed; |
| 307 |
|
| 308 |
$self->add_request( { request => $params->{request}, other => $other } ); |
| 309 |
|
| 310 |
my $request_details = _get_request_details( $params, $other ); |
| 311 |
|
| 312 |
## -> create response. |
| 313 |
return { |
| 314 |
cwd => dirname(__FILE__), |
| 315 |
error => 0, |
| 316 |
status => '', |
| 317 |
message => '', |
| 318 |
method => 'create', |
| 319 |
stage => 'commit', |
| 320 |
next => 'illview', |
| 321 |
value => $request_details, |
| 322 |
core => $core_fields |
| 323 |
}; |
| 324 |
} else { |
| 325 |
|
| 326 |
# Invalid stage, return error. |
| 327 |
return { |
| 328 |
cwd => dirname(__FILE__), |
| 329 |
error => 1, |
| 330 |
status => 'unknown_stage', |
| 331 |
message => '', |
| 332 |
method => 'create', |
| 333 |
stage => $params->{stage}, |
| 334 |
value => {}, |
| 335 |
}; |
| 336 |
} |
| 337 |
} |
| 338 |
|
| 339 |
=head3 edititem |
| 340 |
|
| 341 |
=cut |
| 342 |
|
| 343 |
sub edititem { |
| 344 |
my ( $self, $params ) = @_; |
| 345 |
|
| 346 |
my $core = _get_core_fields(); |
| 347 |
my $core_fields = _get_core_string(); |
| 348 |
|
| 349 |
# Don't allow editing of submitted requests |
| 350 |
return { method => 'illlist' } if $params->{request}->status ne 'NEW'; |
| 351 |
|
| 352 |
my $other = $params->{other}; |
| 353 |
my $stage = $other->{stage}; |
| 354 |
if ( !$stage || $stage eq 'init' ) { |
| 355 |
|
| 356 |
my $attrs = $params->{request}->illrequestattributes->unblessed; |
| 357 |
|
| 358 |
# We need to identify which parameters are custom, and pass them |
| 359 |
# to the template in a predefined form |
| 360 |
my $custom_keys = []; |
| 361 |
my $custom_vals = []; |
| 362 |
foreach my $attr ( @{$attrs} ) { |
| 363 |
if ( !$core->{ $attr->{type} } ) { |
| 364 |
push @{$custom_keys}, $attr->{type}; |
| 365 |
push @{$custom_vals}, $attr->{value}; |
| 366 |
} else { |
| 367 |
$other->{ $attr->{type} } = $attr->{value}; |
| 368 |
} |
| 369 |
} |
| 370 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 371 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 372 |
|
| 373 |
# Pass everything back to the template |
| 374 |
return { |
| 375 |
cwd => dirname(__FILE__), |
| 376 |
error => 0, |
| 377 |
status => '', |
| 378 |
message => '', |
| 379 |
method => 'edititem', |
| 380 |
stage => 'form', |
| 381 |
value => $params, |
| 382 |
core => $core_fields |
| 383 |
}; |
| 384 |
} elsif ( $stage eq 'form' ) { |
| 385 |
|
| 386 |
# We may be recieving a submitted form due to an additional |
| 387 |
# custom field being added or deleted, or the material type |
| 388 |
# having been changed, so check for these things |
| 389 |
if ( defined $other->{'add_new_custom'} |
| 390 |
|| defined $other->{'custom_delete'} |
| 391 |
|| defined $other->{'change_type'} ) |
| 392 |
{ |
| 393 |
if ( defined $other->{'add_new_custom'} ) { |
| 394 |
my ( $custom_keys, $custom_vals ) = |
| 395 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 396 |
push @{$custom_keys}, '---'; |
| 397 |
push @{$custom_vals}, '---'; |
| 398 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 399 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 400 |
} elsif ( defined $other->{'custom_delete'} ) { |
| 401 |
my $delete_idx = $other->{'custom_delete'}; |
| 402 |
my ( $custom_keys, $custom_vals ) = |
| 403 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 404 |
splice @{$custom_keys}, $delete_idx, 1; |
| 405 |
splice @{$custom_vals}, $delete_idx, 1; |
| 406 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 407 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 408 |
} elsif ( defined $other->{'change_type'} ) { |
| 409 |
|
| 410 |
# We may be receiving a submitted form due to the user having |
| 411 |
# changed request material type, so we just need to go straight |
| 412 |
# back to the form, the type has been changed in the params |
| 413 |
delete $other->{'change_type'}; |
| 414 |
} |
| 415 |
return { |
| 416 |
cwd => dirname(__FILE__), |
| 417 |
status => "", |
| 418 |
message => "", |
| 419 |
error => 0, |
| 420 |
value => $params, |
| 421 |
method => "edititem", |
| 422 |
stage => "form", |
| 423 |
core => $core_fields |
| 424 |
}; |
| 425 |
} |
| 426 |
|
| 427 |
# We don't want the request ID param getting any further |
| 428 |
delete $other->{illrequest_id}; |
| 429 |
|
| 430 |
my $result = { |
| 431 |
cwd => dirname(__FILE__), |
| 432 |
status => "", |
| 433 |
message => "", |
| 434 |
error => 1, |
| 435 |
value => {}, |
| 436 |
method => "edititem", |
| 437 |
stage => "form", |
| 438 |
core => $core_fields |
| 439 |
}; |
| 440 |
|
| 441 |
# Received completed details of form. Validate and create request. |
| 442 |
## Validate |
| 443 |
my $failed = 0; |
| 444 |
if ( !$other->{'type'} ) { |
| 445 |
$result->{status} = "missing_type"; |
| 446 |
$result->{value} = $params; |
| 447 |
$failed = 1; |
| 448 |
} |
| 449 |
return $result if $failed; |
| 450 |
|
| 451 |
## Update request |
| 452 |
|
| 453 |
# ...Update Illrequest |
| 454 |
my $request = $params->{request}; |
| 455 |
$request->updated( DateTime->now ); |
| 456 |
$request->store; |
| 457 |
|
| 458 |
# ...Populate Illrequestattributes |
| 459 |
# generate $request_details |
| 460 |
my $request_details = _get_request_details( $params, $other ); |
| 461 |
|
| 462 |
# We do this with a 'dump all and repopulate approach' inside |
| 463 |
# a transaction, easier than catering for create, update & delete |
| 464 |
my $dbh = C4::Context->dbh; |
| 465 |
my $schema = Koha::Database->new->schema; |
| 466 |
$schema->txn_do( |
| 467 |
sub { |
| 468 |
# Delete all existing attributes for this request |
| 469 |
$dbh->do( |
| 470 |
q| |
| 471 |
DELETE FROM illrequestattributes WHERE illrequest_id=? |
| 472 |
|, undef, $request->id |
| 473 |
); |
| 474 |
|
| 475 |
# Insert all current attributes for this request |
| 476 |
foreach my $attr ( keys %{$request_details} ) { |
| 477 |
my $value = $request_details->{$attr}; |
| 478 |
if ( $value && length $value > 0 ) { |
| 479 |
if ( column_exists( 'illrequestattributes', 'backend' ) ) { |
| 480 |
my @bind = ( $request->id, 'Standard', $attr, $value, 0 ); |
| 481 |
$dbh->do( |
| 482 |
q| |
| 483 |
INSERT INTO illrequestattributes |
| 484 |
(illrequest_id, backend, type, value, readonly) VALUES |
| 485 |
(?, ?, ?, ?, ?) |
| 486 |
|, undef, @bind |
| 487 |
); |
| 488 |
} else { |
| 489 |
my @bind = ( $request->id, $attr, $value, 0 ); |
| 490 |
$dbh->do( |
| 491 |
q| |
| 492 |
INSERT INTO illrequestattributes |
| 493 |
(illrequest_id, type, value, readonly) VALUES |
| 494 |
(?, ?, ?, ?) |
| 495 |
|, undef, @bind |
| 496 |
); |
| 497 |
} |
| 498 |
} |
| 499 |
} |
| 500 |
} |
| 501 |
); |
| 502 |
|
| 503 |
## -> create response. |
| 504 |
return { |
| 505 |
error => 0, |
| 506 |
status => '', |
| 507 |
message => '', |
| 508 |
method => 'create', |
| 509 |
stage => 'commit', |
| 510 |
next => 'illview', |
| 511 |
value => $request_details, |
| 512 |
core => $core_fields |
| 513 |
}; |
| 514 |
} else { |
| 515 |
|
| 516 |
# Invalid stage, return error. |
| 517 |
return { |
| 518 |
error => 1, |
| 519 |
status => 'unknown_stage', |
| 520 |
message => '', |
| 521 |
method => 'create', |
| 522 |
stage => $params->{stage}, |
| 523 |
value => {}, |
| 524 |
}; |
| 525 |
} |
| 526 |
} |
| 527 |
|
| 528 |
=head3 confirm |
| 529 |
|
| 530 |
my $response = $backend->confirm({ params => $params }); |
| 531 |
|
| 532 |
Confirm the placement of the previously "selected" request (by using the |
| 533 |
'create' method). |
| 534 |
|
| 535 |
In the Standard backend we only want to display a bit of text to let staff |
| 536 |
confirm that they have taken the steps they need to take to "confirm" the |
| 537 |
request. |
| 538 |
|
| 539 |
=cut |
| 540 |
|
| 541 |
sub confirm { |
| 542 |
my ( $self, $params ) = @_; |
| 543 |
my $stage = $params->{other}->{stage}; |
| 544 |
if ( !$stage || $stage eq 'init' ) { |
| 545 |
|
| 546 |
# We simply need our template .INC to produce a text block. |
| 547 |
return { |
| 548 |
method => 'confirm', |
| 549 |
stage => 'confirm', |
| 550 |
value => $params, |
| 551 |
}; |
| 552 |
} elsif ( $stage eq 'confirm' ) { |
| 553 |
my $request = $params->{request}; |
| 554 |
$request->orderid( $request->illrequest_id ); |
| 555 |
$request->status("REQ"); |
| 556 |
$request->store; |
| 557 |
|
| 558 |
# ...then return our result: |
| 559 |
return { |
| 560 |
method => 'confirm', |
| 561 |
stage => 'commit', |
| 562 |
next => 'illview', |
| 563 |
value => {}, |
| 564 |
}; |
| 565 |
} else { |
| 566 |
|
| 567 |
# Invalid stage, return error. |
| 568 |
return { |
| 569 |
error => 1, |
| 570 |
status => 'unknown_stage', |
| 571 |
message => '', |
| 572 |
method => 'confirm', |
| 573 |
stage => $params->{stage}, |
| 574 |
value => {}, |
| 575 |
}; |
| 576 |
} |
| 577 |
} |
| 578 |
|
| 579 |
=head3 cancel |
| 580 |
|
| 581 |
my $response = $backend->cancel({ params => $params }); |
| 582 |
|
| 583 |
We will attempt to cancel a request that was confirmed. |
| 584 |
|
| 585 |
In the Standard backend this simply means displaying text to the librarian |
| 586 |
asking them to confirm they have taken all steps needed to cancel a confirmed |
| 587 |
request. |
| 588 |
|
| 589 |
=cut |
| 590 |
|
| 591 |
sub cancel { |
| 592 |
my ( $self, $params ) = @_; |
| 593 |
my $stage = $params->{other}->{stage}; |
| 594 |
if ( !$stage || $stage eq 'init' ) { |
| 595 |
|
| 596 |
# We simply need our template .INC to produce a text block. |
| 597 |
return { |
| 598 |
method => 'cancel', |
| 599 |
stage => 'confirm', |
| 600 |
value => $params, |
| 601 |
}; |
| 602 |
} elsif ( $stage eq 'confirm' ) { |
| 603 |
$params->{request}->status("REQREV"); |
| 604 |
$params->{request}->orderid(undef); |
| 605 |
$params->{request}->store; |
| 606 |
return { |
| 607 |
method => 'cancel', |
| 608 |
stage => 'commit', |
| 609 |
next => 'illview', |
| 610 |
value => $params, |
| 611 |
}; |
| 612 |
} else { |
| 613 |
|
| 614 |
# Invalid stage, return error. |
| 615 |
return { |
| 616 |
error => 1, |
| 617 |
status => 'unknown_stage', |
| 618 |
message => '', |
| 619 |
method => 'cancel', |
| 620 |
stage => $params->{stage}, |
| 621 |
value => {}, |
| 622 |
}; |
| 623 |
} |
| 624 |
} |
| 625 |
|
| 626 |
=head3 migrate |
| 627 |
|
| 628 |
Migrate a request into or out of this backend. |
| 629 |
|
| 630 |
=cut |
| 631 |
|
| 632 |
sub migrate { |
| 633 |
my ( $self, $params ) = @_; |
| 634 |
my $other = $params->{other}; |
| 635 |
|
| 636 |
my $stage = $other->{stage}; |
| 637 |
my $step = $other->{step}; |
| 638 |
|
| 639 |
my $core_fields = _get_core_string(); |
| 640 |
|
| 641 |
# We may be recieving a submitted form due to an additional |
| 642 |
# custom field being added or deleted, or the material type |
| 643 |
# having been changed, so check for these things |
| 644 |
if ( defined $other->{'add_new_custom'} |
| 645 |
|| defined $other->{'custom_delete'} |
| 646 |
|| defined $other->{'change_type'} ) |
| 647 |
{ |
| 648 |
if ( defined $other->{'add_new_custom'} ) { |
| 649 |
my ( $custom_keys, $custom_vals ) = |
| 650 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 651 |
push @{$custom_keys}, '---'; |
| 652 |
push @{$custom_vals}, '---'; |
| 653 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 654 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 655 |
} elsif ( defined $other->{'custom_delete'} ) { |
| 656 |
my $delete_idx = $other->{'custom_delete'}; |
| 657 |
my ( $custom_keys, $custom_vals ) = |
| 658 |
_get_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 659 |
splice @{$custom_keys}, $delete_idx, 1; |
| 660 |
splice @{$custom_vals}, $delete_idx, 1; |
| 661 |
$other->{'custom_key'} = join "\0", @{$custom_keys}; |
| 662 |
$other->{'custom_value'} = join "\0", @{$custom_vals}; |
| 663 |
} elsif ( defined $other->{'change_type'} ) { |
| 664 |
|
| 665 |
# We may be receiving a submitted form due to the user having |
| 666 |
# changed request material type, so we just need to go straight |
| 667 |
# back to the form, the type has been changed in the params |
| 668 |
delete $other->{'change_type'}; |
| 669 |
} |
| 670 |
return { |
| 671 |
cwd => dirname(__FILE__), |
| 672 |
status => "", |
| 673 |
message => "", |
| 674 |
error => 0, |
| 675 |
value => $params, |
| 676 |
method => "create", |
| 677 |
stage => "form", |
| 678 |
core => $core_fields |
| 679 |
}; |
| 680 |
} |
| 681 |
|
| 682 |
# Recieve a new request from another backend and suppliment it with |
| 683 |
# anything we require specifically for this backend. |
| 684 |
if ( !$stage || $stage eq 'immigrate' ) { |
| 685 |
my $original_request = Koha::ILL::Requests->find( $other->{illrequest_id} ); |
| 686 |
my $new_request = $params->{request}; |
| 687 |
$new_request->borrowernumber( $original_request->borrowernumber ); |
| 688 |
$new_request->branchcode( $original_request->branchcode ); |
| 689 |
$new_request->status('NEW'); |
| 690 |
$new_request->backend( $self->name ); |
| 691 |
$new_request->placed( DateTime->now ); |
| 692 |
$new_request->updated( DateTime->now ); |
| 693 |
$new_request->store; |
| 694 |
|
| 695 |
my @default_attributes = (qw/title type author year volume isbn issn article_title article_author pages/); |
| 696 |
my $original_attributes = |
| 697 |
$original_request->illrequestattributes->search( { type => { '-in' => \@default_attributes } } ); |
| 698 |
|
| 699 |
my $request_details = |
| 700 |
{ map { $_->type => $_->value } ( $original_attributes->as_list ) }; |
| 701 |
$request_details->{migrated_from} = $original_request->illrequest_id; |
| 702 |
while ( my ( $type, $value ) = each %{$request_details} ) { |
| 703 |
Koha::ILL::Request::Attribute->new( |
| 704 |
{ |
| 705 |
illrequest_id => $new_request->illrequest_id, |
| 706 |
column_exists( 'illrequestattributes', 'backend' ) ? ( backend => "Standard" ) : (), |
| 707 |
type => $type, |
| 708 |
value => $value, |
| 709 |
} |
| 710 |
)->store; |
| 711 |
} |
| 712 |
|
| 713 |
return { |
| 714 |
error => 0, |
| 715 |
status => '', |
| 716 |
message => '', |
| 717 |
method => 'migrate', |
| 718 |
stage => 'commit', |
| 719 |
next => 'emigrate', |
| 720 |
value => $params, |
| 721 |
core => $core_fields |
| 722 |
}; |
| 723 |
} |
| 724 |
|
| 725 |
# Cleanup any outstanding work, close the request. |
| 726 |
elsif ( $stage eq 'emigrate' ) { |
| 727 |
my $new_request = $params->{request}; |
| 728 |
my $from_id = $new_request->illrequestattributes->find( { type => 'migrated_from' } )->value; |
| 729 |
my $request = Koha::ILL::Requests->find($from_id); |
| 730 |
|
| 731 |
# Just cancel the original request now it's been migrated away |
| 732 |
$request->status("REQREV"); |
| 733 |
$request->orderid(undef); |
| 734 |
$request->store; |
| 735 |
|
| 736 |
return { |
| 737 |
error => 0, |
| 738 |
status => '', |
| 739 |
message => '', |
| 740 |
method => 'migrate', |
| 741 |
stage => 'commit', |
| 742 |
next => 'illview', |
| 743 |
value => $params, |
| 744 |
core => $core_fields |
| 745 |
}; |
| 746 |
} |
| 747 |
} |
| 748 |
|
| 749 |
=head3 illview |
| 750 |
|
| 751 |
View and manage an ILL request |
| 752 |
|
| 753 |
=cut |
| 754 |
|
| 755 |
sub illview { |
| 756 |
my ( $self, $params ) = @_; |
| 757 |
|
| 758 |
return { method => "illview" }; |
| 759 |
} |
| 760 |
|
| 761 |
## Helpers |
| 762 |
|
| 763 |
=head3 _get_requested_partners |
| 764 |
|
| 765 |
=cut |
| 766 |
|
| 767 |
sub _get_requested_partners { |
| 768 |
|
| 769 |
# Take a request and retrieve an Illrequestattribute with |
| 770 |
# the type 'requested_partners'. |
| 771 |
my ($args) = @_; |
| 772 |
my $where = { |
| 773 |
illrequest_id => $args->{request}->id, |
| 774 |
type => 'requested_partners' |
| 775 |
}; |
| 776 |
my $res = Koha::ILL::Request::Attributes->find($where); |
| 777 |
return ($res) ? $res->value : undef; |
| 778 |
} |
| 779 |
|
| 780 |
=head3 _set_requested_partners |
| 781 |
|
| 782 |
=cut |
| 783 |
|
| 784 |
sub _set_requested_partners { |
| 785 |
|
| 786 |
# Take a request and set an Illrequestattribute on it |
| 787 |
# detailing the email address(es) of the requested |
| 788 |
# partner(s). We replace any existing value since, by |
| 789 |
# the time we get to this stage, any previous request |
| 790 |
# from partners would have had to be cancelled |
| 791 |
my ($args) = @_; |
| 792 |
my $where = { |
| 793 |
illrequest_id => $args->{request}->id, |
| 794 |
type => 'requested_partners' |
| 795 |
}; |
| 796 |
Koha::ILL::Request::Attributes->search($where)->delete(); |
| 797 |
Koha::ILL::Request::Attributes->new( |
| 798 |
{ |
| 799 |
illrequest_id => $args->{request}->id, |
| 800 |
column_exists( 'illrequestattributes', 'backend' ) ? ( backend => "Standard" ) : (), |
| 801 |
type => 'requested_partners', |
| 802 |
value => $args->{to} |
| 803 |
} |
| 804 |
)->store; |
| 805 |
} |
| 806 |
|
| 807 |
=head3 _validate_borrower |
| 808 |
|
| 809 |
=cut |
| 810 |
|
| 811 |
sub _validate_borrower { |
| 812 |
|
| 813 |
# Perform cardnumber search. If no results, perform surname search. |
| 814 |
# Return ( 0, undef ), ( 1, $brw ) or ( n, $brws ) |
| 815 |
my ($input) = @_; |
| 816 |
my $patrons = Koha::Patrons->new; |
| 817 |
my ( $count, $brw ); |
| 818 |
my $query = { cardnumber => $input }; |
| 819 |
|
| 820 |
my $brws = $patrons->search($query); |
| 821 |
$count = $brws->count; |
| 822 |
my @criteria = qw/ surname userid firstname end /; |
| 823 |
while ( $count == 0 ) { |
| 824 |
my $criterium = shift @criteria; |
| 825 |
return ( 0, undef ) if ( "end" eq $criterium ); |
| 826 |
$brws = $patrons->search( { $criterium => $input } ); |
| 827 |
$count = $brws->count; |
| 828 |
} |
| 829 |
if ( $count == 1 ) { |
| 830 |
$brw = $brws->next; |
| 831 |
} else { |
| 832 |
$brw = $brws; # found multiple results |
| 833 |
} |
| 834 |
return ( $count, $brw ); |
| 835 |
} |
| 836 |
|
| 837 |
=head3 _get_custom |
| 838 |
|
| 839 |
=cut |
| 840 |
|
| 841 |
sub _get_custom { |
| 842 |
|
| 843 |
# Take an string of custom keys and an string |
| 844 |
# of custom values, both delimited by \0 (by CGI) |
| 845 |
# and return an arrayref of each |
| 846 |
my ( $keys, $values ) = @_; |
| 847 |
my @k = defined $keys ? split( "\0", $keys ) : (); |
| 848 |
my @v = defined $values ? split( "\0", $values ) : (); |
| 849 |
return ( \@k, \@v ); |
| 850 |
} |
| 851 |
|
| 852 |
=head3 _prepare_custom |
| 853 |
|
| 854 |
=cut |
| 855 |
|
| 856 |
sub _prepare_custom { |
| 857 |
|
| 858 |
# Take an arrayref of custom keys and an arrayref |
| 859 |
# of custom values, return a hashref of them |
| 860 |
my ( $keys, $values ) = @_; |
| 861 |
my %out = (); |
| 862 |
if ($keys) { |
| 863 |
my @k = split( "\0", $keys ); |
| 864 |
my @v = split( "\0", $values ); |
| 865 |
%out = map { $k[$_] => $v[$_] } 0 .. $#k; |
| 866 |
} |
| 867 |
return \%out; |
| 868 |
} |
| 869 |
|
| 870 |
=head3 _get_request_details |
| 871 |
|
| 872 |
my $request_details = _get_request_details($params, $other); |
| 873 |
|
| 874 |
Return the illrequestattributes for a given request |
| 875 |
|
| 876 |
=cut |
| 877 |
|
| 878 |
sub _get_request_details { |
| 879 |
my ( $params, $other ) = @_; |
| 880 |
|
| 881 |
# Get custom key / values we've been passed |
| 882 |
# Prepare them for addition into the Illrequestattribute object |
| 883 |
my $custom = |
| 884 |
_prepare_custom( $other->{'custom_key'}, $other->{'custom_value'} ); |
| 885 |
|
| 886 |
my $return = {%$custom}; |
| 887 |
my $core = _get_core_fields(); |
| 888 |
foreach my $key ( keys %{$core} ) { |
| 889 |
$return->{$key} = $params->{other}->{$key}; |
| 890 |
} |
| 891 |
|
| 892 |
return $return; |
| 893 |
} |
| 894 |
|
| 895 |
=head3 _get_core_string |
| 896 |
|
| 897 |
Return a comma delimited, quoted, string of core field keys |
| 898 |
|
| 899 |
=cut |
| 900 |
|
| 901 |
sub _get_core_string { |
| 902 |
my $core = _get_core_fields(); |
| 903 |
return join( ",", map { '"' . $_ . '"' } keys %{$core} ); |
| 904 |
} |
| 905 |
|
| 906 |
=head3 _get_core_fields |
| 907 |
|
| 908 |
Return a hashref of core fields |
| 909 |
|
| 910 |
=cut |
| 911 |
|
| 912 |
sub _get_core_fields { |
| 913 |
return { |
| 914 |
article_author => 'Article author', |
| 915 |
article_title => 'Article title', |
| 916 |
associated_id => 'Associated ID', |
| 917 |
author => 'Author', |
| 918 |
chapter_author => 'Chapter author', |
| 919 |
chapter => 'Chapter', |
| 920 |
conference_date => 'Conference date', |
| 921 |
doi => 'DOI', |
| 922 |
editor => 'Editor', |
| 923 |
institution => 'Institution', |
| 924 |
isbn => 'ISBN', |
| 925 |
issn => 'ISSN', |
| 926 |
issue => 'Issue', |
| 927 |
item_date => 'Date', |
| 928 |
pages => 'Pages', |
| 929 |
pagination => 'Pagination', |
| 930 |
paper_author => 'Paper author', |
| 931 |
paper_title => 'Paper title', |
| 932 |
part_edition => 'Part / Edition', |
| 933 |
publication => 'Publication', |
| 934 |
published_date => 'Publication date', |
| 935 |
published_place => 'Place of publication', |
| 936 |
publisher => 'Publisher', |
| 937 |
sponsor => 'Sponsor', |
| 938 |
title => 'Title', |
| 939 |
type => 'Type', |
| 940 |
venue => 'Venue', |
| 941 |
volume => 'Volume', |
| 942 |
year => 'Year' |
| 943 |
}; |
| 944 |
} |
| 945 |
|
| 946 |
=head3 add_request |
| 947 |
|
| 948 |
Add an ILL request |
| 949 |
|
| 950 |
=cut |
| 951 |
|
| 952 |
sub add_request { |
| 953 |
|
| 954 |
my ( $self, $params ) = @_; |
| 955 |
|
| 956 |
# ...Populate Illrequestattributes |
| 957 |
# generate $request_details |
| 958 |
my $request_details = _get_request_details( $params, $params->{other} ); |
| 959 |
|
| 960 |
my ( $brw_count, $brw ) = |
| 961 |
_validate_borrower( $params->{other}->{'cardnumber'} ); |
| 962 |
|
| 963 |
## Create request |
| 964 |
|
| 965 |
# Create bib record |
| 966 |
my $biblionumber = $self->_standard_request2biblio($request_details); |
| 967 |
|
| 968 |
# ...Populate Illrequest |
| 969 |
my $request = $params->{request}; |
| 970 |
$request->biblio_id($biblionumber) unless $biblionumber == 0; |
| 971 |
$request->borrowernumber( $brw->borrowernumber ); |
| 972 |
$request->branchcode( $params->{other}->{branchcode} ); |
| 973 |
$request->status('NEW'); |
| 974 |
$request->backend( $params->{other}->{backend} ); |
| 975 |
$request->placed( DateTime->now ); |
| 976 |
$request->updated( DateTime->now ); |
| 977 |
$request->batch_id( |
| 978 |
$params->{other}->{ill_batch_id} ? $params->{other}->{ill_batch_id} : $params->{other}->{batch_id} ) |
| 979 |
if column_exists( 'illrequests', 'batch_id' ); |
| 980 |
$request->store; |
| 981 |
|
| 982 |
while ( my ( $type, $value ) = each %{$request_details} ) { |
| 983 |
if ( $value && length $value > 0 ) { |
| 984 |
Koha::ILL::Request::Attribute->new( |
| 985 |
{ |
| 986 |
illrequest_id => $request->illrequest_id, |
| 987 |
column_exists( 'illrequestattributes', 'backend' ) ? ( backend => "Standard" ) : (), |
| 988 |
type => $type, |
| 989 |
value => $value, |
| 990 |
readonly => 0 |
| 991 |
} |
| 992 |
)->store; |
| 993 |
} |
| 994 |
} |
| 995 |
|
| 996 |
return $request; |
| 997 |
} |
| 998 |
|
| 999 |
=head3 _openurl_to_ill |
| 1000 |
|
| 1001 |
Take a hashref of OpenURL parameters and return |
| 1002 |
those same parameters but transformed to the ILL |
| 1003 |
schema |
| 1004 |
|
| 1005 |
=cut |
| 1006 |
|
| 1007 |
sub _openurl_to_ill { |
| 1008 |
my ($params) = @_; |
| 1009 |
|
| 1010 |
# Parameters to not place in our custom |
| 1011 |
# parameters arrays |
| 1012 |
my $ignore = { |
| 1013 |
openurl => 1, |
| 1014 |
backend => 1, |
| 1015 |
method => 1, |
| 1016 |
opac => 1, |
| 1017 |
cardnumber => 1, |
| 1018 |
branchcode => 1, |
| 1019 |
userid => 1, |
| 1020 |
password => 1, |
| 1021 |
koha_login_context => 1, |
| 1022 |
stage => 1 |
| 1023 |
}; |
| 1024 |
|
| 1025 |
my $transform_metadata = { |
| 1026 |
genre => 'type', |
| 1027 |
content => 'type', |
| 1028 |
format => 'type', |
| 1029 |
atitle => 'article_title', |
| 1030 |
aulast => 'author', |
| 1031 |
author => 'author', |
| 1032 |
date => 'year', |
| 1033 |
issue => 'issue', |
| 1034 |
volume => 'volume', |
| 1035 |
isbn => 'isbn', |
| 1036 |
issn => 'issn', |
| 1037 |
rft_id => 'doi', |
| 1038 |
year => 'year', |
| 1039 |
title => 'title', |
| 1040 |
author => 'author', |
| 1041 |
aulast => 'article_author', |
| 1042 |
pages => 'pages', |
| 1043 |
ctitle => 'chapter', |
| 1044 |
clast => 'chapter_author' |
| 1045 |
}; |
| 1046 |
|
| 1047 |
my $transform_value = { |
| 1048 |
type => { |
| 1049 |
fulltext => 'article', |
| 1050 |
selectedft => 'article', |
| 1051 |
print => 'book', |
| 1052 |
ebook => 'book', |
| 1053 |
journal => 'journal' |
| 1054 |
} |
| 1055 |
}; |
| 1056 |
|
| 1057 |
my $return = {}; |
| 1058 |
my $custom_key = []; |
| 1059 |
my $custom_value = []; |
| 1060 |
|
| 1061 |
# First make sure our keys are correct |
| 1062 |
foreach my $meta_key ( keys %{ $params->{other} } ) { |
| 1063 |
|
| 1064 |
# If we are transforming this property... |
| 1065 |
if ( exists $transform_metadata->{$meta_key} ) { |
| 1066 |
|
| 1067 |
# ...do it |
| 1068 |
$return->{ $transform_metadata->{$meta_key} } = $params->{other}->{$meta_key}; |
| 1069 |
} else { |
| 1070 |
|
| 1071 |
# Otherwise, pass it through untransformed and maybe move it |
| 1072 |
# to our custom parameters array |
| 1073 |
if ( !exists $ignore->{$meta_key} ) { |
| 1074 |
push @{$custom_key}, $meta_key; |
| 1075 |
push @{$custom_value}, $params->{other}->{$meta_key}; |
| 1076 |
} else { |
| 1077 |
$return->{$meta_key} = $params->{other}->{$meta_key}; |
| 1078 |
} |
| 1079 |
} |
| 1080 |
} |
| 1081 |
|
| 1082 |
# Now check our values are correct |
| 1083 |
foreach my $val_key ( keys %{$return} ) { |
| 1084 |
my $value = $return->{$val_key}; |
| 1085 |
if ( exists $transform_value->{$val_key} && exists $transform_value->{$val_key}->{$value} ) { |
| 1086 |
$return->{$val_key} = $transform_value->{$val_key}->{$value}; |
| 1087 |
} |
| 1088 |
} |
| 1089 |
if ( scalar @{$custom_key} > 0 ) { |
| 1090 |
$return->{custom_key} = join( "\0", @{$custom_key} ); |
| 1091 |
$return->{custom_value} = join( "\0", @{$custom_value} ); |
| 1092 |
} |
| 1093 |
$params->{other} = $return; |
| 1094 |
$params->{custom_keys} = $custom_key; |
| 1095 |
$params->{custom_values} = $custom_value; |
| 1096 |
return $params; |
| 1097 |
|
| 1098 |
} |
| 1099 |
|
| 1100 |
=head3 create_api |
| 1101 |
|
| 1102 |
Create a local submission from data supplied via an |
| 1103 |
API call |
| 1104 |
|
| 1105 |
=cut |
| 1106 |
|
| 1107 |
sub create_api { |
| 1108 |
my ( $self, $body, $request ) = @_; |
| 1109 |
|
| 1110 |
my $patron = Koha::Patrons->find( $body->{borrowernumber} ); |
| 1111 |
|
| 1112 |
$body->{cardnumber} = $patron->cardnumber; |
| 1113 |
|
| 1114 |
foreach my $attr ( @{ $body->{extended_attributes} } ) { |
| 1115 |
$body->{ $attr->{type} } = $attr->{value}; |
| 1116 |
} |
| 1117 |
|
| 1118 |
$body->{type} = $body->{'isbn'} ? 'book' : 'article'; |
| 1119 |
|
| 1120 |
my $submission = $self->add_request( { request => $request, other => $body } ); |
| 1121 |
|
| 1122 |
return $submission; |
| 1123 |
} |
| 1124 |
|
| 1125 |
=head3 _can_create_request |
| 1126 |
|
| 1127 |
Given the parameters we've been passed, should we create the request |
| 1128 |
|
| 1129 |
=cut |
| 1130 |
|
| 1131 |
sub _can_create_request { |
| 1132 |
my ($params) = @_; |
| 1133 |
return ( defined $params->{'stage'} |
| 1134 |
&& $params->{'stage'} eq 'form' |
| 1135 |
&& !defined $params->{'add_new_custom'} |
| 1136 |
&& !defined $params->{'custom_delete'} |
| 1137 |
&& !defined $params->{'change_type'} ) ? 1 : 0; |
| 1138 |
} |
| 1139 |
|
| 1140 |
=head3 _standard_request2biblio |
| 1141 |
|
| 1142 |
Given supplied metadata from a Standard request, create a basic biblio |
| 1143 |
record and return its ID |
| 1144 |
|
| 1145 |
=cut |
| 1146 |
|
| 1147 |
sub _standard_request2biblio { |
| 1148 |
my ( $self, $metadata ) = @_; |
| 1149 |
|
| 1150 |
# We only want to create biblios for books |
| 1151 |
return 0 unless $metadata->{type} eq 'book'; |
| 1152 |
|
| 1153 |
# We're going to try and populate author, title & ISBN |
| 1154 |
my $author = $metadata->{author} if $metadata->{author}; |
| 1155 |
my $title = $metadata->{title} if $metadata->{title}; |
| 1156 |
my $isbn = $metadata->{isbn} if $metadata->{isbn}; |
| 1157 |
|
| 1158 |
# Create the MARC::Record object and populate |
| 1159 |
my $record = MARC::Record->new(); |
| 1160 |
|
| 1161 |
# Fix character set where appropriate |
| 1162 |
my $marcflavour = C4::Context->preference('marcflavour') || 'MARC21'; |
| 1163 |
if ( $record->encoding() eq 'MARC-8' ) { |
| 1164 |
($record) = MarcToUTF8Record( $record, $marcflavour ); |
| 1165 |
} |
| 1166 |
|
| 1167 |
if ($isbn) { |
| 1168 |
my $marc_isbn = MARC::Field->new( '020', '', '', a => $isbn ); |
| 1169 |
$record->append_fields($marc_isbn); |
| 1170 |
} |
| 1171 |
if ($author) { |
| 1172 |
my $marc_author = MARC::Field->new( '100', '1', '', a => $author ); |
| 1173 |
$record->append_fields($marc_author); |
| 1174 |
} |
| 1175 |
if ($title) { |
| 1176 |
my $marc_title = MARC::Field->new( '245', '0', '0', a => $title ); |
| 1177 |
$record->append_fields($marc_title); |
| 1178 |
} |
| 1179 |
|
| 1180 |
# Suppress the record |
| 1181 |
_set_suppression($record); |
| 1182 |
|
| 1183 |
# Create a biblio record |
| 1184 |
my ( $biblionumber, $biblioitemnumber ) = |
| 1185 |
AddBiblio( $record, $self->{framework} ); |
| 1186 |
|
| 1187 |
return $biblionumber; |
| 1188 |
} |
| 1189 |
|
| 1190 |
=head3 _set_suppression |
| 1191 |
|
| 1192 |
_set_suppression($record); |
| 1193 |
|
| 1194 |
Take a MARC::Record object and set it to be suppressed |
| 1195 |
|
| 1196 |
=cut |
| 1197 |
|
| 1198 |
sub _set_suppression { |
| 1199 |
my ($record) = @_; |
| 1200 |
|
| 1201 |
my $new942 = MARC::Field->new( '942', '', '', n => '1' ); |
| 1202 |
$record->append_fields($new942); |
| 1203 |
|
| 1204 |
return 1; |
| 1205 |
} |
| 1206 |
|
| 1207 |
=head1 AUTHORS |
| 1208 |
|
| 1209 |
Alex Sassmannshausen <alex.sassmannshausen@ptfs-europe.com> |
| 1210 |
Martin Renvoize <martin.renvoize@ptfs-europe.com> |
| 1211 |
Andrew Isherwood <andrew.isherwood@ptfs-europe.com> |
| 1212 |
|
| 1213 |
=cut |
| 1214 |
|
| 1215 |
1; |