X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FKoha.pm;h=d6dddbe628e59d49e1e40d358843518a6848b600;hb=9a32fe85c27196de96770eea8f7a34bd24d706a6;hp=22429f88fe0983e766526137efb7d023b834ab3b;hpb=97182dceb2ce9d23e82c57cd91fc1f6c1d8bf382;p=koha.git
diff --git a/C4/Koha.pm b/C4/Koha.pm
index 22429f88fe..d6dddbe628 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -17,28 +17,28 @@ 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);
-use vars qw($VERSION @ISA @EXPORT);
-
-$VERSION = 0.01;
+$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
-C4::Koha - Perl Module containing convenience functions for Koha scripts
+ C4::Koha - Perl Module containing convenience functions for Koha scripts
=head1 SYNOPSIS
use C4::Koha;
- $date = slashifyDate("01-01-2002")
-
=head1 DESCRIPTION
-Koha.pm provides many functions for Koha scripts.
+ Koha.pm provides many functions for Koha scripts.
=head1 FUNCTIONS
@@ -46,31 +46,115 @@ Koha.pm provides many functions for Koha scripts.
=cut
-@ISA = qw(Exporter);
+@ISA = qw(Exporter);
@EXPORT = qw(
- &subfield_is_koha_internal_p
- &getbranches &getbranch &getbranchdetail
- &getprinters &getprinter
- &getitemtypes &getitemtypeinfo
- &getframeworks &getframeworkinfo
- &getauthtypes &getauthtype
- &getallthemes &getalllanguages
- &getallbranches &getletters
- getnbpages
- getitemtypeimagedir
- getitemtypeimagesrc
- getitemtypeimagesrcfromurl
- &getcities
- &getroadtypes
- $DEBUG);
-
-use vars 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);
+
+ Takes a string of the form "DD-MM-YYYY" (or anything separated by
+ dashes), converts it to the form "YYYY/MM/DD", and returns the result.
+
+=cut
+
+sub slashifyDate {
+
+ # accepts a date of the form xx-xx-xx[xx] and returns it in the
+ # form xx/xx/xx[xx]
+ my @dateOut = split( '-', shift );
+ return ("$dateOut[2]/$dateOut[1]/$dateOut[0]");
+}
+
+
+=head2 DisplayISBN
+
+ my $string = DisplayISBN( $isbn );
+
+=cut
+
+sub DisplayISBN {
+ my ($isbn) = @_;
+ my $seg1;
+ if ( substr( $isbn, 0, 1 ) <= 7 ) {
+ $seg1 = substr( $isbn, 0, 1 );
+ }
+ elsif ( substr( $isbn, 0, 2 ) <= 94 ) {
+ $seg1 = substr( $isbn, 0, 2 );
+ }
+ elsif ( substr( $isbn, 0, 3 ) <= 995 ) {
+ $seg1 = substr( $isbn, 0, 3 );
+ }
+ elsif ( substr( $isbn, 0, 4 ) <= 9989 ) {
+ $seg1 = substr( $isbn, 0, 4 );
+ }
+ else {
+ $seg1 = substr( $isbn, 0, 5 );
+ }
+ my $x = substr( $isbn, length($seg1) );
+ my $seg2;
+ if ( substr( $x, 0, 2 ) <= 19 ) {
+
+ # if(sTmp2 < 10) sTmp2 = "0" sTmp2;
+ $seg2 = substr( $x, 0, 2 );
+ }
+ elsif ( substr( $x, 0, 3 ) <= 699 ) {
+ $seg2 = substr( $x, 0, 3 );
+ }
+ elsif ( substr( $x, 0, 4 ) <= 8399 ) {
+ $seg2 = substr( $x, 0, 4 );
+ }
+ elsif ( substr( $x, 0, 5 ) <= 89999 ) {
+ $seg2 = substr( $x, 0, 5 );
+ }
+ elsif ( substr( $x, 0, 6 ) <= 9499999 ) {
+ $seg2 = substr( $x, 0, 6 );
+ }
+ else {
+ $seg2 = substr( $x, 0, 7 );
+ }
+ my $seg3 = substr( $x, length($seg2) );
+ $seg3 = substr( $seg3, 0, length($seg3) - 1 );
+ my $seg4 = substr( $x, -1, 1 );
+ return "$seg1-$seg2-$seg3-$seg4";
+}
+
# FIXME.. this should be moved to a MARC-specific module
sub subfield_is_koha_internal_p ($) {
- my($subfield) = @_;
+ my ($subfield) = @_;
# We could match on 'lib' and 'tab' (and 'mandatory', & more to come!)
# But real MARC subfields are always single-character
@@ -79,229 +163,153 @@ sub subfield_is_koha_internal_p ($) {
return length $subfield != 1;
}
-=head2 getbranches
-
- $branches = &getbranches();
- returns informations about branches.
- Create a branch selector with the following code
- Is branchIndependant sensitive
- When IndependantBranches is set AND user is not superlibrarian, displays only user's branch
-
-=head3 in PERL SCRIPT
-
-my $branches = getbranches;
-my @branchloop;
-foreach my $thisbranch (sort keys %$branches) {
- my $selected = 1 if $thisbranch eq $branch;
- my %row =(value => $thisbranch,
- selected => $selected,
- branchname => $branches->{$thisbranch}->{'branchname'},
- );
- push @branchloop, \%row;
-}
+=head2 GetItemTypes
+ $itemtypes = &GetItemTypes();
-=head3 in TEMPLATE
-
+Returns information about existing itemtypes.
-=cut
+build a HTML select with the following code :
-sub getbranches {
-# returns a reference to a hash of references to branches...
- my %branches;
- my $dbh = C4::Context->dbh;
- my $sth;
- if (C4::Context->preference("IndependantBranches") && (C4::Context->userenv->{flags}!=1)){
- my $strsth ="Select * from branches ";
- $strsth.= " WHERE branchcode = ".$dbh->quote(C4::Context->userenv->{branch});
- $strsth.= " order by branchname";
- $sth=$dbh->prepare($strsth);
- } else {
- $sth = $dbh->prepare("Select * from branches order by branchname");
- }
- $sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $nsth->execute($branch->{'branchcode'});
- while (my ($cat) = $nsth->fetchrow_array) {
- # FIXME - This seems wrong. It ought to be
- # $branch->{categorycodes}{$cat} = 1;
- # otherwise, there's a namespace collision if there's a
- # category with the same name as a field in the 'branches'
- # table (i.e., don't create a category called "issuing").
- # In addition, the current structure doesn't really allow
- # you to list the categories that a branch belongs to:
- # you'd have to list keys %$branch, and remove those keys
- # that aren't fields in the "branches" table.
- $branch->{$cat} = 1;
- }
- $branches{$branch->{'branchcode'}}=$branch;
- }
- return (\%branches);
-}
-
-=head2 getallbranches
-
- $branches = &getallbranches();
- returns informations about ALL branches.
- Create a branch selector with the following code
- IndependantBranches Insensitive...
-
=head3 in PERL SCRIPT
-my $branches = getallbranches;
-my @branchloop;
-foreach my $thisbranch (keys %$branches) {
- my $selected = 1 if $thisbranch eq $branch;
- my %row =(value => $thisbranch,
- selected => $selected,
- branchname => $branches->{$thisbranch}->{'branchname'},
- );
- push @branchloop, \%row;
-}
+ my $itemtypes = GetItemTypes;
+ my @itemtypesloop;
+ foreach my $thisitemtype (sort keys %$itemtypes) {
+ my $selected = 1 if $thisitemtype eq $itemtype;
+ my %row =(value => $thisitemtype,
+ selected => $selected,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+ }
+ $template->param(itemtypeloop => \@itemtypesloop);
+=head3 in TEMPLATE
-=head3 in TEMPLATE
-
+
=cut
-sub getallbranches {
-# returns a reference to a hash of references to ALL branches...
- my %branches;
- my $dbh = C4::Context->dbh;
- my $sth;
- $sth = $dbh->prepare("Select * from branches order by branchname");
- $sth->execute;
- while (my $branch=$sth->fetchrow_hashref) {
- my $nsth = $dbh->prepare("select categorycode from branchrelations where branchcode = ?");
- $nsth->execute($branch->{'branchcode'});
- while (my ($cat) = $nsth->fetchrow_array) {
- # FIXME - This seems wrong. It ought to be
- # $branch->{categorycodes}{$cat} = 1;
- # otherwise, there's a namespace collision if there's a
- # category with the same name as a field in the 'branches'
- # table (i.e., don't create a category called "issuing").
- # In addition, the current structure doesn't really allow
- # you to list the categories that a branch belongs to:
- # you'd have to list keys %$branch, and remove those keys
- # that aren't fields in the "branches" table.
- $branch->{$cat} = 1;
- }
- $branches{$branch->{'branchcode'}}=$branch;
- }
- return (\%branches);
-}
-
-=head2 getletters
-
- $letters = &getletters($category);
- returns informations about letters.
- if needed, $category filters for letters given category
- Create a letter selector with the following code
-
-=head3 in PERL SCRIPT
+sub GetItemTypes {
-my $letters = getletters($cat);
-my @letterloop;
-foreach my $thisletter (keys %$letters) {
- my $selected = 1 if $thisletter eq $letter;
- my %row =(value => $thisletter,
- selected => $selected,
- lettername => $letters->{$thisletter},
- );
- push @letterloop, \%row;
+ # returns a reference to a hash of references to branches...
+ my %itemtypes;
+ my $dbh = C4::Context->dbh;
+ my $query = qq|
+ SELECT *
+ FROM itemtypes
+ |;
+ my $sth = $dbh->prepare($query);
+ $sth->execute;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'itemtype'} } = $IT;
+ }
+ return ( \%itemtypes );
}
+sub get_itemtypeinfos_of {
+ my @itemtypes = @_;
-=head3 in TEMPLATE
-
+ my $query = '
+SELECT itemtype,
+ description,
+ notforloan
+ FROM itemtypes
+ WHERE itemtype IN (' . join( ',', map( { "'" . $_ . "'" } @itemtypes ) ) . ')
+';
-=cut
+ return get_infos_of( $query, 'itemtype' );
+}
-sub getletters {
-# returns a reference to a hash of references to ALL letters...
- my $cat =@_;
- my %letters;
- my $dbh = C4::Context->dbh;
- my $sth;
- if ($cat ne ""){
- $sth = $dbh->prepare("Select * from letter where module = \'".$cat."\' order by name");
- } else {
- $sth = $dbh->prepare("Select * from letter order by name");
- }
- $sth->execute;
- my $count;
- while (my $letter=$sth->fetchrow_hashref) {
- $letters{$letter->{'code'}}=$letter->{'name'};
- $count++;
- }
- return ($count,\%letters);
-}
-
-=head2 getitemtypes
-
- $itemtypes = &getitemtypes();
+# this is temporary until we separate collection codes and item types
+sub GetCcodes {
+ 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 "CCODE" ) {
+ $count++;
+ $results[$count] = $data;
-Returns information about existing itemtypes.
+ #warn "data: $data";
+ }
+ }
+ $sth->finish;
+ return ( $count, @results );
+}
-build a HTML select with the following code :
+=head2
-=head3 in PERL SCRIPT
+grab itemlost authorized values
-my $itemtypes = getitemtypes;
-my @itemtypesloop;
-foreach my $thisitemtype (sort keys %$itemtypes) {
- my $selected = 1 if $thisitemtype eq $itemtype;
- my %row =(value => $thisitemtype,
- selected => $selected,
- description => $itemtypes->{$thisitemtype}->{'description'},
- );
- push @itemtypesloop, \%row;
-}
-$template->param(itemtypeloop => \@itemtypesloop);
+=cut
-=head3 in TEMPLATE
+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 getitemtypes {
-# returns a reference to a hash of references to branches...
- my %itemtypes;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from itemtypes");
- $sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'itemtype'}}=$IT;
- }
- return (\%itemtypes);
+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
@@ -317,51 +325,53 @@ build a HTML select with the following code :
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (keys %$authtypes) {
- my $selected = 1 if $thisauthtype eq $authtype;
- my %row =(value => $thisauthtype,
- selected => $selected,
- authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
- );
- push @authtypesloop, \%row;
+ my $selected = 1 if $thisauthtype eq $authtype;
+ my %row =(value => $thisauthtype,
+ selected => $selected,
+ authtypetext => $authtypes->{$thisauthtype}->{'authtypetext'},
+ );
+ push @authtypesloop, \%row;
}
$template->param(itemtypeloop => \@itemtypesloop);
=head3 in TEMPLATE
=cut
sub getauthtypes {
-# returns a reference to a hash of references to authtypes...
- my %authtypes;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types order by authtypetext");
- $sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $authtypes{$IT->{'authtypecode'}}=$IT;
- }
- return (\%authtypes);
+
+ # returns a reference to a hash of references to authtypes...
+ my %authtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from auth_types order by authtypetext");
+ $sth->execute;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $authtypes{ $IT->{'authtypecode'} } = $IT;
+ }
+ return ( \%authtypes );
}
sub getauthtype {
- my ($authtypecode) = @_;
-# returns a reference to a hash of references to authtypes...
- my %authtypes;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from auth_types where authtypecode=?");
- $sth->execute($authtypecode);
- my $res=$sth->fetchrow_hashref;
- return $res;
+ my ($authtypecode) = @_;
+
+ # returns a reference to a hash of references to authtypes...
+ my %authtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from auth_types where authtypecode=?");
+ $sth->execute($authtypecode);
+ my $res = $sth->fetchrow_hashref;
+ return $res;
}
=head2 getframework
@@ -377,42 +387,44 @@ build a HTML select with the following code :
my $frameworks = frameworks();
my @frameworkloop;
foreach my $thisframework (keys %$frameworks) {
- my $selected = 1 if $thisframework eq $frameworkcode;
- my %row =(value => $thisframework,
- selected => $selected,
- description => $frameworks->{$thisframework}->{'frameworktext'},
- );
- push @frameworksloop, \%row;
+ my $selected = 1 if $thisframework eq $frameworkcode;
+ my %row =(value => $thisframework,
+ selected => $selected,
+ description => $frameworks->{$thisframework}->{'frameworktext'},
+ );
+ push @frameworksloop, \%row;
}
$template->param(frameworkloop => \@frameworksloop);
=head3 in TEMPLATE
=cut
sub getframeworks {
-# returns a reference to a hash of references to branches...
- my %itemtypes;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblio_framework");
- $sth->execute;
- while (my $IT=$sth->fetchrow_hashref) {
- $itemtypes{$IT->{'frameworkcode'}}=$IT;
- }
- return (\%itemtypes);
+
+ # returns a reference to a hash of references to branches...
+ my %itemtypes;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from biblio_framework");
+ $sth->execute;
+ while ( my $IT = $sth->fetchrow_hashref ) {
+ $itemtypes{ $IT->{'frameworkcode'} } = $IT;
+ }
+ return ( \%itemtypes );
}
+
=head2 getframeworkinfo
$frameworkinfo = &getframeworkinfo($frameworkcode);
@@ -422,15 +434,15 @@ Returns information about an frameworkcode.
=cut
sub getframeworkinfo {
- my ($frameworkcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
- $sth->execute($frameworkcode);
- my $res = $sth->fetchrow_hashref;
- return $res;
+ my ($frameworkcode) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare("select * from biblio_framework where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ my $res = $sth->fetchrow_hashref;
+ return $res;
}
-
=head2 getitemtypeinfo
$itemtype = &getitemtype($itemtype);
@@ -440,217 +452,89 @@ Returns information about an itemtype.
=cut
sub getitemtypeinfo {
- my ($itemtype) = @_;
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from itemtypes where itemtype=?");
- $sth->execute($itemtype);
- my $res = $sth->fetchrow_hashref;
+ my ($itemtype) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("select * from itemtypes where itemtype=?");
+ $sth->execute($itemtype);
+ my $res = $sth->fetchrow_hashref;
- $res->{imageurl} = getitemtypeimagesrcfromurl($res->{imageurl});
+ $res->{imageurl} = getitemtypeimagesrcfromurl( $res->{imageurl} );
- return $res;
+ return $res;
}
sub getitemtypeimagesrcfromurl {
my ($imageurl) = @_;
- if (defined $imageurl and $imageurl !~ m/^http/) {
- $imageurl =
- getitemtypeimagesrc()
- .'/'.$imageurl
- ;
+ if ( defined $imageurl and $imageurl !~ m/^http/ ) {
+ $imageurl = getitemtypeimagesrc() . '/' . $imageurl;
}
return $imageurl;
}
sub getitemtypeimagedir {
- return
- C4::Context->intrahtdocs
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return C4::Context->opachtdocs . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
sub getitemtypeimagesrc {
- return
- '/intranet-tmpl'
- .'/'.C4::Context->preference('template')
- .'/itemtypeimg'
- ;
+ return '/opac-tmpl' . '/'
+ . C4::Context->preference('template')
+ . '/itemtypeimg';
}
-=head2 getprinters
+=head2 GetPrinters
- $printers = &getprinters($env);
+ $printers = &GetPrinters();
@queues = keys %$printers;
Returns information about existing printer queues.
-C<$env> is ignored.
-
C<$printers> is a reference-to-hash whose keys are the print queues
defined in the printers table of the Koha database. The values are
references-to-hash, whose keys are the fields in the printers table.
=cut
-sub getprinters {
- my ($env) = @_;
+sub GetPrinters {
my %printers;
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("select * from printers");
+ my $sth = $dbh->prepare("select * from printers");
$sth->execute;
- while (my $printer=$sth->fetchrow_hashref) {
- $printers{$printer->{'printqueue'}}=$printer;
+ while ( my $printer = $sth->fetchrow_hashref ) {
+ $printers{ $printer->{'printqueue'} } = $printer;
}
- return (\%printers);
-}
-
-sub getbranch ($$) {
- my($query, $branches) = @_; # get branch for this query from branches
- my $branch = $query->param('branch');
- ($branch) || ($branch = $query->cookie('branch'));
- ($branches->{$branch}) || ($branch=(keys %$branches)[0]);
- return $branch;
+ return ( \%printers );
}
-=item getbranchdetail
+=head2 GetPrinter
- $branchname = &getbranchdetail($branchcode);
-
-Given the branch code, the function returns the corresponding
-branch name for a comprehensive information display
+$printer = GetPrinter( $query, $printers );
=cut
-sub getbranchdetail
-{
- my ($branchcode) = @_;
- my $dbh = C4::Context->dbh;
- my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
- $sth->execute($branchcode);
- my $branchname = $sth->fetchrow_hashref();
- $sth->finish();
- return $branchname;
-} # sub getbranchname
-
-
-sub getprinter ($$) {
- my($query, $printers) = @_; # get printer for this query from printers
+sub GetPrinter ($$) {
+ my ( $query, $printers ) = @_; # get printer for this query from printers
my $printer = $query->param('printer');
- ($printer) || ($printer = $query->cookie('printer')) || ($printer='');
- ($printers->{$printer}) || ($printer = (keys %$printers)[0]);
+ my %cookie = $query->cookie('userenv');
+ ($printer) || ( $printer = $cookie{'printer'} ) || ( $printer = '' );
+ ( $printers->{$printer} ) || ( $printer = ( keys %$printers )[0] );
return $printer;
}
-=item getalllanguages
-
- (@languages) = &getalllanguages($type);
- (@languages) = &getalllanguages($type,$theme);
+=item getnbpages
-Returns an array of all available languages.
+Returns the number of pages to display in a pagination bar, given the number
+of items and the number of items per page.
=cut
-sub getalllanguages {
- my $type=shift;
- my $theme=shift;
- my $htdocs;
- my @languages;
- if ($type eq 'opac') {
- $htdocs=C4::Context->config('opachtdocs');
- if ($theme and -d "$htdocs/$theme") {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- push @languages, $language;
- }
- return sort @languages;
- } else {
- my $lang;
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
- } elsif ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- if ($theme and -d "$htdocs/$theme") {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- push @languages, $language;
- }
- return sort @languages;
- } else {
- my $lang;
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
- } else {
- my $lang;
- my $htdocs=C4::Context->config('intrahtdocs');
- foreach my $theme (getallthemes('intranet')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- $lang->{$language}=1;
- }
- }
- $htdocs=C4::Context->config('opachtdocs');
- foreach my $theme (getallthemes('opac')) {
- opendir D, "$htdocs/$theme";
- foreach my $language (readdir D) {
- next if $language=~/^\./;
- next if $language eq 'all';
- next if $language=~ /png$/;
- next if $language=~ /css$/;
- next if $language=~ /CVS$/;
- next if $language=~ /itemtypeimg$/;
- $lang->{$language}=1;
- }
- }
- @languages=keys %$lang;
- return sort @languages;
- }
+sub getnbpages {
+ my ( $nb_items, $nb_items_per_page ) = @_;
+
+ return int( ( $nb_items - 1 ) / $nb_items_per_page ) + 1;
}
=item getallthemes
@@ -663,115 +547,682 @@ Returns an array of all available themes.
=cut
sub getallthemes {
- my $type=shift;
+ my $type = shift;
my $htdocs;
my @themes;
- if ($type eq 'intranet') {
- $htdocs=C4::Context->config('intrahtdocs');
- } else {
- $htdocs=C4::Context->config('opachtdocs');
+ if ( $type eq 'intranet' ) {
+ $htdocs = C4::Context->config('intrahtdocs');
+ }
+ else {
+ $htdocs = C4::Context->config('opachtdocs');
}
opendir D, "$htdocs";
- my @dirlist=readdir D;
+ my @dirlist = readdir D;
foreach my $directory (@dirlist) {
- -d "$htdocs/$directory/en" and push @themes, $directory;
+ -d "$htdocs/$directory/en" and push @themes, $directory;
}
return @themes;
}
-=item getnbpages
+sub getFacets {
+ my $facets;
+ if ( C4::Context->preference("marcflavour") eq "UNIMARC" ) {
+ $facets = [
+ {
+ link_value => 'su-to',
+ label_value => 'Topics',
+ tags =>
+ [ '600', '601', '602', '603', '604', '605', '606', '610' ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-geo',
+ label_value => 'Places',
+ tags => ['651'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-ut',
+ label_value => 'Titles',
+ tags => [ '500', '501', '502', '503', '504', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'au',
+ label_value => 'Authors',
+ tags => [ '700', '701', '702', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'se',
+ label_value => 'Series',
+ tags => ['225'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'branch',
+ label_value => 'Branches',
+ tags => [ '995', ],
+ subfield => 'b',
+ expanded => '1',
+ },
+ ];
+ }
+ else {
+ $facets = [
+ {
+ link_value => 'su-to',
+ label_value => 'Topics',
+ tags => ['650'],
+ subfield => 'a',
+ },
+
+ # {
+ # link_value => 'su-na',
+ # label_value => 'People and Organizations',
+ # tags => ['600', '610', '611'],
+ # subfield => 'a',
+ # },
+ {
+ link_value => 'su-geo',
+ label_value => 'Places',
+ tags => ['651'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'su-ut',
+ label_value => 'Titles',
+ tags => ['630'],
+ subfield => 'a',
+ },
+ {
+ link_value => 'au',
+ label_value => 'Authors',
+ tags => [ '100', '110', '700', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'se',
+ label_value => 'Series',
+ tags => [ '440', '490', ],
+ subfield => 'a',
+ },
+ {
+ link_value => 'branch',
+ label_value => 'Branches',
+ tags => [ '952', ],
+ subfield => 'b',
+ expanded => '1',
+ },
+ ];
+ }
+ return $facets;
+}
-Returns the number of pages to display in a pagination bar, given the number
-of items and the number of items per page.
+=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.
+
+ my $query = '
+SELECT itemnumber,
+ notforloan,
+ barcode
+ FROM items
+';
+
+ # generic href of any information on the item, href of href.
+ my $iteminfos_of = get_infos_of($query, 'itemnumber');
+ print $iteminfos_of->{$itemnumber}{barcode};
+
+ # specific information, href of scalar
+ my $barcode_of_item = get_infos_of($query, 'itemnumber', 'barcode');
+ print $barcode_of_item->{$itemnumber};
=cut
-sub getnbpages {
- my ($nb_items, $nb_items_per_page) = @_;
+sub get_infos_of {
+ my ( $query, $key_name, $value_name ) = @_;
+
+ my $dbh = C4::Context->dbh;
+
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
- return int(($nb_items - 1) / $nb_items_per_page) + 1;
+ my %infos_of;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ if ( defined $value_name ) {
+ $infos_of{ $row->{$key_name} } = $row->{$value_name};
+ }
+ else {
+ $infos_of{ $row->{$key_name} } = $row;
+ }
+ }
+ $sth->finish;
+
+ return \%infos_of;
}
+=head2 get_notforloan_label_of
+
+ my $notforloan_label_of = get_notforloan_label_of();
-=head2 getcities (OUEST-PROVENCE)
+Each authorised value of notforloan (information available in items and
+itemtypes) is link to a single label.
- ($id_cityarrayref, $city_hashref) = &getcities();
+Returns a href where keys are authorised values and values are corresponding
+labels.
-Looks up the different city and zip in the database. Returns two
-elements: a reference-to-array, which lists the zip city
-codes, and a reference-to-hash, which maps the name of the city.
-WHERE =>OUEST PROVENCE OR EXTERIEUR
+ foreach my $authorised_value (keys %{$notforloan_label_of}) {
+ printf(
+ "authorised_value: %s => %s\n",
+ $authorised_value,
+ $notforloan_label_of->{$authorised_value}
+ );
+ }
=cut
-sub getcities {
- #my ($type_city) = @_;
+
+sub get_notforloan_label_of {
my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select cityid,city_name from cities order by cityid ");
- #$sth->execute($type_city);
- $sth->execute();
- my %city;
- my @id;
-# insert empty value to create a empty choice in cgi popup
-
-while (my $data=$sth->fetchrow_hashref){
-
- push @id,$data->{'cityid'};
- $city{$data->{'cityid'}}=$data->{'city_name'};
+
+ my $query = '
+SELECT authorised_value
+ FROM marc_subfield_structure
+ WHERE kohafield = \'items.notforloan\'
+ LIMIT 0, 1
+';
+ my $sth = $dbh->prepare($query);
+ $sth->execute();
+ my ($statuscode) = $sth->fetchrow_array();
+
+ $query = '
+SELECT lib,
+ authorised_value
+ FROM authorised_values
+ WHERE category = ?
+';
+ $sth = $dbh->prepare($query);
+ $sth->execute($statuscode);
+ my %notforloan_label_of;
+ while ( my $row = $sth->fetchrow_hashref ) {
+ $notforloan_label_of{ $row->{authorised_value} } = $row->{lib};
}
-
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
- $sth->finish;
- if ($id eq 0)
- {
- return();
- }
- else{
- unshift (@id ,"");
- return(\@id,\%city);
- }
+ $sth->finish;
+
+ 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;
+
+}
+
+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;
+}
+
+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;
+}
+
+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;
}
+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 $rq = $dbh->prepare($strsth);
+ $rq->execute;
+ 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},
+ zed => $data->{type} eq 'zed',
+ opensearch => $data->{type} eq 'opensearch'
+ };
+ }
+ return \@primaryserverloop;
+}
-=head2 getroadtypes (OUEST-PROVENCE)
+sub displaySecondaryServers {
+
+# my $secondary_servers_loop = [
+# { inner_sup_servers_loop => [
+# {label => "Google", id=>"GOOG", value=>"google",icon => "google.ico",opensearch => "1"},
+# {label => "Yahoo", id=>"YAH", value=>"yahoo", icon =>"yahoo.ico", zed => "1"},
+# {label => "Worldcat", id=>"WCT", value=>"worldcat", icon => "worldcat.gif", zed => "1"},
+# {label => "Library of Congress", id=>"LOC", name=> "server", value=>"z3950.loc.gov:7090/Voyager", icon =>"loc.ico", zed => "1"},
+# ],
+# },
+# ];
+ return; #$secondary_servers_loop;
+}
- ($idroadtypearrayref, $roadttype_hashref) = &getroadtypes();
+=head2 GetAuthorisedValues
-Looks up the different road type . Returns two
-elements: a reference-to-array, which lists the id_roadtype
-codes, and a reference-to-hash, which maps the road type of the road .
+$authvalues = GetAuthorisedValues($category);
+this function get all authorised values from 'authosied_value' table into a reference to array which
+each value containt an hashref.
+
+Set C<$category> on input args if you want to limits your query to this one. This params is not mandatory.
=cut
-sub getroadtypes {
- my $dbh = C4::Context->dbh;
- my $sth=$dbh->prepare("Select roadtypeid,road_type from roadtype order by road_type ");
- $sth->execute();
- my %roadtype;
- my @id;
-# insert empty value to create a empty choice in cgi popup
-while (my $data=$sth->fetchrow_hashref){
- push @id,$data->{'roadtypeid'};
- $roadtype{$data->{'roadtypeid'}}=$data->{'road_type'};
+
+sub GetAuthorisedValues {
+ my $category = shift;
+ 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;
+}
+
+=item fixEncoding
+
+ $marcrecord = &fixEncoding($marcblob);
+
+Returns a well encoded marcrecord.
+
+=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;
}
- #test to know if the table contain some records if no the function return nothing
- my $id=@id;
- $sth->finish;
- if ($id eq 0)
- {
- return();
- }
- else{
- unshift (@id ,"");
- return(\@id,\%roadtype);
- }
+ } else {
+ return $record;
+ }
}
-1;
-__END__
+=head2 GetKohaAuthorisedValues
+
+ Takes $dbh , $kohafield as parameters.
+ returns hashref of authvalCode => liblibrarian
+ or undef if no authvals defined for kohafield.
+
+=cut
+
+sub GetKohaAuthorisedValues {
+ my ($kohafield) = @_;
+ 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;
+ }
+ }
+ return \%values;
+}
+
+=head2 GetManagedTagSubfields
+
+=over 4
+
+$res = GetManagedTagSubfields();
+
+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
+=back
+
+=cut
+
+sub GetManagedTagSubfields{
+ my $dbh=C4::Context->dbh;
+ my $rq=$dbh->prepare(qq|
+SELECT
+ DISTINCT CONCAT( marc_subfield_structure.tagfield, tagsubfield ) AS tagsubfield,
+ marc_subfield_structure.liblibrarian as subfielddesc,
+ marc_tag_structure.liblibrarian as tagdesc
+FROM marc_subfield_structure
+ LEFT JOIN marc_tag_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|);
+ $rq->execute;
+ my $data=$rq->fetchall_arrayref({});
+ return $data;
+}
+
+1;
+
+__END__
+
=head1 AUTHOR
Koha Team