3 # Copyright 2000-2002 Katipo Communications
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
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 with
17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
18 # Suite 330, Boston, MA 02111-1307 USA
26 use vars qw($VERSION @ISA @EXPORT);
28 $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
32 C4::Koha - Perl Module containing convenience functions for Koha scripts
41 Koha.pm provides many functions for Koha scripts.
53 &subfield_is_koha_internal_p
54 &GetPrinters &GetPrinter
55 &GetItemTypes &getitemtypeinfo
60 &getframeworks &getframeworkinfo
61 &getauthtypes &getauthtype
70 &getitemtypeimagesrcfromurl
72 &get_notforloan_label_of
77 &GetKohaAuthorisedValues
78 &GetManagedTagSubfields
87 $slash_date = &slashifyDate($dash_date);
89 Takes a string of the form "DD-MM-YYYY" (or anything separated by
90 dashes), converts it to the form "YYYY/MM/DD", and returns the result.
96 # accepts a date of the form xx-xx-xx[xx] and returns it in the
98 my @dateOut = split( '-', shift );
99 return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
105 my $string = DisplayISBN( $isbn );
112 if ( substr( $isbn, 0, 1 ) <= 7 ) {
113 $seg1 = substr( $isbn, 0, 1 );
115 elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
116 $seg1 = substr( $isbn, 0, 2 );
118 elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
119 $seg1 = substr( $isbn, 0, 3 );
121 elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
122 $seg1 = substr( $isbn, 0, 4 );
125 $seg1 = substr( $isbn, 0, 5 );
127 my $x = substr( $isbn, length($seg1) );
129 if ( substr( $x, 0, 2 ) <= 19 ) {
131 # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
132 $seg2 = substr( $x, 0, 2 );
134 elsif ( substr( $x, 0, 3 ) <= 699 ) {
135 $seg2 = substr( $x, 0, 3 );
137 elsif ( substr( $x, 0, 4 ) <= 8399 ) {
138 $seg2 = substr( $x, 0, 4 );
140 elsif ( substr( $x, 0, 5 ) <= 89999 ) {
141 $seg2 = substr( $x, 0, 5 );
143 elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
144 $seg2 = substr( $x, 0, 6 );
147 $seg2 = substr( $x, 0, 7 );
149 my $seg3 = substr( $x, length($seg2) );
150 $seg3 = substr( $seg3, 0, length($seg3) - 1 );
151 my $seg4 = substr( $x, -1, 1 );
152 return "$seg1-$seg2-$seg3-$seg4";
155 # FIXME.. this should be moved to a MARC-specific module
156 sub subfield_is_koha_internal_p ($) {
159 # We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
160 # But real MARC subfields are always single-character
161 # so it really is safer just to check the length
163 return length $subfield != 1;
168 $itemtypes = &GetItemTypes();
170 Returns information about existing itemtypes.
172 build a HTML select with the following code :
174 =head3 in PERL SCRIPT
176 my $itemtypes = GetItemTypes;
178 foreach my $thisitemtype (sort keys %$itemtypes) {
179 my $selected = 1 if $thisitemtype eq $itemtype;
180 my %row =(value => $thisitemtype,
181 selected => $selected,
182 description => $itemtypes->{$thisitemtype}->{'description'},
184 push @itemtypesloop, \%row;
186 $template->param(itemtypeloop => \@itemtypesloop);
190 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
191 <select name="itemtype">
192 <option value="">Default</option>
193 <!-- TMPL_LOOP name="itemtypeloop" -->
194 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="description" --></option>
197 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
198 <input type="submit" value="OK" class="button">
206 # returns a reference to a hash of references to branches...
208 my $dbh = C4::Context->dbh;
213 my $sth = $dbh->prepare($query);
215 while ( my $IT = $sth->fetchrow_hashref ) {
216 $itemtypes{ $IT->{'itemtype'} } = $IT;
218 return ( \%itemtypes );
221 sub get_itemtypeinfos_of {
229 WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
232 return get_infos_of( $query, 'itemtype' );
235 # this is temporary until we separate collection codes and item types
239 my $dbh = C4::Context->dbh;
242 "SELECT * FROM authorised_values ORDER BY authorised_value");
244 while ( my $data = $sth->fetchrow_hashref ) {
245 if ( $data->{category} eq "CCODE" ) {
247 $results[$count] = $data;
253 return ( $count, @results );
258 grab itemlost authorized values
262 sub GetAuthItemlost {
263 my $itemlost = shift;
266 my $dbh = C4::Context->dbh;
269 "SELECT * FROM authorised_values ORDER BY authorised_value");
271 while ( my $data = $sth->fetchrow_hashref ) {
272 if ( $data->{category} eq "ITEMLOST" ) {
274 if ( $itemlost eq $data->{'authorised_value'} ) {
275 $data->{'selected'} = 1;
277 $results[$count] = $data;
283 return ( $count, @results );
286 =head2 GetAuthItembinding
288 grab itemlost authorized values
292 sub GetAuthItembinding {
293 my $itembinding = shift;
296 my $dbh = C4::Context->dbh;
299 "SELECT * FROM authorised_values ORDER BY authorised_value");
301 while ( my $data = $sth->fetchrow_hashref ) {
302 if ( $data->{category} eq "BINDING" ) {
304 if ( $itembinding eq $data->{'authorised_value'} ) {
305 $data->{'selected'} = 1;
307 $results[$count] = $data;
313 return ( $count, @results );
318 $authtypes = &getauthtypes();
320 Returns information about existing authtypes.
322 build a HTML select with the following code :
324 =head3 in PERL SCRIPT
326 my $authtypes = getauthtypes;
328 foreach my $thisauthtype (keys %$authtypes) {
329 my $selected = 1 if $thisauthtype eq $authtype;
330 my %row =(value => $thisauthtype,
331 selected => $selected,
332 authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
334 push @authtypesloop, \%row;
336 $template->param(itemtypeloop => \@itemtypesloop);
340 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
341 <select name="authtype">
342 <!-- TMPL_LOOP name="authtypeloop" -->
343 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="authtypetext" --></option>
346 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
347 <input type="submit" value="OK" class="button">
355 # returns a reference to a hash of references to authtypes...
357 my $dbh = C4::Context->dbh;
358 my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
360 while ( my $IT = $sth->fetchrow_hashref ) {
361 $authtypes{ $IT->{'authtypecode'} } = $IT;
363 return ( \%authtypes );
367 my ($authtypecode) = @_;
369 # returns a reference to a hash of references to authtypes...
371 my $dbh = C4::Context->dbh;
372 my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
373 $sth->execute($authtypecode);
374 my $res = $sth->fetchrow_hashref;
380 $frameworks = &getframework();
382 Returns information about existing frameworks
384 build a HTML select with the following code :
386 =head3 in PERL SCRIPT
388 my $frameworks = frameworks();
390 foreach my $thisframework (keys %$frameworks) {
391 my $selected = 1 if $thisframework eq $frameworkcode;
392 my %row =(value => $thisframework,
393 selected => $selected,
394 description => $frameworks->{$thisframework}->{'frameworktext'},
396 push @frameworksloop, \%row;
398 $template->param(frameworkloop => \@frameworksloop);
402 <form action='<!-- TMPL_VAR name="script_name" -->' method=post>
403 <select name="frameworkcode">
404 <option value="">Default</option>
405 <!-- TMPL_LOOP name="frameworkloop" -->
406 <option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="frameworktext" --></option>
409 <input type=text name=searchfield value="<!-- TMPL_VAR name="searchfield" -->">
410 <input type="submit" value="OK" class="button">
418 # returns a reference to a hash of references to branches...
420 my $dbh = C4::Context->dbh;
421 my $sth = $dbh->prepare("select * from biblio_framework");
423 while ( my $IT = $sth->fetchrow_hashref ) {
424 $itemtypes{ $IT->{'frameworkcode'} } = $IT;
426 return ( \%itemtypes );
429 =head2 getframeworkinfo
431 $frameworkinfo = &getframeworkinfo($frameworkcode);
433 Returns information about an frameworkcode.
437 sub getframeworkinfo {
438 my ($frameworkcode) = @_;
439 my $dbh = C4::Context->dbh;
441 $dbh->prepare("select * from biblio_framework where frameworkcode=?");
442 $sth->execute($frameworkcode);
443 my $res = $sth->fetchrow_hashref;
447 =head2 getitemtypeinfo
449 $itemtype = &getitemtype($itemtype);
451 Returns information about an itemtype.
455 sub getitemtypeinfo {
457 my $dbh = C4::Context->dbh;
458 my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
459 $sth->execute($itemtype);
460 my $res = $sth->fetchrow_hashref;
462 $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
467 sub getitemtypeimagesrcfromurl {
470 if ( defined $imageurl and $imageurl !~ m/^http/ ) {
471 $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
477 sub getitemtypeimagedir {
478 return C4::Context->opachtdocs . '/'
479 . C4::Context->preference('template')
483 sub getitemtypeimagesrc {
484 return '/opac-tmpl' . '/'
485 . C4::Context->preference('template')
491 $printers = &GetPrinters();
492 @queues = keys %$printers;
494 Returns information about existing printer queues.
496 C<$printers> is a reference-to-hash whose keys are the print queues
497 defined in the printers table of the Koha database. The values are
498 references-to-hash, whose keys are the fields in the printers table.
504 my $dbh = C4::Context->dbh;
505 my $sth = $dbh->prepare("select * from printers");
507 while ( my $printer = $sth->fetchrow_hashref ) {
508 $printers{ $printer->{'printqueue'} } = $printer;
510 return ( \%printers );
515 $printer = GetPrinter( $query, $printers );
519 sub GetPrinter ($$) {
520 my ( $query, $printers ) = @_; # get printer for this query from printers
521 my $printer = $query->param('printer');
522 my %cookie = $query->cookie('userenv');
523 ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
524 ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
530 Returns the number of pages to display in a pagination bar, given the number
531 of items and the number of items per page.
536 my ( $nb_items, $nb_items_per_page ) = @_;
538 return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
543 (@themes) = &getallthemes('opac');
544 (@themes) = &getallthemes('intranet');
546 Returns an array of all available themes.
554 if ( $type eq 'intranet' ) {
555 $htdocs = C4::Context->config('intrahtdocs');
558 $htdocs = C4::Context->config('opachtdocs');
560 opendir D, "$htdocs";
561 my @dirlist = readdir D;
562 foreach my $directory (@dirlist) {
563 -d "$htdocs/$directory/en" and push @themes, $directory;
570 if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
573 link_value => 'su-to',
574 label_value => 'Topics',
576 [ '600', '601', '602', '603', '604', '605', '606', '610' ],
580 link_value => 'su-geo',
581 label_value => 'Places',
586 link_value => 'su-ut',
587 label_value => 'Titles',
588 tags => [ '500', '501', '502', '503', '504', ],
593 label_value => 'Authors',
594 tags => [ '700', '701', '702', ],
599 label_value => 'Series',
604 link_value => 'branch',
605 label_value => 'Branches',
615 link_value => 'su-to',
616 label_value => 'Topics',
622 # link_value => 'su-na',
623 # label_value => 'People and Organizations',
624 # tags => ['600', '610', '611'],
628 link_value => 'su-geo',
629 label_value => 'Places',
634 link_value => 'su-ut',
635 label_value => 'Titles',
641 label_value => 'Authors',
642 tags => [ '100', '110', '700', ],
647 label_value => 'Series',
648 tags => [ '440', '490', ],
652 link_value => 'branch',
653 label_value => 'Branches',
665 Return a href where a key is associated to a href. You give a query, the
666 name of the key among the fields returned by the query. If you also give as
667 third argument the name of the value, the function returns a href of scalar.
676 # generic href of any information on the item, href of href.
677 my $iteminfos_of = get_infos_of($query, 'itemnumber');
678 print $iteminfos_of->{$itemnumber}{barcode};
680 # specific information, href of scalar
681 my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
682 print $barcode_of_item->{$itemnumber};
687 my ( $query, $key_name, $value_name ) = @_;
689 my $dbh = C4::Context->dbh;
691 my $sth = $dbh->prepare($query);
695 while ( my $row = $sth->fetchrow_hashref ) {
696 if ( defined $value_name ) {
697 $infos_of{ $row->{$key_name} } = $row->{$value_name};
700 $infos_of{ $row->{$key_name} } = $row;
708 =head2 get_notforloan_label_of
710 my $notforloan_label_of = get_notforloan_label_of();
712 Each authorised value of notforloan (information available in items and
713 itemtypes) is link to a single label.
715 Returns a href where keys are authorised values and values are corresponding
718 foreach my $authorised_value (keys %{$notforloan_label_of}) {
720 "authorised_value: %s => %s\n",
722 $notforloan_label_of->{$authorised_value}
728 sub get_notforloan_label_of {
729 my $dbh = C4::Context->dbh;
732 SELECT authorised_value
733 FROM marc_subfield_structure
734 WHERE kohafield = \'items.notforloan\'
737 my $sth = $dbh->prepare($query);
739 my ($statuscode) = $sth->fetchrow_array();
744 FROM authorised_values
747 $sth = $dbh->prepare($query);
748 $sth->execute($statuscode);
749 my %notforloan_label_of;
750 while ( my $row = $sth->fetchrow_hashref ) {
751 $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
755 return \%notforloan_label_of;
760 $sort_by =~ s/</\</;
761 $sort_by =~ s/>/\>/;
763 { value => "1=9523 >i", label => "Popularity (Most to Least)" },
764 { value => "1=9523 <i", label => "Popularity (Least to Most)" },
765 { value => "1=1003 <i", label => "Author (A-Z)" },
766 { value => "1=1003 >i", label => "Author (Z-A)" },
768 value => "1=20 <i",
769 label => "Call Number (Non-fiction 0-9 to Fiction A-Z)"
772 value => "1=20 >i",
773 label => "Call Number (Fiction Z-A to Non-fiction 9-0)"
775 { value => "1=31 >i", label => "Dates" },
777 value => "1=31 >i",
779 " Publication/Copyright Date: Newest to Oldest"
782 value => "1=31 <i",
784 " Publication/Copyright Date: Oldest to Newest"
787 value => "1=32 >i",
788 label => " Acquisition Date: Newest to Oldest"
791 value => "1=32 <i",
792 label => " Acquisition Date: Oldest to Newest"
794 { value => "1=36 <i", label => "Title (A-Z)" },
795 { value => "1=36 >i", label => "Title (Z-A)" },
797 for my $hash (@$sort_by_loop) {
799 #warn "sort by: $sort_by ... hash:".$hash->{value};
800 if ($sort_by && $hash->{value} eq $sort_by ) {
801 $hash->{selected} = "selected";
804 return $sort_by_loop;
810 { value => '', label => 'Keyword' },
811 { value => 'au', label => 'Author' },
814 label => ' Author Phrase'
816 { value => 'cpn', label => ' Corporate Name' },
817 { value => 'cfn', label => ' Conference Name' },
820 label => ' Corporate Name Phrase'
824 label => ' Conference Name Phrase'
826 { value => 'pn', label => ' Personal Name' },
829 label => ' Personal Name Phrase'
831 { value => 'ln', label => 'Language' },
833 # { value => 'mt', label => 'Material Type' },
834 # { value => 'mt,phr', label => 'Material Type Phrase' },
835 # { value => 'mc', label => 'Musical Composition' },
836 # { value => 'mc,phr', label => 'Musical Composition Phrase' },
838 { value => 'nt', label => 'Notes/Comments' },
839 { value => 'pb', label => 'Publisher' },
840 { value => 'pl', label => 'Publisher Location' },
841 { value => 'sn', label => 'Standard Number' },
842 { value => 'nb', label => ' ISBN' },
843 { value => 'ns', label => ' ISSN' },
844 { value => 'lcn', label => ' Call Number' },
845 { value => 'su', label => 'Subject' },
848 label => ' Subject Phrase'
851 # { value => 'de', label => ' Descriptor' },
852 # { value => 'ge', label => ' Genre/Form' },
853 # { value => 'gc', label => ' Geographic Coverage' },
855 # { value => 'nc', label => ' Named Corporation and Conference' },
856 # { value => 'na', label => ' Named Person' },
858 { value => 'ti', label => 'Title' },
859 { value => 'ti,phr', label => ' Title Phrase' },
860 { value => 'se', label => ' Series Title' },
865 sub displaySubtypesLimit {
866 my $outer_subtype_limits_loop = [
868 { # in MARC21, aud codes are stored in 008/22 (Target audience)
870 inner_subtype_limits_loop => [
873 label => 'Any Audience',
874 selected => "selected"
876 { value => 'aud:a', label => 'Easy', },
877 { value => 'aud:c', label => 'Juvenile', },
878 { value => 'aud:d', label => 'Young Adult', },
879 { value => 'aud:e', label => 'Adult', },
883 { # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06
885 inner_subtype_limits_loop => [
886 { value => '', label => 'Any Content', selected => "selected" },
887 { value => 'fic:1', label => 'Fiction', },
888 { value => 'fic:0', label => 'Non Fiction', },
889 { value => 'bio:b', label => 'Biography', },
890 { value => 'mus:j', label => 'Musical recording', },
891 { value => 'mus:i', label => 'Non-musical recording', },
895 { # MARC21, these are codes stored in 007/00-01
897 inner_subtype_limits_loop => [
898 { value => '', label => 'Any Format', selected => "selected" },
899 { value => 'l-format:ta', label => 'Regular print', },
900 { value => 'l-format:tb', label => 'Large print', },
901 { value => 'l-format:fk', label => 'Braille', },
902 { value => '', label => '-----------', },
903 { value => 'l-format:sd', label => 'CD audio', },
904 { value => 'l-format:ss', label => 'Cassette recording', },
906 value => 'l-format:vf',
907 label => 'VHS tape / Videocassette',
909 { value => 'l-format:vd', label => 'DVD video / Videodisc', },
910 { value => 'l-format:co', label => 'CD Software', },
911 { value => 'l-format:cr', label => 'Website', },
915 { # in MARC21, these are codes in 008/24-28
917 inner_subtype_limits_loop => [
918 { value => '', label => 'Additional Content Types', },
919 { value => 'ctype:a', label => 'Abstracts/summaries', },
920 { value => 'ctype:b', label => 'Bibliographies', },
921 { value => 'ctype:c', label => 'Catalogs', },
922 { value => 'ctype:d', label => 'Dictionaries', },
923 { value => 'ctype:e', label => 'Encyclopedias ', },
924 { value => 'ctype:f', label => 'Handbooks', },
925 { value => 'ctype:g', label => 'Legal articles', },
926 { value => 'ctype:i', label => 'Indexes', },
927 { value => 'ctype:j', label => 'Patent document', },
928 { value => 'ctype:k', label => 'Discographies', },
929 { value => 'ctype:l', label => 'Legislation', },
930 { value => 'ctype:m', label => 'Theses', },
931 { value => 'ctype:n', label => 'Surveys', },
932 { value => 'ctype:o', label => 'Reviews', },
933 { value => 'ctype:p', label => 'Programmed texts', },
934 { value => 'ctype:q', label => 'Filmographies', },
935 { value => 'ctype:r', label => 'Directories', },
936 { value => 'ctype:s', label => 'Statistics', },
937 { value => 'ctype:t', label => 'Technical reports', },
938 { value => 'ctype:v', label => 'Legal cases and case notes', },
939 { value => 'ctype:w', label => 'Law reports and digests', },
940 { value => 'ctype:z', label => 'Treaties ', },
944 return $outer_subtype_limits_loop;
947 sub displayLimitTypes {
948 my $outer_limit_types_loop = [
951 inner_limit_types_loop => [
956 value => "(mc-collection:AF or mc-collection:MYS or mc-collection:SCI or mc-collection:NF or mc-collection:YA or mc-collection:BIO or mc-collection:LP or mc-collection:LPNF)",
957 icon => "search-books.gif",
959 "Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations",
966 value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)",
967 icon => "search-movies.gif",
969 "Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings",
976 value => "(mc-collection:CDM)",
977 icon => "search-music.gif",
978 title => "Spoken, Books on CD and Cassette",
983 inner_limit_types_loop => [
985 label => "Audio Books",
986 id => "mc-audio-books",
988 value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)",
989 icon => "search-audio-books.gif",
990 title => "Spoken, Books on CD and Cassette",
994 label => "Local History Materials",
995 id => "mc-local-history",
997 value => "mc-collection:LH",
998 icon => "Local history.gif",
999 title => "Local History Materials",
1002 {label => "Large Print",
1003 id => "mc-large-print",
1005 value => "(mc-collection:LP or mc-collection:LPNF)",
1006 icon => "search-large-print.gif ",
1007 title => "Large Print",},
1010 { inner_limit_types_loop => [
1014 value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)",
1015 icon => "search-kids.gif",
1018 {label => "Software/Internet",
1019 id => "mc-sofware-web",
1021 value => "(mc-collection:CDR)",
1022 icon => "search-software-web.gif",
1025 {label => "Reference",
1026 id => "mc-reference",
1028 value => "mc-collection:REF",
1029 icon => "search-reference.gif",
1030 title => "Reference",},
1036 return $outer_limit_types_loop;
1039 sub displayServers {
1040 my ( $position, $type ) = @_;
1041 my $dbh = C4::Context->dbh;
1042 my $strsth = "SELECT * FROM z3950servers where 1";
1043 $strsth .= " AND position=\"$position\"" if ($position);
1044 $strsth .= " AND type=\"$type\"" if ($type);
1045 my $rq = $dbh->prepare($strsth);
1047 my @primaryserverloop;
1049 while ( my $data = $rq->fetchrow_hashref ) {
1051 $cell{label} = $data->{'description'};
1052 $cell{id} = $data->{'name'};
1055 . ( $data->{port} ? ":" . $data->{port} : "" ) . "/"
1057 if ( $data->{host} );
1058 $cell{checked} = $data->{checked};
1059 push @primaryserverloop,
1061 label => $data->{description},
1062 id => $data->{name},
1064 value => $data->{host} . ":"
1065 . $data->{port} . "/"
1066 . $data->{database},
1067 checked => "checked",
1068 icon => $data->{icon},
1069 zed => $data->{type} eq 'zed',
1070 opensearch => $data->{type} eq 'opensearch'
1073 return \@primaryserverloop;
1076 sub displaySecondaryServers {
1078 # my $secondary_servers_loop = [
1079 # { inner_sup_servers_loop => [
1080 # {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
1081 # {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
1082 # {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
1083 # {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
1087 return; #$secondary_servers_loop;
1090 =head2 GetAuthorisedValues
1092 $authvalues = GetAuthorisedValues($category);
1094 this function get all authorised values from 'authosied_value' table into a reference to array which
1095 each value containt an hashref.
1097 Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
1101 sub GetAuthorisedValues {
1102 my $category = shift;
1103 my $dbh = C4::Context->dbh;
1104 my $query = "SELECT * FROM authorised_values";
1105 $query .= " WHERE category = '" . $category . "'" if $category;
1107 my $sth = $dbh->prepare($query);
1109 my $data = $sth->fetchall_arrayref({});
1115 $marcrecord = &fixEncoding($marcblob);
1117 Returns a well encoded marcrecord.
1122 my $record = MARC::Record->new_from_usmarc($marc);
1123 if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){
1125 my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8");
1126 $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1");
1127 my $decoder = guess_encoding($marc, qw/utf8 latin1/);
1128 # die $decoder unless ref($decoder);
1129 if (ref($decoder)) {
1130 my $newRecord=MARC::Record->new();
1131 foreach my $field ($record->fields()){
1132 if ($field->tag()<'010'){
1133 $newRecord->insert_grouped_field($field);
1137 foreach my $subfield ($field->subfields()){
1139 if (($newField->tag eq '100')) {
1140 substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1");
1141 substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8");
1143 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1144 $newField->add_subfields($subfield->[0]=>$subfield->[1]);
1146 map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield;
1147 $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]);
1151 $newRecord->insert_grouped_field($newField);
1154 # warn $newRecord->as_formatted();
1164 =head2 GetKohaAuthorisedValues
1166 Takes $dbh , $kohafield as parameters.
1167 returns hashref of authvalCode => liblibrarian
1168 or undef if no authvals defined for kohafield.
1172 sub GetKohaAuthorisedValues {
1173 my ($kohafield) = @_;
1175 my $dbh = C4::Context->dbh;
1176 my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?');
1177 $sthnflstatus->execute($kohafield);
1178 my $authorised_valuecode = $sthnflstatus->fetchrow;
1179 if ($authorised_valuecode) {
1180 $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? ");
1181 $sthnflstatus->execute($authorised_valuecode);
1182 while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) {
1183 $values{$val}= $lib;
1189 =head2 GetManagedTagSubfields
1193 $res = GetManagedTagSubfields();
1195 Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode
1196 $forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones
1197 $frameworkcode : the framework code to read
1205 sub GetManagedTagSubfields{
1206 my $dbh=C4::Context->dbh;
1207 my $rq=$dbh->prepare(qq|
1209 DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
1210 marc_subfield_structure.liblibrarian as subfielddesc,
1211 marc_tag_structure.liblibrarian as tagdesc
1212 FROM marc_subfield_structure
1213 LEFT JOIN marc_tag_structure
1214 ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield
1215 AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode
1216 WHERE marc_subfield_structure.tab>=0
1217 ORDER BY tagsubfield|);
1219 my $data=$rq->fetchall_arrayref({});