Bug 11926: URI-encode data sent to statistics server
[koha.git] / svc / bib_profile
blobe1c1f68a299b778b2c8955284ef4c28a54d5450e
1 #!/usr/bin/perl
3 # Copyright 2007 LibLime
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 2 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.
21 use strict;
22 use warnings;
24 use CGI;
25 use C4::Auth qw/check_api_auth/;
26 use C4::Context;
27 use C4::Koha;
28 use XML::Simple;
30 my $query = new CGI;
32 my ($status, $cookie, $sessionID) = check_api_auth($query, { editcatalogue => 'edit_catalogue'} );
34 if ($status eq "ok") {
35 print $query->header(-type => 'text/xml', cookie => $cookie);
36 } else {
37 print $query->header(-type => 'text/xml', -status => '403 Forbidden');
38 print XMLout({ auth_status => $status }, NoAttr => 1, RootName => 'response', XMLDecl => 1);
39 exit 0;
42 my $dbh = C4::Context->dbh;
44 # get list of required tags
45 my $result = {};
46 $result->{'auth_status'} = $status;
47 _get_mandatory_tags($result);
48 _get_mandatory_subfields($result);
49 _get_reserved_tags($result);
50 _get_bib_number_tag($result);
51 _get_biblioitem_itemtypes($result);
52 print XMLout($result, NoAttr => 1, RootName => 'response', XMLDecl => 1,
53 GroupTags => {mandatory_tags => 'tag', mandatory_subfields => 'subfield', reserved_tags => 'tag',
54 valid_values => 'value'});
56 exit 0;
58 sub _get_mandatory_tags {
59 my $result = shift;
60 my $sth = $dbh->prepare_cached("SELECT tagfield FROM marc_tag_structure WHERE frameworkcode = '' AND mandatory = 1");
61 $sth->execute();
62 my @tags = ();
63 while (my $row = $sth->fetchrow_arrayref) {
64 push @tags, $row->[0];
66 $result->{'mandatory_tags'} = \@tags;
69 sub _get_mandatory_subfields {
70 my $result = shift;
71 my $sth = $dbh->prepare_cached("SELECT tagfield, tagsubfield
72 FROM marc_subfield_structure
73 WHERE frameworkcode = ''
74 AND tagsubfield <> '\@'
75 AND kohafield <> 'biblioitems.itemtype'
76 AND mandatory = 1");
77 $sth->execute();
78 my @subfields = ();
79 while (my $row = $sth->fetchrow_arrayref) {
80 push @subfields, { tag => $row->[0], subfield_label => $row->[1] };
82 $result->{'mandatory_subfields'} = \@subfields;
85 sub _get_reserved_tags {
86 my $result = shift;
87 my $sth = $dbh->prepare_cached("SELECT DISTINCT tagfield
88 FROM marc_subfield_structure
89 WHERE frameworkcode = ''
90 AND (kohafield = 'items.itemnumber' OR kohafield = 'biblioitems.itemtype' OR
91 kohafield = 'biblio.biblionumber')");
92 $sth->execute();
93 my @tags = ();
94 while (my $row = $sth->fetchrow_arrayref) {
95 push @tags, $row->[0];
97 $result->{'reserved_tags'} = \@tags;
100 sub _get_bib_number_tag {
101 my $result = shift;
102 my $sth = $dbh->prepare_cached("SELECT tagfield, tagsubfield
103 FROM marc_subfield_structure
104 WHERE frameworkcode = ''
105 AND kohafield = 'biblio.biblionumber'");
106 $sth->execute();
107 my @tags = ();
108 while (my $row = $sth->fetchrow_arrayref) {
109 push @tags, { tag => $row->[0], subfield => $row->[1] };
111 $result->{'bib_number'} = \@tags;
114 sub _get_biblioitem_itemtypes {
115 my $result = shift;
116 my $itemtypes = GetItemTypes;
117 my $sth = $dbh->prepare_cached("SELECT tagfield, tagsubfield
118 FROM marc_subfield_structure
119 WHERE frameworkcode = ''
120 AND kohafield = 'biblioitems.itemtype'");
121 $sth->execute();
122 my @tags = ();
123 while (my $row = $sth->fetchrow_arrayref) {
124 push @tags, { tag => $row->[0], subfield => $row->[1] };
126 my @valid_values = map { { code => $_, description => $itemtypes->{$_}->{'description'} } } sort keys %$itemtypes;
127 $result->{'special_entry'} = { field => \@tags, valid_values => \@valid_values };