[Koha-cvs] CVS: koha/C4 AuthoritiesMarc.pm,1.1,1.2 Biblio.pm,1.91,1.92 Koha.pm,1.20,1.21
Paul POULAIN
tipaul at users.sourceforge.net
Thu Jun 10 10:29:03 CEST 2004
- Previous message: [Koha-cvs] CVS: koha/authorities auth_finder.pl,NONE,1.1 detail.pl,NONE,1.1 authorities-home.pl,1.1,1.2 authorities.pl,1.1,1.2
- Next message: [Koha-cvs] CVS: koha/koha-tmpl/intranet-tmpl/default/en/parameters auth_subfields_structure.tmpl,1.3,1.4 authtypes.tmpl,1.2,1.3 marc_subfields_structure.tmpl,1.31,1.32
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
Update of /cvsroot/koha/koha/C4
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv9687/C4
Modified Files:
AuthoritiesMarc.pm Biblio.pm Koha.pm
Log Message:
MARC authority management (continued)
Index: AuthoritiesMarc.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/AuthoritiesMarc.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -r1.1 -r1.2
*** AuthoritiesMarc.pm 7 Jun 2004 07:35:01 -0000 1.1
--- AuthoritiesMarc.pm 10 Jun 2004 08:29:01 -0000 1.2
***************
*** 21,24 ****
--- 21,25 ----
use C4::Context;
use C4::Database;
+ use C4::Koha;
use MARC::Record;
***************
*** 31,36 ****
@EXPORT = qw(
&AUTHgettagslib
! &MARCfindsubfield
! &MARCfind_frameworkcode
&AUTHaddauthority
--- 32,37 ----
@EXPORT = qw(
&AUTHgettagslib
! &AUTHfindsubfield
! &AUTHfind_authtypecode
&AUTHaddauthority
***************
*** 40,43 ****
--- 41,46 ----
&AUTHgetauthority
+ &authoritysearch
+
&MARCmodsubfield
&AUTHhtml2marc
***************
*** 47,56 ****
);
sub AUTHgettagslib {
my ($dbh,$forlibrarian,$authtypecode)= @_;
! warn "AUTH : $authtypecode";
$authtypecode="" unless $authtypecode;
! warn "AUTH : $authtypecode";
my $sth;
my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
--- 50,256 ----
);
+ sub authoritysearch {
+ my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$authtypecode) = @_;
+ # build the sql request. She will look like :
+ # select m1.bibid
+ # from auth_subfield_table as m1, auth_subfield_table as m2
+ # where m1.authid=m2.authid and
+ # (m1.subfieldvalue like "Des%" and m2.subfieldvalue like "27%")
+
+ # "Normal" statements
+ my @normal_tags = ();
+ my @normal_and_or = ();
+ my @normal_operator = ();
+ my @normal_value = ();
+ # Extracts the NOT statements from the list of statements
+ for(my $i = 0 ; $i <= $#{$value} ; $i++)
+ {
+ if(@$operator[$i] eq "contains") # if operator is contains, splits the words in separate requests
+ {
+ foreach my $word (split(/ /, @$value[$i]))
+ {
+ unless (C4::Context->stopwords->{uc($word)}) { #it's NOT a stopword => use it. Otherwise, ignore
+ my $tag = substr(@$tags[$i],0,3);
+ my $subf = substr(@$tags[$i],3,1);
+ push @normal_tags, @$tags[$i];
+ push @normal_and_or, "and"; # assumes "foo" and "bar" if "foo bar" is entered
+ push @normal_operator, @$operator[$i];
+ push @normal_value, $word;
+ }
+ }
+ }
+ else
+ {
+ push @normal_tags, @$tags[$i];
+ push @normal_and_or, @$and_or[$i];
+ push @normal_operator, @$operator[$i];
+ push @normal_value, @$value[$i];
+ }
+ }
+
+ # Finds the basic results without the NOT requests
+ my ($sql_tables, $sql_where1, $sql_where2) = create_request($dbh,\@normal_tags, \@normal_and_or, \@normal_operator, \@normal_value);
+
+ my $sth;
+ if ($sql_where2) {
+ $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)");
+ warn "Q2 : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where2 and ($sql_where1)";
+ } else {
+ $sth = $dbh->prepare("select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1");
+ warn "Q : select distinct m1.authid from auth_header,$sql_tables where m1.authid=auth_header.authid and auth_header.authtypecode=? and $sql_where1";
+ }
+ $sth->execute($authtypecode);
+ my @result = ();
+
+ while (my ($authid) = $sth->fetchrow) {
+ warn "AUTH: $authid";
+ push @result,$authid;
+ }
+
+ # we have authid list. Now, loads summary from [offset] to [offset]+[length]
+ my $counter = $offset;
+ my @finalresult = ();
+ my $oldline;
+ while (($counter <= $#result) && ($counter <= ($offset + $length))) {
+ warn "HERE";
+ # get MARC::Record of the authority
+ my $record = AUTHgetauthority($dbh,$result[$counter]);
+ # then build the summary
+ my $authtypecode = AUTHfind_authtypecode($dbh,$result[$counter]);
+ my $authref = getauthtype($authtypecode);
+ my $summary = $authref->{summary};
+ my @fields = $record->fields();
+ foreach my $field (@fields) {
+ my $tag = $field->tag();
+ if ($tag<10) {
+ } else {
+ my @subf = $field->subfields;
+ for my $i (0..$#subf) {
+ my $subfieldcode = $subf[$i][0];
+ my $subfieldvalue = $subf[$i][1];
+ my $tagsubf = $tag.$subfieldcode;
+ $summary =~ s/\[(.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue\[$1$tagsubf$2]$2$3/g;
+ }
+ }
+ }
+ $summary =~ s/\[(.*?)]//g;
+ $summary =~ s/\n/<br>/g;
+ # then add a line for the template loop
+ my %newline;
+ $newline{summary} = $summary;
+ $newline{authid} = $result[$counter];
+ push @finalresult, \%newline;
+ my $nbresults = $#result + 1;
+ return (\@finalresult, $nbresults);
+ }
+ }
+
+ # Creates the SQL Request
+
+ sub create_request {
+ my ($dbh,$tags, $and_or, $operator, $value) = @_;
+
+ my $sql_tables; # will contain marc_subfield_table as m1,...
+ my $sql_where1; # will contain the "true" where
+ my $sql_where2 = "("; # will contain m1.authid=m2.authid
+ my $nb_active=0; # will contain the number of "active" entries. and entry is active is a value is provided.
+ my $nb_table=1; # will contain the number of table. ++ on each entry EXCEPT when an OR is provided.
+
+ for(my $i=0; $i<=@$value;$i++) {
+ if (@$value[$i]) {
+ $nb_active++;
+ if ($nb_active==1) {
+ if (@$operator[$i] eq "start") {
+ $sql_tables .= "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "(m1.subfieldvalue like ".$dbh->quote("@$value[$i]%");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ } elsif (@$operator[$i] eq "contains") {
+ $sql_tables .= "auth_word as m$nb_table,";
+ $sql_where1 .= "(m1.word like ".$dbh->quote("@$value[$i]%");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m1.tag+m1.subfieldid in (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ } else {
+ $sql_tables .= "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "(m1.subfieldvalue @$operator[$i] ".$dbh->quote("@$value[$i]");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m1.tag+m1.subfieldcode in (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ }
+ } else {
+ if (@$operator[$i] eq "start") {
+ $nb_table++;
+ $sql_tables .= "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue like ".$dbh->quote("@$value[$i]%");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldcode in (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ $sql_where2 .= "m1.authid=m$nb_table.authid and ";
+ } elsif (@$operator[$i] eq "contains") {
+ if (@$and_or[$i] eq 'and') {
+ $nb_table++;
+ $sql_tables .= "auth_word as m$nb_table,";
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldid in(@$tags[$i])";
+ }
+ $sql_where1.=")";
+ $sql_where2 .= "m1.authid=m$nb_table.authid and ";
+ } else {
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.word like ".$dbh->quote("@$value[$i]%");
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldid in (@$tags[$i])";
+ }
+ $sql_where1.=")";
+ $sql_where2 .= "m1.authid=m$nb_table.authid and ";
+ }
+ } else {
+ $nb_table++;
+ $sql_tables .= "auth_subfield_table as m$nb_table,";
+ $sql_where1 .= "@$and_or[$i] (m$nb_table.subfieldvalue @$operator[$i] ".$dbh->quote(@$value[$i]);
+ if (@$tags[$i]) {
+ $sql_where1 .=" and m$nb_table.tag+m$nb_table.subfieldcode in (@$tags[$i])";
+ }
+ $sql_where2 .= "m1.authid=m$nb_table.authid and ";
+ $sql_where1.=")";
+ }
+ }
+ }
+ }
+
+ if($sql_where2 ne "(") # some datas added to sql_where2, processing
+ {
+ $sql_where2 = substr($sql_where2, 0, (length($sql_where2)-5)); # deletes the trailing ' and '
+ $sql_where2 .= ")";
+ }
+ else # no sql_where2 statement, deleting '('
+ {
+ $sql_where2 = "";
+ }
+ chop $sql_tables; # deletes the trailing ','
+ return ($sql_tables, $sql_where1, $sql_where2);
+ }
+
+
+ sub AUTHfind_authtypecode {
+ my ($dbh,$authid) = @_;
+ my $sth = $dbh->prepare("select authtypecode from auth_header where authid=?");
+ $sth->execute($authid);
+ my ($authtypecode) = $sth->fetchrow;
+ return $authtypecode;
+ }
+
sub AUTHgettagslib {
my ($dbh,$forlibrarian,$authtypecode)= @_;
! # warn "AUTH : $authtypecode";
$authtypecode="" unless $authtypecode;
! # warn "AUTH : $authtypecode";
my $sth;
my $libfield = ($forlibrarian eq 1)? 'liblibrarian' : 'libopac';
***************
*** 172,176 ****
#---- TODO : the leader is missing
$record->leader(' ');
! my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
from auth_subfield_table
where authid=? order by tag,tagorder,subfieldcode
--- 372,376 ----
#---- TODO : the leader is missing
$record->leader(' ');
! my $sth=$dbh->prepare("select authid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue
from auth_subfield_table
where authid=? order by tag,tagorder,subfieldcode
***************
*** 559,562 ****
--- 759,765 ----
# $Id$
# $Log$
+ # Revision 1.2 2004/06/10 08:29:01 tipaul
+ # MARC authority management (continued)
+ #
# Revision 1.1 2004/06/07 07:35:01 tipaul
# MARC authority management package
Index: Biblio.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Biblio.pm,v
retrieving revision 1.91
retrieving revision 1.92
diff -C2 -r1.91 -r1.92
*** Biblio.pm 3 Jun 2004 10:03:01 -0000 1.91
--- Biblio.pm 10 Jun 2004 08:29:01 -0000 1.92
***************
*** 241,250 ****
}
! $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,thesaurus_category,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield");
$sth->execute($frameworkcode);
my $subfield;
my $authorised_value;
! my $thesaurus_category;
my $value_builder;
my $kohafield;
--- 241,250 ----
}
! $sth=$dbh->prepare("select tagfield,tagsubfield,$libfield as lib,tab, mandatory, repeatable,authorised_value,authtypecode,value_builder,kohafield,seealso,hidden,isurl from marc_subfield_structure where frameworkcode=? order by tagfield,tagsubfield");
$sth->execute($frameworkcode);
my $subfield;
my $authorised_value;
! my $authtypecode;
my $value_builder;
my $kohafield;
***************
*** 252,256 ****
my $hidden;
my $isurl;
! while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$thesaurus_category,$value_builder,$kohafield,$seealso,$hidden,$isurl) = $sth->fetchrow) {
$res->{$tag}->{$subfield}->{lib}=$lib;
$res->{$tag}->{$subfield}->{tab}=$tab;
--- 252,256 ----
my $hidden;
my $isurl;
! while ( ($tag, $subfield, $lib, $tab, $mandatory, $repeatable,$authorised_value,$authtypecode,$value_builder,$kohafield,$seealso,$hidden,$isurl) = $sth->fetchrow) {
$res->{$tag}->{$subfield}->{lib}=$lib;
$res->{$tag}->{$subfield}->{tab}=$tab;
***************
*** 258,262 ****
$res->{$tag}->{$subfield}->{repeatable}=$repeatable;
$res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
! $res->{$tag}->{$subfield}->{thesaurus_category}=$thesaurus_category;
$res->{$tag}->{$subfield}->{value_builder}=$value_builder;
$res->{$tag}->{$subfield}->{kohafield}=$kohafield;
--- 258,262 ----
$res->{$tag}->{$subfield}->{repeatable}=$repeatable;
$res->{$tag}->{$subfield}->{authorised_value}=$authorised_value;
! $res->{$tag}->{$subfield}->{authtypecode}=$authtypecode;
$res->{$tag}->{$subfield}->{value_builder}=$value_builder;
$res->{$tag}->{$subfield}->{kohafield}=$kohafield;
***************
*** 2192,2195 ****
--- 2192,2198 ----
# $Id$
# $Log$
+ # Revision 1.92 2004/06/10 08:29:01 tipaul
+ # MARC authority management (continued)
+ #
# Revision 1.91 2004/06/03 10:03:01 tipaul
# * frameworks and itemtypes are independant
Index: Koha.pm
===================================================================
RCS file: /cvsroot/koha/koha/C4/Koha.pm,v
retrieving revision 1.20
retrieving revision 1.21
diff -C2 -r1.20 -r1.21
*** Koha.pm 3 Jun 2004 10:03:02 -0000 1.20
--- Koha.pm 10 Jun 2004 08:29:01 -0000 1.21
***************
*** 60,64 ****
&getitemtypes &getitemtypeinfo
&getframeworks &getframeworkinfo
! &getauthtypes
$DEBUG);
--- 60,64 ----
&getitemtypes &getitemtypeinfo
&getframeworks &getframeworkinfo
! &getauthtypes &getauthtype
$DEBUG);
***************
*** 323,326 ****
--- 323,337 ----
}
+ 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;
+ }
+
=head2 getframework
- Previous message: [Koha-cvs] CVS: koha/authorities auth_finder.pl,NONE,1.1 detail.pl,NONE,1.1 authorities-home.pl,1.1,1.2 authorities.pl,1.1,1.2
- Next message: [Koha-cvs] CVS: koha/koha-tmpl/intranet-tmpl/default/en/parameters auth_subfields_structure.tmpl,1.3,1.4 authtypes.tmpl,1.2,1.3 marc_subfields_structure.tmpl,1.31,1.32
- Messages sorted by:
[ date ]
[ thread ]
[ subject ]
[ author ]
More information about the Koha-cvs
mailing list