sub getorders {
my ($supplierid)=@_;
my $dbh = C4::Context->dbh;
-
- my $strsth ="Select count(*),authorisedby,creationdate,aqbasket.basketno,
-closedate,surname,firstname,aqorders.title
-from aqorders
-left join aqbasket on aqbasket.basketno=aqorders.basketno
-left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
-where booksellerid=? and (quantity > quantityreceived or
-quantityreceived is NULL) and datecancellationprinted is NULL ";
-
- if (C4::Context->preference("IndependantBranches")) {
- my $userenv = C4::Context->userenv;
- unless ($userenv->{flags} == 1){
- $strsth .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
- }
- }
- $strsth.=" group by basketno order by aqbasket.basketno";
- my $sth=$dbh->prepare($strsth);
+ my $sth=$dbh->prepare("Select count(*),authorisedby,creationdate,aqbasket.basketno,
+ closedate,surname,firstname
+ from aqorders
+ left join aqbasket on aqbasket.basketno=aqorders.basketno
+ left join borrowers on aqbasket.authorisedby=borrowers.borrowernumber
+ where booksellerid=? and (quantity > quantityreceived or
+ quantityreceived is NULL) and datecancellationprinted is NULL
+ group by basketno order by aqbasket.basketno");
$sth->execute($supplierid);
my @results = ();
while (my $data=$sth->fetchrow_hashref){
my @searchterms = ($id);
map { push(@searchterms,"$_%","% $_%") } @data;
push(@searchterms,$search,$search,$biblio);
- my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.* from aqorders,biblioitems,biblio,aqbasket
+ my $sth=$dbh->prepare("Select biblio.*,biblioitems.*,aqorders.*,aqbasket.*,biblio.title from aqorders,biblioitems,biblio,aqbasket
where aqorders.biblioitemnumber = biblioitems.biblioitemnumber and
aqorders.basketno = aqbasket.basketno
and aqbasket.booksellerid = ?
sub histsearch {
my ($title,$author,$name,$from_placed_on,$to_placed_on)=@_;
my $dbh= C4::Context->dbh;
- my $query = "select biblio.title,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio";
-
- $query .= ",borrowers " if (C4::Context->preference("IndependantBranches"));
- $query .=" where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and biblio.biblionumber=aqorders.biblionumber ";
- $query .= " and aqbasket.authorisedby=borrowers.borrowernumber" if (C4::Context->preference("IndependantBranches"));
+ my $query = "select biblio.title,aqorders.basketno,name,aqbasket.creationdate,aqorders.datereceived, aqorders.quantity, aqorders.ecost from aqorders,aqbasket,aqbooksellers,biblio
+where aqorders.basketno=aqbasket.basketno and aqbasket.booksellerid=aqbooksellers.id and
+biblio.biblionumber=aqorders.biblionumber";
$query .= " and biblio.title like ".$dbh->quote("%".$title."%") if $title;
$query .= " and biblio.author like ".$dbh->quote("%".$author."%") if $author;
$query .= " and name like ".$dbh->quote("%".$name."%") if $name;
$query .= " and creationdate >" .$dbh->quote($from_placed_on) if $from_placed_on;
$query .= " and creationdate<".$dbh->quote($to_placed_on) if $to_placed_on;
- if (C4::Context->preference("IndependantBranches")) {
- my $userenv = C4::Context->userenv;
- unless ($userenv->{flags} == 1){
- $query .= " and (borrowers.branchcode = '".$userenv->{branch}."' or borrowers.branchcode ='')";
- }
- }
-# warn "C4:Acquisition : ".$query;
+ warn "C4:Acquisition : ".$query;
my $sth = $dbh->prepare($query);
$sth->execute;
my @order_loop;
+ my $cnt=1;
while (my $line = $sth->fetchrow_hashref) {
+ $line->{count}=$cnt++;
push @order_loop, $line;
}
return \@order_loop;
if ($sth->rows) {
my ($md5password,$cardnumber) = $sth->fetchrow;
if (md5_base64($password) eq $md5password) {
+ C4::Context->set_userenv("$bornum",$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags);
return 1,$cardnumber;
}
}
if ($sth->rows) {
my ($md5password) = $sth->fetchrow;
if (md5_base64($password) eq $md5password) {
+ C4::Context->set_userenv($bornum,$userid,$cardnumber,$firstname,$surname,$branchcode,$userflags);
return 1,$userid;
}
}
if ($userid eq C4::Context->config('user') && $password eq C4::Context->config('pass')) {
+ # Koha superuser account
+ C4::Context->set_userenv(0,0,C4::Context->config('user'),C4::Context->config('user'),C4::Context->config('user'),"",1);
return 2;
}
if ($userid eq 'demo' && $password eq 'demo' && C4::Context->config('demo')) {
my $subfieldcode = $subf[$i][0];
my $subfieldvalue = $subf[$i][1];
my $tagsubf = $tag.$subfieldcode;
- $summary =~ s/\[(.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue$2\[$1$tagsubf$2]/g;
+ $summary =~ s/\[(.?.?.?.?)$tagsubf(.*?)]/$1$subfieldvalue\[$1$tagsubf$2]$2/g;
}
}
}
&AUTHdelauthority($dbh,$authid,1);
&AUTHaddauthority($dbh,$record,$authid,AUTHfind_authtypecode($dbh,$authid));
# save the file in localfile/modified_authorities
- my $filename = C4::Context->config("intranetdir")."/localfile/modified_authorities/$authid.authid";
+ my $cgidir = C4::Context->intranetdir ."/cgi-bin";
+ unless (opendir(DIR, "$cgidir")) {
+ $cgidir = C4::Context->intranetdir."/";
+ }
+
+ my $filename = $cgidir."/localfile/modified_authorities/$authid.authid";
open AUTH, "> $filename";
print AUTH $authid;
close AUTH;
# $Id$
# $Log$
-# Revision 1.19 2005/06/20 14:10:00 tipaul
+# Revision 1.20 2005/08/04 13:27:47 tipaul
# synch'ing 2.2 and head
#
-# Revision 1.18 2005/06/07 10:00:47 tipaul
-# adding $b to mainentry (in UNIMARC, for personal names, $a is the surname, $b is the firstname)
+# Revision 1.9.2.7 2005/08/01 15:14:50 tipaul
+# minor change in summary handling (accepting 4 digits before the field)
#
-# Revision 1.17 2005/06/01 12:51:02 tipaul
-# some fixes & improvements for dictionnary search in librarian interface
+# Revision 1.9.2.6 2005/06/07 10:02:00 tipaul
+# porting dictionnary search from head to 2.2. there is now a ... facing titles, author & subject, to search in biblio & authorities existing values.
#
-# Revision 1.16 2005/05/04 15:43:43 tipaul
-# synch'ing 2.2 and head
+# Revision 1.9.2.5 2005/05/31 14:50:46 tipaul
+# fix for authority merging. There was a bug on official installs
+#
+# Revision 1.9.2.4 2005/05/30 11:24:15 tipaul
+# fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in AUTHhtml2marc, this empty field was not discarded correctly)
#
# Revision 1.9.2.3 2005/04/28 08:45:33 tipaul
# porting FindDuplicate feature for authorities from HEAD to rel_2_2, works correctly now.
}
}
}
+ # save leader
+ &MARCaddsubfield($dbh,$bibid,'000','',$fieldcount+1,'',1,$record->leader);
$dbh->do("unlock tables");
return $bibid;
}
my $record = MARC::Record->new();
# warn "". $bidid;
- #---- TODO : the leader is missing
- $record->leader(' ');
my $sth =
$dbh->prepare(
"select bibid,subfieldid,tag,tagorder,tag_indicator,subfieldcode,subfieldorder,subfieldvalue,valuebloblink
from marc_subfield_table
- where bibid=? order by tag,tagorder,subfieldcode
+ where bibid=? order by tag,tagorder,subfieldorder
"
);
my $sth2 =
if ( $row->{tagorder} ne $prevtagorder || $row->{tag} ne $prevtag ) {
$previndicator .= " ";
if ( $prevtag < 10 ) {
- $record->add_fields( ( sprintf "%03s", $prevtag ), $prevvalue )
- unless $prevtag eq "XXX"; # ignore the 1st loop
+ if ($prevtag ne '000') {
+ $record->add_fields( ( sprintf "%03s", $prevtag ), $prevvalue ) unless $prevtag eq "XXX"; # ignore the 1st loop
+ } else {
+ $record->leader(sprintf("%24s",$prevvalue));
+ }
}
else {
$record->add_fields($field) unless $prevtag eq "XXX";
sub MARCmodbiblio {
my ($dbh,$bibid,$record,$frameworkcode,$delete)=@_;
- my $oldrecord=&MARCgetbiblio($dbh,$bibid);
- if ($oldrecord eq $record) {
- return;
- }
# 1st delete the biblio,
# 2nd recreate it
my $biblionumber = MARCfind_oldbiblionumber_from_MARCbibid($dbh,$bibid);
if (@$rtags[$i] ne $prevtag) {
if ($prevtag < 10) {
if ($prevvalue) {
- $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
+ if ($prevtag ne '000') {
+ $record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
+ } else {
+ $record->leader($prevvalue);
+ }
}
} else {
if ($field) {
my $subfield;
( $tagfield, $subfield ) = MARCfind_marc_from_kohafield("",$kohatable.".".$kohafield,$frameworkcode);
foreach my $field ( $record->field($tagfield) ) {
- if ( $field->subfields ) {
- my @subfields = $field->subfields();
- foreach my $subfieldcount ( 0 .. $#subfields ) {
- if ($subfields[$subfieldcount][0] eq $subfield) {
- if ( $result->{$kohafield} ) {
- $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
- }
- else {
- $result->{$kohafield} = $subfields[$subfieldcount][1];
+ if ($field->tag()<10) {
+ if ($result->{$kohafield}) {
+ $result->{$kohafield} .= " | ".$field->data();
+ } else {
+ $result->{$kohafield} = $field->data();
+ }
+ } else {
+ if ( $field->subfields ) {
+ my @subfields = $field->subfields();
+ foreach my $subfieldcount ( 0 .. $#subfields ) {
+ if ($subfields[$subfieldcount][0] eq $subfield) {
+ if ( $result->{$kohafield} ) {
+ $result->{$kohafield} .= " | " . $subfields[$subfieldcount][1];
+ }
+ else {
+ $result->{$kohafield} = $subfields[$subfieldcount][1];
+ }
}
}
}
- }
+ }
}
# warn "OneField for $kohatable.$kohafield and $frameworkcode=> $tagfield, $subfield";
return $result;
my $oldbibitemnum;
my $olddata = MARCmarc2koha( $dbh, $record,$frameworkcode );
$oldbibnum = OLDnewbiblio( $dbh, $olddata );
- $olddata->{'biblionumber'} = $oldbibnum;
+ $olddata->{'biblionumber'} = $oldbibnum;
$oldbibitemnum = OLDnewbiblioitem( $dbh, $olddata );
# search subtiles, addiauthors and subjects
( my $tagfield1, my $tagsubfield1 ) = $sth->fetchrow;
$sth->execute("biblioitems.biblioitemnumber");
( my $tagfield2, my $tagsubfield2 ) = $sth->fetchrow;
+ my $newfield;
+ # biblionumber & biblioitemnumber are in different fields
if ( $tagfield1 != $tagfield2 ) {
- warn
-"Error in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
- print
-"Content-Type: text/html\n\nError in NEWnewbiblio : biblio.biblionumber and biblioitems.biblioitemnumber MUST have the same field number";
- die;
- }
- my $newfield = MARC::Field->new(
- $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
- "$tagsubfield2" => $oldbibitemnum
- );
-
- # drop old field and create new one...
- my $old_field = $record->field($tagfield1);
- $record->delete_field($old_field);
- $record->add_fields($newfield);
+ # deal with biblionumber
+ if ($tagfield1<10) {
+ $newfield = MARC::Field->new(
+ $tagfield1, $oldbibnum,
+ );
+ } else {
+ $newfield = MARC::Field->new(
+ $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
+ );
+ }
+ # drop old field and create new one...
+ my $old_field = $record->field($tagfield1);
+ $record->delete_field($old_field);
+ $record->add_fields($newfield);
+ # deal with biblioitemnumber
+ if ($tagfield2<10) {
+ $newfield = MARC::Field->new(
+ $tagfield2, $oldbibitemnum,
+ );
+ } else {
+ $newfield = MARC::Field->new(
+ $tagfield2, '', '', "$tagsubfield2" => $oldbibitemnum,
+ );
+ }
+ # drop old field and create new one...
+ $old_field = $record->field($tagfield2);
+ $record->delete_field($old_field);
+ $record->add_fields($newfield);
+ # biblionumber & biblioitemnumber are in the same field (can't be <10 as fields <10 have only 1 value)
+ } else {
+ my $newfield = MARC::Field->new(
+ $tagfield1, '', '', "$tagsubfield1" => $oldbibnum,
+ "$tagsubfield2" => $oldbibitemnum
+ );
+ # drop old field and create new one...
+ my $old_field = $record->field($tagfield1);
+ $record->delete_field($old_field);
+ $record->add_fields($newfield);
+ }
+# warn "REC : ".$record->as_formatted;
my $bibid = MARCaddbiblio( $dbh, $record, $oldbibnum, $frameworkcode );
return ( $bibid, $oldbibnum, $oldbibitemnum );
}
# if dateaccessioned is provided, use it. Otherwise, set to NOW()
if ( $item->{'dateaccessioned'} ) {
$sth = $dbh->prepare( "Insert into items set
- itemnumber = ?, biblionumber = ?,
- biblioitemnumber = ?, barcode = ?,
- booksellerid = ?, dateaccessioned = ?,
- homebranch = ?, holdingbranch = ?,
- price = ?, replacementprice = ?,
- replacementpricedate = NOW(), itemnotes = ?,
+ itemnumber = ?, biblionumber = ?,
+ multivolumepart = ?,
+ biblioitemnumber = ?, barcode = ?,
+ booksellerid = ?, dateaccessioned = ?,
+ homebranch = ?, holdingbranch = ?,
+ price = ?, replacementprice = ?,
+ replacementpricedate = NOW(), datelastseen = NOW(),
+ multivolume = ?, stack = ?,
+ itemlost = ?, wthdrawn = ?,
+ paidfor = ?, itemnotes = ?,
itemcallnumber =?, notforloan = ?,
location = ?
"
);
$sth->execute(
- $itemnumber, $item->{'biblionumber'},
- $item->{'biblioitemnumber'}, $barcode,
- $item->{'booksellerid'}, $item->{'dateaccessioned'},
- $item->{'homebranch'}, $item->{'holdingbranch'},
- $item->{'price'}, $item->{'replacementprice'},
- $item->{'itemnotes'}, $item->{'itemcallnumber'},
- $item->{'notforloan'}, $item->{'location'}
+ $itemnumber, $item->{'biblionumber'},
+ $item->{'multivolumepart'},
+ $item->{'biblioitemnumber'},$barcode,
+ $item->{'booksellerid'}, $item->{'dateaccessioned'},
+ $item->{'homebranch'}, $item->{'holdingbranch'},
+ $item->{'price'}, $item->{'replacementprice'},
+ $item->{multivolume}, $item->{stack},
+ $item->{itemlost}, $item->{wthdrawn},
+ $item->{paidfor}, $item->{'itemnotes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}
);
}
else {
$sth = $dbh->prepare( "Insert into items set
- itemnumber = ?, biblionumber = ?,
- biblioitemnumber = ?, barcode = ?,
- booksellerid = ?, dateaccessioned = NOW(),
- homebranch = ?, holdingbranch = ?,
- price = ?, replacementprice = ?,
- replacementpricedate = NOW(), itemnotes = ?,
- itemcallnumber = ? , notforloan = ?,
+ itemnumber = ?, biblionumber = ?,
+ multivolumepart = ?,
+ biblioitemnumber = ?, barcode = ?,
+ booksellerid = ?, dateaccessioned = NOW(),
+ homebranch = ?, holdingbranch = ?,
+ price = ?, replacementprice = ?,
+ replacementpricedate = NOW(), datelastseen = NOW(),
+ multivolume = ?, stack = ?,
+ itemlost = ?, wthdrawn = ?,
+ paidfor = ?, itemnotes = ?,
+ itemcallnumber =?, notforloan = ?,
location = ?
"
);
$sth->execute(
- $itemnumber, $item->{'biblionumber'},
- $item->{'biblioitemnumber'}, $barcode,
- $item->{'booksellerid'}, $item->{'homebranch'},
- $item->{'holdingbranch'}, $item->{'price'},
- $item->{'replacementprice'}, $item->{'itemnotes'},
- $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $itemnumber, $item->{'biblionumber'},
+ $item->{'multivolumepart'},
+ $item->{'biblioitemnumber'},$barcode,
+ $item->{'booksellerid'},
+ $item->{'homebranch'}, $item->{'holdingbranch'},
+ $item->{'price'}, $item->{'replacementprice'},
+ $item->{multivolume}, $item->{stack},
+ $item->{itemlost}, $item->{wthdrawn},
+ $item->{paidfor}, $item->{'itemnotes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
$item->{'location'}
);
}
sub OLDmoditem {
my ( $dbh, $item ) = @_;
-
-# my ($dbh,$loan,$itemnum,$bibitemnum,$barcode,$notes,$homebranch,$lost,$wthdrawn,$replacement)=@_;
- # my $dbh=C4Connect;
$item->{'itemnum'} = $item->{'itemnumber'} unless $item->{'itemnum'};
- my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=? where itemnumber=?";
+ my $query = "update items set barcode=?,itemnotes=?,itemcallnumber=?,notforloan=?,location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
my @bind = (
- $item->{'barcode'}, $item->{'notes'},
- $item->{'itemcallnumber'}, $item->{'notforloan'},
- $item->{'location'}, $item->{'itemnum'}
+ $item->{'barcode'}, $item->{'notes'},
+ $item->{'itemcallnumber'}, $item->{'notforloan'},
+ $item->{'location'}, $item->{multivolumepart},
+ $item->{multivolume}, $item->{stack},
+ $item->{wthdrawn},
);
if ( $item->{'lost'} ne '' ) {
- $query = "update items set biblioitemnumber=?,
- barcode=?,
- itemnotes=?,
- homebranch=?,
- itemlost=?,
- wthdrawn=?,
- itemcallnumber=?,
- notforloan=?,
- location=?";
+ $query = "update items set biblioitemnumber=?,barcode=?,itemnotes=?,homebranch=?,
+ itemlost=?,wthdrawn=?,itemcallnumber=?,notforloan=?,
+ location=?,multivolumepart=?,multivolume=?,stack=?,wthdrawn=?";
@bind = (
$item->{'bibitemnum'}, $item->{'barcode'},
$item->{'notes'}, $item->{'homebranch'},
$item->{'lost'}, $item->{'wthdrawn'},
$item->{'itemcallnumber'}, $item->{'notforloan'},
- $item->{'location'}, $item->{'itemnum'}
+ $item->{'location'}, $item->{multivolumepart},
+ $item->{multivolume}, $item->{stack},
+ $item->{wthdrawn},
);
if ($item->{homebranch}) {
$query.=",homebranch=?";
$query.=",holdingbranch=?";
push @bind, $item->{holdingbranch};
}
- $query.=" where itemnumber=?";
}
- if ( $item->{'replacement'} ne '' ) {
+ $query.=" where itemnumber=?";
+ push @bind,$item->{'itemnum'};
+ if ( $item->{'replacement'} ne '' ) {
$query =~ s/ where/,replacementprice='$item->{'replacement'}' where/;
}
my $sth = $dbh->prepare($query);
my ( $bibnum, $force, @subject ) = @_;
my $dbh = C4::Context->dbh;
my $error = &OLDmodsubject( $dbh, $bibnum, $force, @subject );
- if ($error eq ''){
- # When MARC is off, ensures that the MARC biblio table gets updated with new
- # subjects, of course, it deletes the biblio in marc, and then recreates.
- # This check is to ensure that no MARC data exists to lose.
-
- if (C4::Context->preference("MARC") eq '0'){
- my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
- my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
- &MARCmodbiblio($dbh,$bibid, $MARCRecord);
- }
-
- }
- return ($error);
+ if ($error eq ''){
+ # When MARC is off, ensures that the MARC biblio table gets updated with new
+ # subjects, of course, it deletes the biblio in marc, and then recreates.
+ # This check is to ensure that no MARC data exists to lose.
+ if (C4::Context->preference("MARC") eq '0'){
+ my $MARCRecord = &MARCkoha2marcBiblio($dbh,$bibnum);
+ my $bibid = &MARCfind_MARCbibid_from_oldbiblionumber($dbh,$bibnum);
+ &MARCmodbiblio($dbh,$bibid, $MARCRecord);
+ }
+ }
+ return ($error);
} # sub modsubject
sub modbibitem {
# $encoding = C4::Context->preference("marcflavour") unless $encoding;
if ( $encoding eq "UNIMARC" ) {
- s/\xe1/Æ/gm;
+# s/\xe1/Æ/gm;
s/\xe2/Ð/gm;
s/\xe9/Ø/gm;
s/\xec/þ/gm;
s/\xc4\x61/ã/gm;
s/\xc4\x6e/ñ/gm;
s/\xc4\x6f/õ/gm;
+ s/\xc8\x41/Ä/gm;
s/\xc8\x45/Ë/gm;
s/\xc8\x49/Ï/gm;
+ s/\xc8\x61/ä/gm;
s/\xc8\x65/ë/gm;
s/\xc8\x69/ï/gm;
+ s/\xc8\x6F/ö/gm;
+ s/\xc8\x75/ü/gm;
s/\xc8\x76/ÿ/gm;
s/\xc9\x41/Ä/gm;
+ s/\xc9\x45/Ë/gm;
+ s/\xc9\x49/Ï/gm;
s/\xc9\x4f/Ö/gm;
s/\xc9\x55/Ü/gm;
s/\xc9\x61/ä/gm;
# no result, returns nothing
return;
}
+
sub DisplayISBN {
my ($isbn)=@_;
my $seg1;
my $seg4 = substr($x, -1, 1);
return "$seg1-$seg2-$seg3-$seg4";
}
+
+
END { } # module clean-up code here (global destructor)
=back
# $Id$
# $Log$
-# Revision 1.121 2005/06/20 14:10:00 tipaul
+# Revision 1.122 2005/08/04 13:27:48 tipaul
# synch'ing 2.2 and head
#
-# Revision 1.120 2005/06/15 16:09:43 hdl
-# Displaying dashed isbn.
+# Revision 1.115.2.18 2005/08/02 07:45:44 tipaul
+# fix for bug http://bugs.koha.org/cgi-bin/bugzilla/show_bug.cgi?id=1009
+# (Not all items fields mapped to MARC)
+#
+# Revision 1.115.2.17 2005/08/01 15:15:43 tipaul
+# adding decoder for Ä string
+#
+# Revision 1.115.2.16 2005/07/28 19:56:15 tipaul
+# * removing a useless & CPU consuming call to MARCgetbiblio
+# * Leader management.
+# If you create a MARC tag "000", with a subfield '@', it will be managed as the leader.
+# Seems to work correctly.
+#
+# Now going to create a plugin for leader()
#
-# Revision 1.119 2005/06/01 20:43:58 genjimoto
+# Revision 1.115.2.15 2005/07/19 15:25:40 tipaul
+# * fixing a bug in subfield order when MARCgetbiblio
+# * getting rid with the limit "biblionumber & biblioitemnumber must be in the same tag". So, we can put biblionumber in 001 (field that has no subfields, so we can't put biblioitemnumber in this field), and use biblionumber as identifier in the MARC biblio too. Still to be deeply tested.
+# * adding some diacritic decoding (Ä, Ü...)
+#
+# Revision 1.115.2.14 2005/06/27 23:24:06 hdl
+# Display dashed ISBN
+#
+# Revision 1.115.2.13 2005/05/31 12:44:26 tipaul
# patch from Genji (Waylon R.) to update subjects in MARC tables when systempref has MARC=OFF
#
-# Revision 1.118 2005/05/04 15:40:01 tipaul
-# synch'ing 2.2 and head
+# Revision 1.115.2.12 2005/05/30 11:22:41 tipaul
+# fixing a bug : when a field was repeated, the last field was also repeated. (Was due to the "empty" field in html between fields : to separate fields, in html, an empty field is automatically added. in MARChtml2marc, this empty field was not discarded correctly)
+#
+# Revision 1.115.2.11 2005/05/25 15:48:43 tipaul
+# * removing my for variables already declared
+# * updating biblio.unititle field as well as other fields in biblio table
+#
+# Revision 1.115.2.10 2005/05/25 09:30:50 hdl
+# Adding NEWmodbiblioframework feature
+# Used by addbiblio.pl when modifying a framework selection.
#
# Revision 1.115.2.9 2005/04/07 10:05:25 tipaul
# adding / to the list of symbols that are replace by spaces for searches
&getsubscriptionfrombiblionumber &get_subscription_list_from_biblionumber
&get_full_subscription_list_from_biblionumber
&modsubscriptionhistory &newissue
- &getserials &serialchangestatus
+ &getserials &getlatestserials &serialchangestatus
&Find_Next_Date, &Get_Next_Seq
&hassubscriptionexpired &subscriptionexpirationdate &subscriptionrenew
&getSupplierListWithLateIssues &GetLateIssues &serialdelete &getlatestserials);
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
- $numberingmethod, $status, $notes) = @_;
+ $numberingmethod, $status, $notes,$letter) = @_;
my $dbh = C4::Context->dbh;
#save subscription
my $sth=$dbh->prepare("insert into subscription (librarian,aqbooksellerid,cost,aqbudgetid,biblionumber,
add1,every1,whenmorethan1,setto1,lastvalue1,
add2,every2,whenmorethan2,setto2,lastvalue2,
add3,every3,whenmorethan3,setto3,lastvalue3,
- numberingmethod, status, notes) values
+ numberingmethod, status, notes, letter) values
(?,?,?,?,?,?,?,?,?,
?,?,?,?,?,?,?,?,?,?,
- ?,?,?,?,?,?,?,?,?,?)");
+ ?,?,?,?,?,?,?,?,?,?,?)");
$sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$biblionumber,
format_date_in_iso($startdate),$periodicity,$dow,$numberlength,$weeklength,$monthlength,
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,
- $numberingmethod, $status, $notes);
+ $numberingmethod, $status, $notes,$letter);
#then create the 1st waited number
my $subscriptionid = $dbh->{'mysql_insertid'};
$sth = $dbh->prepare("insert into subscriptionhistory (biblionumber, subscriptionid, histstartdate, enddate, missinglist, recievedlist, opacnote, librariannote) values (?,?,?,?,?,?,?,?)");
left join aqbudget on subscription.aqbudgetid=aqbudget.aqbudgetid
left join aqbooksellers on subscription.aqbooksellerid=aqbooksellers.id
left join biblio on biblio.biblionumber=subscription.biblionumber
- where subscription.biblionumber = ? order by year,serial.planneddate');
+ where subscription.biblionumber = ? order by year,serial.subscriptionid,serial.planneddate');
$sth->execute($biblionumber);
my @res;
my $year;
my $bibliotitle;
my @loopissues;
my $first;
+ my $previousnote="";
while (my $subs = $sth->fetchrow_hashref) {
# my $sth2 = $dbh->prepare('select * from serial where serial.biblionumber = ? and serial.subscriptionid=? order by serial.planneddate');
# $sth2->execute($biblionumber,$subs->{'subscriptionid'});
'status2' => $subs->{'status'}==2,
'status3' => $subs->{'status'}==3,
'status4' => $subs->{'status'}==4,
+ 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
};
}else {
$first=1 if (not $year);
'status2' => $subs->{'status'}==2,
'status3' => $subs->{'status'}==3,
'status4' => $subs->{'status'}==4,
+ 'notes' => $subs->{'notes'} eq $previousnote?"":$subs->{notes},
};
push @res,{
'first'=>$first
};
}
+ $previousnote=$subs->{notes};
}
return \@res;
}
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
- $numberingmethod, $status, $biblionumber, $notes, $subscriptionid)= @_;
+ $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid)= @_;
my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("update subscription set librarian=?, aqbooksellerid=?,cost=?,aqbudgetid=?,startdate=?,
periodicity=?,dow=?,numberlength=?,weeklength=?,monthlength=?,
add1=?,every1=?,whenmorethan1=?,setto1=?,lastvalue1=?,innerloop1=?,
add2=?,every2=?,whenmorethan2=?,setto2=?,lastvalue2=?,innerloop2=?,
add3=?,every3=?,whenmorethan3=?,setto3=?,lastvalue3=?,innerloop3=?,
- numberingmethod=?, status=?, biblionumber=?, notes=? where subscriptionid = ?");
+ numberingmethod=?, status=?, biblionumber=?, notes=?, letter=? where subscriptionid = ?");
$sth->execute($auser,$aqbooksellerid,$cost,$aqbudgetid,$startdate,
$periodicity,$dow,$numberlength,$weeklength,$monthlength,
$add1,$every1,$whenmorethan1,$setto1,$lastvalue1,$innerloop1,
$add2,$every2,$whenmorethan2,$setto2,$lastvalue2,$innerloop2,
$add3,$every3,$whenmorethan3,$setto3,$lastvalue3,$innerloop3,
- $numberingmethod, $status, $biblionumber, $notes, $subscriptionid);
+ $numberingmethod, $status, $biblionumber, $notes, $letter, $subscriptionid);
$sth->finish;
}
my $dbh = C4::Context->dbh;
my $sth;
if ($biblionumber) {
- $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblio.biblionumber=?");
+ $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblio.biblionumber=?");
$sth->execute($biblionumber);
} else {
if ($ISSN and $title)
{
- $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and (biblio.title like ? or biblioitems.issn = ? )");
+ $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and (biblio.title like ? or biblioitems.issn = ? )");
$sth->execute("%$title%",$ISSN);
}
else
{
if ($ISSN)
{
- $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblioitems.issn = ?");
+ $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and biblio.biblionumber=subscription.biblionumber and biblioitems.issn = ?");
$sth->execute($ISSN);
}
else
{
- $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and
+ $sth = $dbh->prepare("select subscription.subscriptionid,biblio.title,biblioitems.issn,subscription.notes,biblio.biblionumber from subscription,biblio,biblioitems where biblio.biblionumber = biblioitems.biblionumber and
biblio.biblionumber=subscription.biblionumber and biblio.title like ? ");
$sth->execute("%$title%");
}
}
}
- my @results;
+ my @results;
+ my $previoustitle="";
while (my $line = $sth->fetchrow_hashref) {
+ if ($previoustitle eq $line->{title}) {
+ $line->{title}="";
+ $line->{issn}="";
+ } else {
+ $previoustitle=$line->{title};
+ }
push @results, $line;
}
return @results;
my ($totalissues) = $sth->fetchrow;
return ($totalissues,@serials);
}
+
+# get the $limit's latest serials arrived or missing for a given subscription
sub getlatestserials{
my ($subscriptionid,$limit) =@_;
my $dbh = C4::Context->dbh;
$sth=$dbh->prepare("select count(*) from serial where subscriptionid=?");
$sth->execute($subscriptionid);
my ($totalissues) = $sth->fetchrow;
- return ($totalissues,@serials);
+ return \@serials;
}
sub serialchangestatus {
my ($subscriptionid,$oldstatus) = $sth->fetchrow;
# change status & update subscriptionhistory
if ($status eq 6){
- delissue($serialseq, $subscriptionid);
+ delissue($serialseq, $subscriptionid)
}else{
$sth = $dbh->prepare("update serial set serialseq=?,planneddate=?,status=? where serialid = ?");
$sth->execute($serialseq,$planneddate,$status,$serialid);
$sth=$dbh->prepare("update subscriptionhistory set recievedlist=?, missinglist=? where subscriptionid=?");
$sth->execute($recievedlist,$missinglist,$subscriptionid);
}
-
# create new waited entry if needed (ie : was a "waited" and has changed)
if ($oldstatus eq 1 && $status ne 1) {
$sth = $dbh->prepare("select * from subscription where subscriptionid = ? ");
$sth->execute($recievedlist,$missinglist,$subscriptionid);
}
+sub delissue {
+ my ($serialseq,$subscriptionid) = @_;
+ my $dbh = C4::Context->dbh;
+ my $sth = $dbh->prepare("delete from serial where serialseq= ? and subscriptionid= ? ");
+ $sth->execute($serialseq,$subscriptionid);
+}
+
sub Get_Next_Date(@) {
my ($planneddate,$subscription) = @_;
my $resultdate;
unless ($iteminformation->{barcode}) {
$issuingimpossible{UNKNOWN_BARCODE} = 1;
}
- if ($iteminformation->{'notforloan'} && $iteminformation->{'notforloan'} > 0) {
+ if ($iteminformation->{'notforloan'} > 0) {
$issuingimpossible{NOT_FOR_LOAN} = 1;
}
if ($iteminformation->{'itemtype'} &&$iteminformation->{'itemtype'} eq 'REF') {
my $retval = {};
$stopwordlist->{$stopword} = uc($stopword);
}
+ $stopwordlist->{A} = "A" unless $stopwordlist;
return $stopwordlist;
}
Returns the scrolling list with name $input_name, built on authorised Values named $name.
Returns NULL if no authorised values found
+=item buildCGISort
+
+ $CGIScrollingList = &BuildCGISort($name string, $input_name string);
+
+Returns the scrolling list with name $input_name, built on authorised Values named $name.
+Returns NULL if no authorised values found
+
=cut
-#'
-#--------------------------------------
-# Determine if a number is a valid ISBN number, according to length
-# of 10 digits and valid checksum
sub buildCGIsort {
use strict;
my ($name,$input_name,$data) = @_;
-default=> $data,
-size => 1,
-multiple => 0);
- }
+ }
+ $sth->finish;
return $CGISort;
}
END { } # module clean-up code here (global destructor)
$marcflavour ("MARC21" or "UNIMARC") determines which tags are used for retrieving subjects.
=cut
+=head2 my $marcurlsarray = &getMARCurls($dbh,$bibid,$marcflavour);
+Returns a reference to an array containing all the URLS stored in the MARC database for the given bibid.
+$marcflavour ("MARC21" or "UNIMARC") isn't used in this version because both flavours of MARC use the same subfield for URLS (but eventually when we get the lables working we'll need to change this.
+
+=cut
sub catalogsearch {
my ($dbh, $tags, $and_or, $excluding, $operator, $value, $offset,$length,$orderby,$desc_or_asc,$sqlstring, $extratables) = @_;
# build the sql request. She will look like :
}
$sth->finish;
- $dbh->disconnect;
my $marcnotesarray=\@marcnotes;
return $marcnotesarray;
}
$sth->finish;
- $dbh->disconnect;
my $marcsubjctsarray=\@marcsubjcts;
return $marcsubjctsarray;