#!/usr/bin/perl # # Copyright (C) 2018 Koha-Suomi Oy # # This file is part of Koha # # Koha is free software; you can redistribute it and/or modify it # under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 3 of the License, or # (at your option) any later version. # # Koha is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with Koha; if not, see . # use Modern::Perl; use XML::Simple qw( XMLin ); use Pod::Usage qw( pod2usage ); use Getopt::Long qw( GetOptions ); use Carp qw( croak ); use open ':std', ':encoding(UTF-8)'; sub usage { pod2usage( -verbose => 2 ); exit; } # Options my $sourceurl = 'http://www.loc.gov/standards/codelists/languages.xml'; my $help; my $outfile; my $tempfile = '/tmp/languages.xml'; GetOptions( 'o|output:s' => \$outfile, 'url:s' => \$sourceurl, 'help|h' => \$help, ); usage() if $help; system( qq{/usr/bin/wget $sourceurl -O $tempfile } ) == 0 or croak "Can't wget $sourceurl ($?)"; my $ref = XMLin($tempfile); my $languages = $ref->{'languages'}->{'language'}; # output log or STDOUT my $out_handle; if (defined $outfile) { open( $out_handle, ">", $outfile ) || croak("Cannot open output file"); } else { open( $out_handle, ">&STDOUT" ) || croak("Couldn't duplicate STDOUT: $!"); } generate_header($out_handle); generate_body($out_handle, $languages); generate_footer($out_handle); close $out_handle; sub generate_body { my ( $file_handle, $language_list ) = @_; foreach my $l ( @{$language_list} ) { my $code = $l->{'code'}; my $name = ( ref( $l->{'name'} ) eq 'HASH' ? $l->{'name'}{'content'} : $l->{'name'} ); next if ( ref($code) eq 'HASH' && $code->{'status'} eq 'obsolete' ); print {$file_handle} " "; print {$file_handle} "$name"; print {$file_handle} ""; print {$file_handle} "\n"; } return; } sub generate_header { my ($file_handle) = @_; print {$file_handle} <<"HEADER"; HEADER return; } sub generate_footer { my ($file_handle) = @_; print {$file_handle} <<"FOOTER"; FOOTER return; } =head1 NAME generate_MARC21Languages.pl =head1 SYNOPSIS generate_MARC21Languages.pl generate_MARC21Languages.pl --url='http://www.loc.gov/standards/codelists/languages.xml' =head1 DESCRIPTION Create MARC21Languages.xsl from the loc.gov MARC21 Code List for Languages =over 8 =item B<--help> Prints this help =item B<--url> Fetch the languages XML from this url. Defaults to http://www.loc.gov/standards/codelists/languages.xml =item B<--output> Writes the output XML into this file. Defaults to STDOUT. =back =cut