Bug 26685: Move starman out of debian/control.in and into cpanfile
[koha.git] / cataloguing / value_builder / marc21_field_006.pl
1 #!/usr/bin/perl
2
3 # Converted to new plugin style (Bug 13437)
4
5 # Copyright 2000-2002 Katipo Communications
6 #
7 # This file is part of Koha.
8 #
9 # Koha is free software; you can redistribute it and/or modify it
10 # under the terms of the GNU General Public License as published by
11 # the Free Software Foundation; either version 3 of the License, or
12 # (at your option) any later version.
13 #
14 # Koha is distributed in the hope that it will be useful, but
15 # WITHOUT ANY WARRANTY; without even the implied warranty of
16 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 # GNU General Public License for more details.
18 #
19 # You should have received a copy of the GNU General Public License
20 # along with Koha; if not, see <http://www.gnu.org/licenses>.
21
22 use Modern::Perl;
23 use C4::Auth qw( get_template_and_user );
24 use CGI qw ( -utf8 );
25 use C4::Context;
26
27 use C4::Search;
28 use C4::Output qw( output_html_with_http_headers );
29
30 use XML::LibXML;
31
32 my $builder = sub {
33     my ( $params ) = @_;
34     my $function_name = $params->{id};
35     my $res           = "
36 <script>
37
38 function Click$function_name(event) {
39     defaultvalue=document.getElementById(event.data.id).value;
40     newin=window.open(\"../cataloguing/plugin_launcher.pl?plugin_name=marc21_field_006.pl&index=\"+ event.data.id +\"&result=\"+defaultvalue,\"tag_editor\",'width=1000,height=600,toolbar=false,scrollbars=yes');
41
42 }
43 </script>
44 ";
45
46     return $res;
47 };
48
49 my $launcher = sub {
50     my ( $params ) = @_;
51     my $input = $params->{cgi};
52     my $index   = $input->param('index');
53     my $result  = $input->param('result');
54
55     my $dbh = C4::Context->dbh;
56
57     my ($template, $loggedinuser, $cookie) = get_template_and_user(
58         {   template_name   => "cataloguing/value_builder/marc21_field_006.tt",
59             query           => $input,
60             type            => "intranet",
61             flagsrequired   => { editcatalogue => '*' },
62         }
63     );
64     $result = "a|||||r|||| 00| 0 " unless $result;
65     my $material_form_mapping = {
66         a => 'BKS', t => 'BKS',
67         c => 'MU', d => 'MU', i => 'MU', j => 'MU',
68         e => 'MP', f => 'MP',
69         g => 'VM', k => 'VM', o => 'VM', r => 'VM',
70         m => 'CF',
71         p => 'MX',
72         s => 'CR',
73     };
74     my $material_code = substr(($result // ' '), 0, 1);
75     my $material_configuration = $material_form_mapping->{$material_code};
76
77     my $errorXml = '';
78     # Check if the xml, xsd exists and is validated
79     my $dir = C4::Context->config('intrahtdocs') . '/prog/' . $template->{lang} . '/data/';
80     if (-r $dir . 'marc21_field_006.xml') {
81         my $doc = XML::LibXML->new->parse_file($dir . 'marc21_field_006.xml');
82         if (-r $dir . 'marc21_field_CF.xsd') {
83             my $xmlschema = XML::LibXML::Schema->new(location => $dir . 'marc21_field_CF.xsd');
84             eval {
85                 $xmlschema->validate( $doc );
86             };
87             $errorXml = 'Can\'t validate the xml data from ' . $dir . 'marc21_field_006.xml' if ($@);
88         }
89     } else {
90         $errorXml = 'Can\'t read the xml file ' . $dir . 'marc21_field_006.xml';
91     }
92     $template->param(tagfield => '006',
93             index => $index,
94             result => $result,
95             errorXml => $errorXml,
96             material_configuration => $material_configuration,
97     );
98     output_html_with_http_headers $input, $cookie, $template->output;
99 };
100
101 return { builder => $builder, launcher => $launcher };