X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=2ebf4a98ed1a603c3b563f84017deb6157dc619e;hb=fa7e8e493e71d3358aa64c3454f171af2e8b941f;hp=d6dddbe628e59d49e1e40d358843518a6848b600;hpb=36d57b8f9a164ba5a47459e62cc2e02f78cfb253;p=koha.git diff --git a/C4/Koha.pm b/C4/Koha.pm index d6dddbe628..2ebf4a98ed 100644 --- a/C4/Koha.pm +++ b/C4/Koha.pm @@ -17,15 +17,47 @@ package C4::Koha; # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place, # Suite 330, Boston, MA 02111-1307 USA -# $Id$ use strict; -require Exporter; use C4::Context; use C4::Output; -our ($VERSION,@ISA,@EXPORT); - -$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); }; +use URI::Split qw(uri_split); + +use vars qw($VERSION @ISA @EXPORT $DEBUG); + +BEGIN { + $VERSION = 3.01; + require Exporter; + @ISA = qw(Exporter); + @EXPORT = qw( + &slashifyDate + &DisplayISBN + &subfield_is_koha_internal_p + &GetPrinters &GetPrinter + &GetItemTypes &getitemtypeinfo + &GetCcodes + &get_itemtypeinfos_of + &getframeworks &getframeworkinfo + &getauthtypes &getauthtype + &getallthemes + &getFacets + &displayServers + &getnbpages + &get_infos_of + &get_notforloan_label_of + &getitemtypeimagedir + &getitemtypeimagesrc + &getitemtypeimagelocation + &GetAuthorisedValues + &GetAuthorisedValueCategories + &GetKohaAuthorisedValues + &GetAuthValCode + &GetManagedTagSubfields + + $DEBUG + ); + $DEBUG = 0; +} =head1 NAME @@ -42,46 +74,8 @@ $VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map =head1 FUNCTIONS -=over 2 - =cut -@ISA = qw(Exporter); -@EXPORT = qw( - &slashifyDate - &DisplayISBN - &subfield_is_koha_internal_p - &GetPrinters &GetPrinter - &GetItemTypes &getitemtypeinfo - &GetCcodes - &GetAuthItemlost - &GetAuthItembinding - &get_itemtypeinfos_of - &getframeworks &getframeworkinfo - &getauthtypes &getauthtype - &getallthemes - &getFacets - &displaySortby - &displayIndexes - &displaySubtypesLimit - &displayLimitTypes - &displayServers - &getnbpages - &getitemtypeimagesrcfromurl - &get_infos_of - &get_notforloan_label_of - &getitemtypeimagedir - &getitemtypeimagesrc - &GetAuthorisedValues - &FixEncoding - &GetKohaAuthorisedValues - &GetManagedTagSubfields - - $DEBUG - ); - -my $DEBUG = 0; - =head2 slashifyDate $slash_date = &slashifyDate($dash_date); @@ -108,6 +102,7 @@ sub slashifyDate { sub DisplayISBN { my ($isbn) = @_; + if (length ($isbn)<13){ my $seg1; if ( substr( $isbn, 0, 1 ) <= 7 ) { $seg1 = substr( $isbn, 0, 1 ); @@ -150,6 +145,52 @@ sub DisplayISBN { $seg3 = substr( $seg3, 0, length($seg3) - 1 ); my $seg4 = substr( $x, -1, 1 ); return "$seg1-$seg2-$seg3-$seg4"; + } else { + my $seg1; + $seg1 = substr( $isbn, 0, 3 ); + my $seg2; + if ( substr( $isbn, 3, 1 ) <= 7 ) { + $seg2 = substr( $isbn, 3, 1 ); + } + elsif ( substr( $isbn, 3, 2 ) <= 94 ) { + $seg2 = substr( $isbn, 3, 2 ); + } + elsif ( substr( $isbn, 3, 3 ) <= 995 ) { + $seg2 = substr( $isbn, 3, 3 ); + } + elsif ( substr( $isbn, 3, 4 ) <= 9989 ) { + $seg2 = substr( $isbn, 3, 4 ); + } + else { + $seg2 = substr( $isbn, 3, 5 ); + } + my $x = substr( $isbn, length($seg2) +3); + my $seg3; + if ( substr( $x, 0, 2 ) <= 19 ) { + + # if(sTmp2 < 10) sTmp2 = "0" sTmp2; + $seg3 = substr( $x, 0, 2 ); + } + elsif ( substr( $x, 0, 3 ) <= 699 ) { + $seg3 = substr( $x, 0, 3 ); + } + elsif ( substr( $x, 0, 4 ) <= 8399 ) { + $seg3 = substr( $x, 0, 4 ); + } + elsif ( substr( $x, 0, 5 ) <= 89999 ) { + $seg3 = substr( $x, 0, 5 ); + } + elsif ( substr( $x, 0, 6 ) <= 9499999 ) { + $seg3 = substr( $x, 0, 6 ); + } + else { + $seg3 = substr( $x, 0, 7 ); + } + my $seg4 = substr( $x, length($seg3) ); + $seg4 = substr( $seg4, 0, length($seg4) - 1 ); + my $seg5 = substr( $x, -1, 1 ); + return "$seg1-$seg2-$seg3-$seg4-$seg5"; + } } # FIXME.. this should be moved to a MARC-specific module @@ -202,7 +243,7 @@ build a HTML select with the following code : sub GetItemTypes { - # returns a reference to a hash of references to branches... + # returns a reference to a hash of references to itemtypes... my %itemtypes; my $dbh = C4::Context->dbh; my $query = qq| @@ -220,15 +261,17 @@ sub GetItemTypes { sub get_itemtypeinfos_of { my @itemtypes = @_; - my $query = ' + my $placeholders = join( ', ', map { '?' } @itemtypes ); + my $query = <<"END_SQL"; SELECT itemtype, description, + imageurl, notforloan FROM itemtypes - WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ') -'; + WHERE itemtype IN ( $placeholders ) +END_SQL - return get_infos_of( $query, 'itemtype' ); + return get_infos_of( $query, 'itemtype', undef, \@itemtypes ); } # this is temporary until we separate collection codes and item types @@ -252,66 +295,6 @@ sub GetCcodes { return ( $count, @results ); } -=head2 - -grab itemlost authorized values - -=cut - -sub GetAuthItemlost { - my $itemlost = shift; - my $count = 0; - my @results; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "SELECT * FROM authorised_values ORDER BY authorised_value"); - $sth->execute; - while ( my $data = $sth->fetchrow_hashref ) { - if ( $data->{category} eq "ITEMLOST" ) { - $count++; - if ( $itemlost eq $data->{'authorised_value'} ) { - $data->{'selected'} = 1; - } - $results[$count] = $data; - - #warn "data: $data"; - } - } - $sth->finish; - return ( $count, @results ); -} - -=head2 GetAuthItembinding - -grab itemlost authorized values - -=cut - -sub GetAuthItembinding { - my $itembinding = shift; - my $count = 0; - my @results; - my $dbh = C4::Context->dbh; - my $sth = - $dbh->prepare( - "SELECT * FROM authorised_values ORDER BY authorised_value"); - $sth->execute; - while ( my $data = $sth->fetchrow_hashref ) { - if ( $data->{category} eq "BINDING" ) { - $count++; - if ( $itembinding eq $data->{'authorised_value'} ) { - $data->{'selected'} = 1; - } - $results[$count] = $data; - - #warn "data: $data"; - } - } - $sth->finish; - return ( $count, @results ); -} - =head2 getauthtypes $authtypes = &getauthtypes(); @@ -458,31 +441,168 @@ sub getitemtypeinfo { $sth->execute($itemtype); my $res = $sth->fetchrow_hashref; - $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} ); + $res->{imageurl} = getitemtypeimagelocation( 'intranet', $res->{imageurl} ); return $res; } -sub getitemtypeimagesrcfromurl { - my ($imageurl) = @_; +=head2 getitemtypeimagedir - if ( defined $imageurl and $imageurl !~ m/^http/ ) { - $imageurl = getitemtypeimagesrc() . '/' . $imageurl; - } +=over - return $imageurl; -} +=item 4 + + my $directory = getitemtypeimagedir( 'opac' ); + +pass in 'opac' or 'intranet'. Defaults to 'opac'. + +returns the full path to the appropriate directory containing images. + +=back + +=cut sub getitemtypeimagedir { - return C4::Context->opachtdocs . '/' - . C4::Context->preference('template') - . '/itemtypeimg'; + my $src = shift || 'opac'; + if ($src eq 'intranet') { + return C4::Context->config('intrahtdocs') . '/' .C4::Context->preference('template') . '/img/itemtypeimg'; + } else { + return C4::Context->config('opachtdocs') . '/' . C4::Context->preference('template') . '/itemtypeimg'; + } } sub getitemtypeimagesrc { - return '/opac-tmpl' . '/' - . C4::Context->preference('template') - . '/itemtypeimg'; + my $src = shift || 'opac'; + if ($src eq 'intranet') { + return '/intranet-tmpl' . '/' . C4::Context->preference('template') . '/img/itemtypeimg'; + } else { + return '/opac-tmpl' . '/' . C4::Context->preference('template') . '/itemtypeimg'; + } +} + +sub getitemtypeimagelocation($$) { + my ( $src, $image ) = @_; + + return '' if ( !$image ); + + my $scheme = ( uri_split( $image ) )[0]; + + return $image if ( $scheme ); + + return getitemtypeimagesrc( $src ) . '/' . $image; +} + +=head3 _getImagesFromDirectory + + Find all of the image files in a directory in the filesystem + + parameters: + a directory name + + returns: a list of images in that directory. + + Notes: this does not traverse into subdirectories. See + _getSubdirectoryNames for help with that. + Images are assumed to be files with .gif or .png file extensions. + The image names returned do not have the directory name on them. + +=cut + +sub _getImagesFromDirectory { + my $directoryname = shift; + return unless defined $directoryname; + return unless -d $directoryname; + + if ( opendir ( my $dh, $directoryname ) ) { + my @images = grep { /\.(gif|png)$/i } readdir( $dh ); + closedir $dh; + return @images; + } else { + warn "unable to opendir $directoryname: $!"; + return; + } +} + +=head3 _getSubdirectoryNames + + Find all of the directories in a directory in the filesystem + + parameters: + a directory name + + returns: a list of subdirectories in that directory. + + Notes: this does not traverse into subdirectories. Only the first + level of subdirectories are returned. + The directory names returned don't have the parent directory name + on them. + +=cut + +sub _getSubdirectoryNames { + my $directoryname = shift; + return unless defined $directoryname; + return unless -d $directoryname; + + if ( opendir ( my $dh, $directoryname ) ) { + my @directories = grep { -d File::Spec->catfile( $directoryname, $_ ) && ! ( /^\./ ) } readdir( $dh ); + closedir $dh; + return @directories; + } else { + warn "unable to opendir $directoryname: $!"; + return; + } +} + +=head3 getImageSets + + returns: a listref of hashrefs. Each hash represents another collection of images. + { imagesetname => 'npl', # the name of the image set (npl is the original one) + images => listref of image hashrefs + } + + each image is represented by a hashref like this: + { KohaImage => 'npl/image.gif', + StaffImageUrl => '/intranet-tmpl/prog/img/itemtypeimg/npl/image.gif', + OpacImageURL => '/opac-tmpl/prog/itemtypeimg/npl/image.gif' + checked => 0 or 1: was this the image passed to this method? + Note: I'd like to remove this somehow. + } + +=cut + +sub getImageSets { + my %params = @_; + my $checked = $params{'checked'} || ''; + + my $paths = { staff => { filesystem => getitemtypeimagedir('intranet'), + url => getitemtypeimagesrc('intranet'), + }, + opac => { filesystem => getitemtypeimagedir('opac'), + url => getitemtypeimagesrc('opac'), + } + }; + + my @imagesets = (); # list of hasrefs of image set data to pass to template + my @subdirectories = _getSubdirectoryNames( $paths->{'staff'}{'filesystem'} ); + + foreach my $imagesubdir ( @subdirectories ) { + my @imagelist = (); # hashrefs of image info + my @imagenames = _getImagesFromDirectory( File::Spec->catfile( $paths->{'staff'}{'filesystem'}, $imagesubdir ) ); + foreach my $thisimage ( @imagenames ) { + push( @imagelist, + { KohaImage => "$imagesubdir/$thisimage", + StaffImageUrl => join( '/', $paths->{'staff'}{'url'}, $imagesubdir, $thisimage ), + OpacImageUrl => join( '/', $paths->{'opac'}{'url'}, $imagesubdir, $thisimage ), + checked => "$imagesubdir/$thisimage" eq $checked ? 1 : 0, + } + ); + } + push @imagesets, { imagesetname => $imagesubdir, + images => \@imagelist }; + + } + return \@imagesets; } =head2 GetPrinters @@ -524,7 +644,7 @@ sub GetPrinter ($$) { return $printer; } -=item getnbpages +=head2 getnbpages Returns the number of pages to display in a pagination bar, given the number of items and the number of items per page. @@ -537,7 +657,7 @@ sub getnbpages { return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1; } -=item getallthemes +=head2 getallthemes (@themes) = &getallthemes('opac'); (@themes) = &getallthemes('intranet'); @@ -599,14 +719,18 @@ sub getFacets { tags => ['225'], subfield => 'a', }, - { + ]; + + my $library_facet; + + $library_facet = { link_value => 'branch', - label_value => 'Branches', + label_value => 'Libraries', tags => [ '995', ], subfield => 'b', expanded => '1', - }, - ]; + }; + push @$facets, $library_facet unless C4::Context->preference("singleBranchMode"); } else { $facets = [ @@ -647,23 +771,28 @@ sub getFacets { tags => [ '440', '490', ], subfield => 'a', }, - { + ]; + my $library_facet; + $library_facet = { link_value => 'branch', - label_value => 'Branches', + label_value => 'Libraries', tags => [ '952', ], subfield => 'b', expanded => '1', - }, - ]; + }; + push @$facets, $library_facet unless C4::Context->preference("singleBranchMode"); } return $facets; } =head2 get_infos_of -Return a href where a key is associated to a href. You give a query, the -name of the key among the fields returned by the query. If you also give as -third argument the name of the value, the function returns a href of scalar. +Return a href where a key is associated to a href. You give a query, +the name of the key among the fields returned by the query. If you +also give as third argument the name of the value, the function +returns a href of scalar. The optional 4th argument is an arrayref of +items passed to the C call. It is designed to bind +parameters to any placeholders in your SQL. my $query = ' SELECT itemnumber, @@ -683,12 +812,12 @@ SELECT itemnumber, =cut sub get_infos_of { - my ( $query, $key_name, $value_name ) = @_; + my ( $query, $key_name, $value_name, $bind_params ) = @_; my $dbh = C4::Context->dbh; my $sth = $dbh->prepare($query); - $sth->execute(); + $sth->execute( @$bind_params ); my %infos_of; while ( my $row = $sth->fetchrow_hashref ) { @@ -724,6 +853,8 @@ labels. =cut +# FIXME - why not use GetAuthorisedValues ?? +# sub get_notforloan_label_of { my $dbh = C4::Context->dbh; @@ -754,317 +885,73 @@ SELECT lib, return \%notforloan_label_of; } -sub displaySortby { - my ($sort_by) = @_; - $sort_by =~ s//\>/; - my $sort_by_loop = [ - { value => "1=9523 >i", label => "Popularity (Most to Least)" }, - { value => "1=9523 <i", label => "Popularity (Least to Most)" }, - { value => "1=1003 <i", label => "Author (A-Z)" }, - { value => "1=1003 >i", label => "Author (Z-A)" }, - { - value => "1=20 <i", - label => "Call Number (Non-fiction 0-9 to Fiction A-Z)" - }, - { - value => "1=20 >i", - label => "Call Number (Fiction Z-A to Non-fiction 9-0)" - }, - { value => "1=31 >i", label => "Dates" }, - { - value => "1=31 >i", - label => - "   Publication/Copyright Date: Newest to Oldest" - }, - { - value => "1=31 <i", - label => - "   Publication/Copyright Date: Oldest to Newest" - }, - { - value => "1=32 >i", - label => "   Acquisition Date: Newest to Oldest" - }, - { - value => "1=32 <i", - label => "   Acquisition Date: Oldest to Newest" - }, - { value => "1=4 <i", label => "Title (A-Z)" }, - { value => "1=4 >i", label => "Title (Z-A)" }, - ]; - for my $hash (@$sort_by_loop) { - - #warn "sort by: $sort_by ... hash:".$hash->{value}; - if ($sort_by && $hash->{value} eq $sort_by ) { - $hash->{selected} = "selected"; - } - } - return $sort_by_loop; +=head2 displayServers -} +=over 4 -sub displayIndexes { - my $indexes = [ - { value => '', label => 'Keyword' }, - { value => 'au', label => 'Author' }, - { - value => 'au,phr', - label => '     Author Phrase' - }, - { value => 'cpn', label => '     Corporate Name' }, - { value => 'cfn', label => '     Conference Name' }, - { - value => 'cpn,phr', - label => '     Corporate Name Phrase' - }, - { - value => 'cfn,phr', - label => '     Conference Name Phrase' - }, - { value => 'pn', label => '     Personal Name' }, - { - value => 'pn,phr', - label => '     Personal Name Phrase' - }, - { value => 'ln', label => 'Language' }, - - # { value => 'mt', label => 'Material Type' }, - # { value => 'mt,phr', label => 'Material Type Phrase' }, - # { value => 'mc', label => 'Musical Composition' }, - # { value => 'mc,phr', label => 'Musical Composition Phrase' }, - - { value => 'nt', label => 'Notes/Comments' }, - { value => 'pb', label => 'Publisher' }, - { value => 'pl', label => 'Publisher Location' }, - { value => 'sn', label => 'Standard Number' }, - { value => 'nb', label => '     ISBN' }, - { value => 'ns', label => '     ISSN' }, - { value => 'lcn', label => '     Call Number' }, - { value => 'su', label => 'Subject' }, - { - value => 'su,phr', - label => '     Subject Phrase' - }, - -# { value => 'de', label => '     Descriptor' }, -# { value => 'ge', label => '     Genre/Form' }, -# { value => 'gc', label => '     Geographic Coverage' }, - -# { value => 'nc', label => '     Named Corporation and Conference' }, -# { value => 'na', label => '     Named Person' }, - - { value => 'ti', label => 'Title' }, - { value => 'ti,phr', label => '     Title Phrase' }, - { value => 'se', label => '     Series Title' }, - ]; - return $indexes; -} +my $servers = displayServers(); -sub displaySubtypesLimit { - my $outer_subtype_limits_loop = [ - - { # in MARC21, aud codes are stored in 008/22 (Target audience) - name => "limit", - inner_subtype_limits_loop => [ - { - value => '', - label => 'Any Audience', - selected => "selected" - }, - { value => 'aud:a', label => 'Easy', }, - { value => 'aud:c', label => 'Juvenile', }, - { value => 'aud:d', label => 'Young Adult', }, - { value => 'aud:e', label => 'Adult', }, - - ], - }, - { # in MARC21, fic is in 008/33, bio in 008/34, mus in LDR/06 - name => "limit", - inner_subtype_limits_loop => [ - { value => '', label => 'Any Content', selected => "selected" }, - { value => 'fic:1', label => 'Fiction', }, - { value => 'fic:0', label => 'Non Fiction', }, - { value => 'bio:b', label => 'Biography', }, - { value => 'mus:j', label => 'Musical recording', }, - { value => 'mus:i', label => 'Non-musical recording', }, - - ], - }, - { # MARC21, these are codes stored in 007/00-01 - name => "limit", - inner_subtype_limits_loop => [ - { value => '', label => 'Any Format', selected => "selected" }, - { value => 'l-format:ta', label => 'Regular print', }, - { value => 'l-format:tb', label => 'Large print', }, - { value => 'l-format:fk', label => 'Braille', }, - { value => '', label => '-----------', }, - { value => 'l-format:sd', label => 'CD audio', }, - { value => 'l-format:ss', label => 'Cassette recording', }, - { - value => 'l-format:vf', - label => 'VHS tape / Videocassette', - }, - { value => 'l-format:vd', label => 'DVD video / Videodisc', }, - { value => 'l-format:co', label => 'CD Software', }, - { value => 'l-format:cr', label => 'Website', }, - - ], - }, - { # in MARC21, these are codes in 008/24-28 - name => "limit", - inner_subtype_limits_loop => [ - { value => '', label => 'Additional Content Types', }, - { value => 'ctype:a', label => 'Abstracts/summaries', }, - { value => 'ctype:b', label => 'Bibliographies', }, - { value => 'ctype:c', label => 'Catalogs', }, - { value => 'ctype:d', label => 'Dictionaries', }, - { value => 'ctype:e', label => 'Encyclopedias ', }, - { value => 'ctype:f', label => 'Handbooks', }, - { value => 'ctype:g', label => 'Legal articles', }, - { value => 'ctype:i', label => 'Indexes', }, - { value => 'ctype:j', label => 'Patent document', }, - { value => 'ctype:k', label => 'Discographies', }, - { value => 'ctype:l', label => 'Legislation', }, - { value => 'ctype:m', label => 'Theses', }, - { value => 'ctype:n', label => 'Surveys', }, - { value => 'ctype:o', label => 'Reviews', }, - { value => 'ctype:p', label => 'Programmed texts', }, - { value => 'ctype:q', label => 'Filmographies', }, - { value => 'ctype:r', label => 'Directories', }, - { value => 'ctype:s', label => 'Statistics', }, - { value => 'ctype:t', label => 'Technical reports', }, - { value => 'ctype:v', label => 'Legal cases and case notes', }, - { value => 'ctype:w', label => 'Law reports and digests', }, - { value => 'ctype:z', label => 'Treaties ', }, - ], - }, - ]; - return $outer_subtype_limits_loop; -} +my $servers = displayServers( $position ); -sub displayLimitTypes { - my $outer_limit_types_loop = [ - - { - inner_limit_types_loop => [ - { - label => "Books", - id => "mc-books", - name => "limit", - 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)", - icon => "search-books.gif", - title => -"Books, Pamphlets, Technical reports, Manuscripts, Legal papers, Theses and dissertations", - }, - - { - label => "Movies", - id => "mc-movies", - name => "limit", - value => "(mc-collection:DVD or mc-collection:AV or mc-collection:AVJ or mc-collection:AVJN or mc-collection:AVJNF or mc-collection:AVNF)", - icon => "search-movies.gif", - title => -"Motion pictures, Videorecordings, Filmstrips, Slides, Transparencies, Photos, Cards, Charts, Drawings", - }, - - { - label => "Music", - id => "mc-music", - name => "limit", - value => "(mc-collection:CDM)", - icon => "search-music.gif", - title => "Spoken, Books on CD and Cassette", - }, - ], - }, - { - inner_limit_types_loop => [ - { - label => "Audio Books", - id => "mc-audio-books", - name => "limit", - value => "(mc-collection:AB or mc-collection:AC or mc-collection:JAC or mc-collection:YAC)", - icon => "search-audio-books.gif", - title => "Spoken, Books on CD and Cassette", - }, - - { - label => "Local History Materials", - id => "mc-local-history", - name => "limit", - value => "mc-collection:LH", - icon => "Local history.gif", - title => "Local History Materials", - }, - - {label => "Large Print", - id => "mc-large-print", - name => "limit", - value => "(mc-collection:LP or mc-collection:LPNF)", - icon => "search-large-print.gif ", - title => "Large Print",}, - ], - }, -{ inner_limit_types_loop => [ - {label => "Kids", - id => "mc-kids", - name => "limit", - value => "(mc-collection:EASY or mc-collection:JNF or mc-collection:JF or mc-collection:JREF or mc-collection:JB)", - icon => "search-kids.gif", - title => "Music",}, - - {label => "Software/Internet", - id => "mc-sofware-web", - name => "limit", - value => "(mc-collection:CDR)", - icon => "search-software-web.gif", - title => "Kits",}, - - {label => "Reference", - id => "mc-reference", - name => "limit", - value => "mc-collection:REF", - icon => "search-reference.gif", - title => "Reference",}, - - ], - }, - - ]; - return $outer_limit_types_loop; -} +my $servers = displayServers( $position, $type ); + +=back + +displayServers returns a listref of hashrefs, each containing +information about available z3950 servers. Each hashref has a format +like: + + { + 'checked' => 'checked', + 'encoding' => 'MARC-8' + 'icon' => undef, + 'id' => 'LIBRARY OF CONGRESS', + 'label' => '', + 'name' => 'server', + 'opensearch' => '', + 'value' => 'z3950.loc.gov:7090/', + 'zed' => 1, + }, + + +=cut sub displayServers { my ( $position, $type ) = @_; - my $dbh = C4::Context->dbh; - my $strsth = "SELECT * FROM z3950servers where 1"; - $strsth .= " AND position=\"$position\"" if ($position); - $strsth .= " AND type=\"$type\"" if ($type); + my $dbh = C4::Context->dbh; + + my $strsth = 'SELECT * FROM z3950servers'; + my @where_clauses; + my @bind_params; + + if ($position) { + push @bind_params, $position; + push @where_clauses, ' position = ? '; + } + + if ($type) { + push @bind_params, $type; + push @where_clauses, ' type = ? '; + } + + # reassemble where clause from where clause pieces + if (@where_clauses) { + $strsth .= ' WHERE ' . join( ' AND ', @where_clauses ); + } + my $rq = $dbh->prepare($strsth); - $rq->execute; + $rq->execute(@bind_params); my @primaryserverloop; while ( my $data = $rq->fetchrow_hashref ) { - my %cell; - $cell{label} = $data->{'description'}; - $cell{id} = $data->{'name'}; - $cell{value} = - $data->{host} - . ( $data->{port} ? ":" . $data->{port} : "" ) . "/" - . $data->{database} - if ( $data->{host} ); - $cell{checked} = $data->{checked}; push @primaryserverloop, - { - label => $data->{description}, - id => $data->{name}, - name => "server", - value => $data->{host} . ":" - . $data->{port} . "/" - . $data->{database}, - checked => "checked", - icon => $data->{icon}, + { label => $data->{description}, + id => $data->{name}, + name => "server", + value => $data->{host} . ":" . $data->{port} . "/" . $data->{database}, + encoding => ( $data->{encoding} ? $data->{encoding} : "iso-5426" ), + checked => "checked", + icon => $data->{icon}, zed => $data->{type} eq 'zed', opensearch => $data->{type} eq 'opensearch' }; @@ -1086,103 +973,96 @@ sub displaySecondaryServers { return; #$secondary_servers_loop; } +=head2 GetAuthValCode + +$authvalcode = GetAuthValCode($kohafield,$frameworkcode); + +=cut + +sub GetAuthValCode { + my ($kohafield,$fwcode) = @_; + my $dbh = C4::Context->dbh; + $fwcode='' unless $fwcode; + my $sth = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=? and frameworkcode=?'); + $sth->execute($kohafield,$fwcode); + my ($authvalcode) = $sth->fetchrow_array; + return $authvalcode; +} + =head2 GetAuthorisedValues -$authvalues = GetAuthorisedValues($category); +$authvalues = GetAuthorisedValues([$category], [$selected]); -this function get all authorised values from 'authosied_value' table into a reference to array which -each value containt an hashref. +This function returns all authorised values from the'authosied_value' table in a reference to array of hashrefs. -Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory. +C<$category> returns authorised values for just one category (optional). =cut sub GetAuthorisedValues { - my $category = shift; + my ($category,$selected) = @_; + my @results; my $dbh = C4::Context->dbh; my $query = "SELECT * FROM authorised_values"; $query .= " WHERE category = '" . $category . "'" if $category; my $sth = $dbh->prepare($query); $sth->execute; - my $data = $sth->fetchall_arrayref({}); - return $data; + while (my $data=$sth->fetchrow_hashref) { + if ($selected eq $data->{'authorised_value'} ) { + $data->{'selected'} = 1; + } + push @results, $data; + } + #my $data = $sth->fetchall_arrayref({}); + return \@results; #$data; } -=item fixEncoding +=head2 GetAuthorisedValueCategories - $marcrecord = &fixEncoding($marcblob); +$auth_categories = GetAuthorisedValueCategories(); -Returns a well encoded marcrecord. +Return an arrayref of all of the available authorised +value categories. =cut -sub FixEncoding { - my $marc=shift; - my $record = MARC::Record->new_from_usmarc($marc); - if (C4::Context->preference("MARCFLAVOUR") eq "UNIMARC"){ - use Encode::Guess; - my $targetcharset="utf8" if (C4::Context->preference("TemplateEncoding") eq "utf-8"); - $targetcharset="latin1" if (C4::Context->preference("TemplateEncoding") eq "iso-8859-1"); - my $decoder = guess_encoding($marc, qw/utf8 latin1/); -# die $decoder unless ref($decoder); - if (ref($decoder)) { - my $newRecord=MARC::Record->new(); - foreach my $field ($record->fields()){ - if ($field->tag()<'010'){ - $newRecord->insert_grouped_field($field); - } else { - my $newField; - my $createdfield=0; - foreach my $subfield ($field->subfields()){ - if ($createdfield){ - if (($newField->tag eq '100')) { - substr($subfield->[1],26,2,"0103") if ($targetcharset eq "latin1"); - substr($subfield->[1],26,4,"5050") if ($targetcharset eq "utf8"); - } - map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield; - $newField->add_subfields($subfield->[0]=>$subfield->[1]); - } else { - map {C4::Biblio::char_decode($_,"UNIMARC")} @$subfield; - $newField=MARC::Field->new($field->tag(),$field->indicator(1),$field->indicator(2),$subfield->[0]=>$subfield->[1]); - $createdfield=1; - } - } - $newRecord->insert_grouped_field($newField); - } - } - # warn $newRecord->as_formatted(); - return $newRecord; - } else { - return $record; + +sub GetAuthorisedValueCategories { + my $dbh = C4::Context->dbh; + my $sth = $dbh->prepare("SELECT DISTINCT category FROM authorised_values ORDER BY category"); + $sth->execute; + my @results; + while (my $category = $sth->fetchrow_array) { + push @results, $category; } - } else { - return $record; - } + return \@results; } =head2 GetKohaAuthorisedValues - Takes $dbh , $kohafield as parameters. - returns hashref of authvalCode => liblibrarian - or undef if no authvals defined for kohafield. + Takes $kohafield, $fwcode as parameters. + Returns hashref of Code => description + Returns undef + if no authorised value category is defined for the kohafield. =cut sub GetKohaAuthorisedValues { - my ($kohafield) = @_; + my ($kohafield,$fwcode,$codedvalue) = @_; + $fwcode='' unless $fwcode; my %values; my $dbh = C4::Context->dbh; - my $sthnflstatus = $dbh->prepare('select authorised_value from marc_subfield_structure where kohafield=?'); - $sthnflstatus->execute($kohafield); - my $authorised_valuecode = $sthnflstatus->fetchrow; - if ($authorised_valuecode) { - $sthnflstatus = $dbh->prepare("select authorised_value, lib from authorised_values where category=? "); - $sthnflstatus->execute($authorised_valuecode); - while ( my ($val, $lib) = $sthnflstatus->fetchrow_array ) { - $values{$val}= $lib; - } + my $avcode = GetAuthValCode($kohafield,$fwcode); + if ($avcode) { + my $sth = $dbh->prepare("select authorised_value, lib from authorised_values where category=? "); + $sth->execute($avcode); + while ( my ($val, $lib) = $sth->fetchrow_array ) { + $values{$val}= $lib; + } + return \%values; + } else { + return undef; } - return \%values; } =head2 GetManagedTagSubfields @@ -1191,13 +1071,18 @@ sub GetKohaAuthorisedValues { $res = GetManagedTagSubfields(); +=back + Returns a reference to a big hash of hash, with the Marc structure fro the given frameworkcode -$forlibrarian :if set to 1, the MARC descriptions are the librarians ones, otherwise it's the public (OPAC) ones -$frameworkcode : the framework code to read -=back +NOTE: This function is used only by the (incomplete) bulk editing feature. Since +that feature currently does not deal with items and biblioitems changes +correctly, those tags are specifically excluded from the list prepared +by this function. -=back +For future reference, if a bulk item editing feature is implemented at some point, it +needs some design thought -- for example, circulation status fields should not +be changed willy-nilly. =cut @@ -1213,12 +1098,166 @@ FROM marc_subfield_structure ON marc_tag_structure.tagfield = marc_subfield_structure.tagfield AND marc_tag_structure.frameworkcode = marc_subfield_structure.frameworkcode WHERE marc_subfield_structure.tab>=0 -ORDER BY tagsubfield|); +AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield like 'items.%') +AND marc_tag_structure.tagfield NOT IN (SELECT tagfield FROM marc_subfield_structure WHERE kohafield = 'biblioitems.itemtype') +AND marc_subfield_structure.kohafield <> 'biblio.biblionumber' +AND marc_subfield_structure.kohafield <> 'biblioitems.biblioitemnumber' +ORDER BY marc_subfield_structure.tagfield, tagsubfield|); $rq->execute; my $data=$rq->fetchall_arrayref({}); return $data; } +=head2 display_marc_indicators + +=over 4 + +# field is a MARC::Field object +my $display_form = C4::Koha::display_marc_indicators($field); + +=back + +Generate a display form of the indicators of a variable +MARC field, replacing any blanks with '#'. + +=cut + +sub display_marc_indicators { + my $field = shift; + my $indicators = ''; + if ($field->tag() >= 10) { + $indicators = $field->indicator(1) . $field->indicator(2); + $indicators =~ s/ /#/g; + } + return $indicators; +} + +sub GetNormalizedUPC { + my ($record,$marcflavour) = @_; + my (@fields,$upc); + + if ($marcflavour eq 'MARC21') { + @fields = $record->field('024'); + foreach my $field (@fields) { + my $indicator = $field->indicator(1); + my $upc = _normalize_match_point($field->subfield('a')); + if ($indicator == 1 and $upc ne '') { + return $upc; + } + } + } + else { # assume unimarc if not marc21 + @fields = $record->field('072'); + foreach my $field (@fields) { + my $upc = _normalize_match_point($field->subfield('a')); + if ($upc ne '') { + return $upc; + } + } + } +} + +# Normalizes and returns the first valid ISBN found in the record +sub GetNormalizedISBN { + my ($isbn,$record,$marcflavour) = @_; + my @fields; + if ($isbn) { + return _isbn_cleanup($isbn); + } + return undef unless $record; + + if ($marcflavour eq 'MARC21') { + @fields = $record->field('020'); + foreach my $field (@fields) { + $isbn = $field->subfield('a'); + if ($isbn) { + return _isbn_cleanup($isbn); + } else { + return undef; + } + } + } + else { # assume unimarc if not marc21 + @fields = $record->field('010'); + foreach my $field (@fields) { + my $isbn = $field->subfield('a'); + if ($isbn) { + return _isbn_cleanup($isbn); + } else { + return undef; + } + } + } + +} + +sub GetNormalizedEAN { + my ($record,$marcflavour) = @_; + my (@fields,$ean); + + if ($marcflavour eq 'MARC21') { + @fields = $record->field('024'); + foreach my $field (@fields) { + my $indicator = $field->indicator(1); + $ean = _normalize_match_point($field->subfield('a')); + if ($indicator == 3 and $ean ne '') { + return $ean; + } + } + } + else { # assume unimarc if not marc21 + @fields = $record->field('073'); + foreach my $field (@fields) { + $ean = _normalize_match_point($field->subfield('a')); + if ($ean ne '') { + return $ean; + } + } + } +} +sub GetNormalizedOCLCNumber { + my ($record,$marcflavour) = @_; + my (@fields,$oclc); + + if ($marcflavour eq 'MARC21') { + @fields = $record->field('035'); + foreach my $field (@fields) { + $oclc = $field->subfield('a'); + if ($oclc =~ /OCoLC/) { + $oclc =~ s/\(OCoLC\)//; + return $oclc; + } else { + return undef; + } + } + } + else { # TODO: add UNIMARC fields + } +} + +sub _normalize_match_point { + my $match_point = shift; + (my $normalized_match_point) = $match_point =~ /([\d-]*[X]*)/; + $normalized_match_point =~ s/-//g; + + return $normalized_match_point; +} + +sub _isbn_cleanup ($) { + my $normalized_isbn = shift; + $normalized_isbn =~ s/-//g; + $normalized_isbn =~/([0-9]{1,})/; + $normalized_isbn = $1; + if ( + $normalized_isbn =~ /\b(\d{13})\b/ or + $normalized_isbn =~ /\b(\d{10})\b/ or + $normalized_isbn =~ /\b(\d{9}X)\b/i + ) { + return $1; + } + return undef; +} + 1; __END__