view release on metacpan or  search on metacpan

lib/Koha/Contrib/Sudoc/Loader/Authorities.pm  view on Meta::CPAN

package Koha::Contrib::Sudoc::Loader::Authorities;
# ABSTRACT: Chargeur de notices d'autorité
$Koha::Contrib::Sudoc::Loader::Authorities::VERSION = '2.49';
use Moose;

extends 'Koha::Contrib::Sudoc::Loader';

use Modern::Perl;
use utf8;
use C4::AuthoritiesMarc qw/ AddAuthority /;
use MARC::Moose::Record;


sub handle_record {
    my ($self, $record) = @_;

    # FIXME: Ici et pas en-tête parce qu'il faut que l'environnement Shell soit
    # déjà fixé avant de charger ces modules qui ont besoin de KOHA_CONF et qui
    # le garde
    use C4::Biblio qw/ ModBiblio /;
    use C4::Items;

    my $conf = $self->sudoc->c->{auth};

    # FIXME Reset de la connexion tous les x enregistrements
    $self->sudoc->koha->zconn_reset()  unless $self->count % 100;

    my $ppn = $record->field('001')->value;
    $self->log->notice( 'Autorité #' . $self->count . " ppn $ppn\n");
    my $record_text = $self->sudoc->record_as_text($record);
    $self->log->debug( $record_text );

    # On détermine le type d'autorité
    my $authtypecode;
    my $typefromtag = $conf->{typefromtag};
    for my $tag ( keys %$typefromtag ) {
        if ( $record->field($tag) ) {
            $authtypecode = $typefromtag->{$tag};
            last;
        }
    }
    unless ( $authtypecode ) {
        $self->log->warning("  ERREUR : Autorité sans vedette\n");
        return;
    }

    # On déplace le PPN de 001 en 009
    $self->sudoc->ppn_move($record, $conf->{ppn_move});

    # Y a-t-il déjà dans la base Koha une autorité ayant ce PPN ?
    # Si oui, on ajoute son authid à l'autorité entrante afin de forcer sa mise
    # à jour.
    my ($authid, $auth) = $self->sudoc->koha->get_auth_by_ppn($ppn);
    if ( $auth ) {
        $record->append(
            MARC::Moose::Field::Control->new( tag => '001', value => $authid) );
        $self->count_replaced( $self->count_replaced + 1 );
    }
    else {
        $self->count_added( $self->count_added + 1 );
    }

    if ( $self->doit ) {
        my $legacy = $record->as('Legacy');
        # FIXME: Bug SUDOC, certaines notices UTF8 n'ont pas 50 en position 13
        my $field = $legacy->field('100');
        if ( $field ) {
            my $value = $field->subfield('a');