[Koha-cvs] koha acqui/neworderbiblio.pl acqui/orderreceive...
paul poulain
paul at koha-fr.org
Fri Mar 9 16:34:17 CET 2007
CVSROOT: /sources/koha
Module name: koha
Changes by: paul poulain <tipaul> 07/03/09 15:34:17
Added files:
acqui : neworderbiblio.pl orderreceive.pl parcels.pl
spent.pl
admin : biblio_framework.pl koha2marclinks.pl
marc_subfields_structure.pl marctagstructure.pl
Log message:
rel_3_0 moved to HEAD (introducing new files)
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/neworderbiblio.pl?cvsroot=koha&rev=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/orderreceive.pl?cvsroot=koha&rev=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/parcels.pl?cvsroot=koha&rev=1.4
http://cvs.savannah.gnu.org/viewcvs/koha/acqui/spent.pl?cvsroot=koha&rev=1.3
http://cvs.savannah.gnu.org/viewcvs/koha/admin/biblio_framework.pl?cvsroot=koha&rev=1.6
http://cvs.savannah.gnu.org/viewcvs/koha/admin/koha2marclinks.pl?cvsroot=koha&rev=1.15
http://cvs.savannah.gnu.org/viewcvs/koha/admin/marc_subfields_structure.pl?cvsroot=koha&rev=1.40
http://cvs.savannah.gnu.org/viewcvs/koha/admin/marctagstructure.pl?cvsroot=koha&rev=1.34
Patches:
Index: acqui/neworderbiblio.pl
===================================================================
RCS file: acqui/neworderbiblio.pl
diff -N acqui/neworderbiblio.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ acqui/neworderbiblio.pl 9 Mar 2007 15:34:17 -0000 1.4
@@ -0,0 +1,136 @@
+#!/usr/bin/perl
+
+#origninally script to provide intranet (librarian) advanced search facility
+#now script to do searching for acquisitions
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+neworderbiblio.pl
+
+=head1 DESCRIPTION
+
+this script allows to perform a new order from an existing record.
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item search
+the title the librarian has typed to search an existing record.
+
+=item q
+the keyword the librarian has typed to search an existing record.
+
+=item author
+the author of the new record.
+
+=item num
+the number of result per page to display
+
+=item booksellerid
+the id of the bookseller this script has to add an order.
+
+=item basketno
+the basket number to know on which basket this script have to add a new order.
+
+=back
+
+=cut
+
+use strict;
+use C4::Search;
+use CGI;
+use C4::Output;
+use C4::Bookseller;
+use C4::Biblio;
+
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Koha;
+
+my $input = new CGI;
+
+#getting all CGI params into a hash.
+my $params = $input->Vars;
+
+my $offset = $params->{'offset'} || 0;
+my $query = $params->{'q'};
+my $num = $params->{'num'};
+$num = 20 unless $num;
+
+my $booksellerid = $params->{'booksellerid'};
+my $basketno = $params->{'basketno'};
+my $sub = $params->{'sub'};
+
+# getting the template
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "acqui/neworderbiblio.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { acquisition => 1 },
+ }
+);
+
+# Searching the catalog.
+my ($error, $marcresults) = SimpleSearch($query);
+
+if (defined $error) {
+ $template->param(query_error => $error);
+ warn "error: ".$error;
+ output_html_with_http_headers $input, $cookie, $template->output;
+ exit;
+}
+
+my $hits = scalar @$marcresults;
+my @results;
+
+for(my $i=0;$i<$hits;$i++) {
+ my %resultsloop;
+ my $marcrecord = MARC::File::USMARC::decode($marcresults->[$i]);
+ my $biblio = MARCmarc2koha(C4::Context->dbh,$marcrecord,'');
+
+ #build the hash for the template.
+ %resultsloop=%$biblio;
+ $resultsloop{highlight} = ($i % 2)?(1):(0);
+
+ push @results, \%resultsloop;
+}
+
+$template->param(
+ basketno => $basketno,
+ booksellerid => $booksellerid,
+ resultsloop => \@results,
+ total => $hits,
+ query => $query,
+ virtualshelves => C4::Context->preference("virtualshelves"),
+ LibraryName => C4::Context->preference("LibraryName"),
+ OpacNav => C4::Context->preference("OpacNav"),
+ opaccredits => C4::Context->preference("opaccredits"),
+ AmazonContent => C4::Context->preference("AmazonContent"),
+ opacsmallimage => C4::Context->preference("opacsmallimage"),
+ opaclayoutstylesheet => C4::Context->preference("opaclayoutstylesheet"),
+ opaccolorstylesheet => C4::Context->preference("opaccolorstylesheet"),
+ "BiblioDefaultView".C4::Context->preference("IntranetBiblioDefaultView") => 1,
+);
+
+# BUILD THE TEMPLATE
+output_html_with_http_headers $input, $cookie, $template->output;
Index: acqui/orderreceive.pl
===================================================================
RCS file: acqui/orderreceive.pl
diff -N acqui/orderreceive.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ acqui/orderreceive.pl 9 Mar 2007 15:34:17 -0000 1.4
@@ -0,0 +1,232 @@
+#!/usr/bin/perl
+
+# $Id: orderreceive.pl,v 1.4 2007/03/09 15:34:17 tipaul Exp $
+
+#script to recieve orders
+#written by chris at katipo.co.nz 24/2/2000
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+orderreceive.pl
+
+=head1 DESCRIPTION
+This script shows all order already receive and all pendings orders.
+It permit to write a new order as 'received'.
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item supplierid
+to know on what supplier this script has to display receive order.
+
+=item recieve
+
+=item invoice
+the number of this invoice.
+
+=item freight
+
+=item biblio
+The biblionumber of this order.
+
+=item daterecieved
+
+=item catview
+
+=item gst
+
+=back
+
+=cut
+
+use strict;
+use CGI;
+use C4::Context;
+use C4::Koha; # GetKohaAuthorisedValues GetItemTypes
+use C4::Acquisition;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Date;
+use C4::Bookseller;
+use C4::Members;
+use C4::Branch; # GetBranches
+
+my $input = new CGI;
+my $supplierid = $input->param('supplierid');
+my $dbh = C4::Context->dbh;
+
+my $search = $input->param('recieve');
+my $invoice = $input->param('invoice');
+my $freight = $input->param('freight');
+my $biblionumber = $input->param('biblionumber');
+my $daterecieved = $input->param('daterecieved') || format_date(join "-",Date::Calc::Today());
+my $catview = $input->param('catview');
+my $gst = $input->param('gst');
+
+my @results = SearchOrder( $search, $supplierid, $biblionumber, $catview );
+my $count = scalar @results;
+
+my @booksellers = GetBookSeller( $results[0]->{'booksellerid'} );
+
+my $date = $results[0]->{'entrydate'};
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "acqui/orderreceive.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { acquisition => 1 },
+ debug => 1,
+ }
+);
+$template->param($count);
+
+if ( $count == 1 ) {
+
+ my $itemtypes = GetItemTypes;
+ my @itemtypesloop;
+ foreach my $thisitemtype (sort keys %$itemtypes) {
+ my %row = (
+ value => $thisitemtype,
+ description => $itemtypes->{$thisitemtype}->{'description'},
+ );
+ push @itemtypesloop, \%row;
+ }
+
+ $template->param(itemtypeloop => \@itemtypesloop);
+
+
+ my $locations = GetKohaAuthorisedValues( 'items.location' );
+ if ($locations) {
+ my @location_codes = keys %$locations;
+ my $CGIlocation = CGI::scrolling_list(
+ -name => 'location',
+ -id => 'location',
+ -values => \@location_codes,
+ -default => $results[0]->{'itemtype'},
+ -labels => $locations,
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0
+ );
+ $template->param( CGIlocation => $CGIlocation );
+ }
+ my $onlymine=C4::Context->preference('IndependantBranches') &&
+ C4::Context->userenv &&
+ C4::Context->userenv->{flags} !=1 &&
+ C4::Context->userenv->{branch};
+ my $branches = GetBranches($onlymine);
+ my @branchloop;
+ foreach my $thisbranch ( sort keys %$branches ) {
+ my %row = (
+ value => $thisbranch,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+ }
+
+ my $auto_barcode = C4::Context->boolean_preference("autoBarcode") || 0;
+
+ # See whether barcodes should be automatically allocated.
+ # Defaults to 0, meaning "no".
+ my $barcode;
+ if ( $auto_barcode ) {
+ my $sth = $dbh->prepare("Select max(barcode) from items");
+ $sth->execute;
+ my $data = $sth->fetchrow_hashref;
+ $barcode = $results[0]->{'barcode'} + 1;
+ $sth->finish;
+ }
+
+ if ( $results[0]->{'quantityreceived'} == 0 ) {
+ $results[0]->{'quantityreceived'} = '';
+ }
+ if ( $results[0]->{'unitprice'} == 0 ) {
+ $results[0]->{'unitprice'} = '';
+ }
+ $results[0]->{'copyrightdate'} =
+ format_date( $results[0]->{'copyrightdate'} );
+ $template->param(
+ branchloop => \@branchloop,
+ count => 1,
+ biblionumber => $results[0]->{'biblionumber'},
+ ordernumber => $results[0]->{'ordernumber'},
+ biblioitemnumber => $results[0]->{'biblioitemnumber'},
+ supplierid => $results[0]->{'booksellerid'},
+ freight => $freight,
+ gst => $gst,
+ catview => ( $catview ne 'yes' ? 1 : 0 ),
+ name => $booksellers[0]->{'name'},
+ date => format_date($date),
+ title => $results[0]->{'title'},
+ author => $results[0]->{'author'},
+ copyrightdate => format_date( $results[0]->{'copyrightdate'} ),
+ itemtype => $results[0]->{'itemtype'},
+ isbn => $results[0]->{'isbn'},
+ seriestitle => $results[0]->{'seriestitle'},
+ barcode => $barcode,
+ bookfund => $results[0]->{'bookfundid'},
+ quantity => $results[0]->{'quantity'},
+ quantityreceivedplus1 => $results[0]->{'quantityreceived'} + 1,
+ quantityreceived => $results[0]->{'quantityreceived'},
+ rrp => $results[0]->{'rrp'},
+ ecost => $results[0]->{'ecost'},
+ unitprice => $results[0]->{'unitprice'},
+ invoice => $invoice,
+ daterecieved => $daterecieved,
+ notes => $results[0]->{'notes'},
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+}
+else {
+ my @loop;
+ for ( my $i = 0 ; $i < $count ; $i++ ) {
+ my %line = %{ $results[$i] };
+
+ $line{invoice} = $invoice;
+ $line{daterecieved} = $daterecieved;
+ $line{freight} = $freight;
+ $line{gst} = $gst;
+ $line{title} = $results[$i]->{'title'};
+ $line{author} = $results[$i]->{'author'};
+ $line{supplierid} = $supplierid;
+ push @loop, \%line;
+ }
+ $template->param(
+ loop => \@loop,
+ date => format_date($date),
+ daterecieved => $daterecieved,
+ name => $booksellers[0]->{'name'},
+ supplierid => $supplierid,
+ invoice => $invoice,
+ daterecieved => $daterecieved,
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+
+}
+output_html_with_http_headers $input, $cookie, $template->output;
Index: acqui/parcels.pl
===================================================================
RCS file: acqui/parcels.pl
diff -N acqui/parcels.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ acqui/parcels.pl 9 Mar 2007 15:34:17 -0000 1.4
@@ -0,0 +1,172 @@
+#!/usr/bin/perl
+
+# $Id: parcels.pl,v 1.4 2007/03/09 15:34:17 tipaul Exp $
+
+#script to show display basket of orders
+#written by chris at katipo.co.nz 24/2/2000
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+=head1 NAME
+
+parcels.pl
+
+=head1 DESCRIPTION
+This script shows all orders/parcels receipt or pending for a given supplier.
+It allows to write an order/parcels as 'received' when he arrives.
+
+=head1 CGI PARAMETERS
+
+=over 4
+
+=item supplierid
+To know the supplier this script has to show orders.
+
+=item orderby
+sort list of order by 'orderby'.
+Orderby can be equals to
+ * datereceived desc (default value)
+ * aqorders.booksellerinvoicenumber
+ * datereceived
+ * aqorders.booksellerinvoicenumber desc
+
+=item filter
+
+=item datefrom
+To filter on date
+
+=item dateto
+To filter on date
+
+=item resultsperpage
+To know how many results have to be display / page.
+
+=back
+
+=cut
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Output;
+use C4::Interface::CGI::Output;
+
+use C4::Date;
+
+use C4::Acquisition;
+use C4::Bookseller;
+
+my $input=new CGI;
+my $supplierid=$input->param('supplierid');
+my $order=$input->param('orderby') || "datereceived desc";
+my $startfrom=$input->param('startfrom');
+my $code=$input->param('filter');
+my $datefrom=$input->param('datefrom');
+my $dateto=$input->param('dateto');
+my $resultsperpage = $input->param('resultsperpage');
+
+my @booksellers=GetBookSeller($supplierid);
+my $count = scalar @booksellers;
+
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "acqui/parcels.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {acquisition => 1},
+ debug => 1,
+});
+
+
+$resultsperpage = 20 unless ($resultsperpage);
+my @results =GetParcels($supplierid, $order, $code,$datefrom,$dateto);
+$count = scalar @results;
+
+# multi page display gestion
+$startfrom=0 unless ($startfrom);
+if ($count>$resultsperpage){
+ my $displaynext=0;
+ my $displayprev=$startfrom;
+ if(($count - ($startfrom+$resultsperpage)) > 0 ) {
+ $displaynext = 1;
+ }
+
+ my @numbers = ();
+ if ($count>$resultsperpage) {
+ for (my $i=1; $i<$count/$resultsperpage+1; $i++) {
+ if ($i<16) {
+ my $highlight=0;
+ ($startfrom/$resultsperpage==($i-1)) && ($highlight=1);
+ push @numbers, { number => $i,
+ highlight => $highlight ,
+# searchdata=> "test",
+ startfrom => ($i-1)*$resultsperpage};
+ }
+ }
+ }
+
+ my $from = $startfrom*$resultsperpage+1;
+ my $to;
+ if($count < (($startfrom+1)*$resultsperpage)){
+ $to = $count;
+ } else {
+ $to = (($startfrom+1)*$resultsperpage);
+ }
+ $template->param(numbers=>\@numbers,
+ displaynext=>$displaynext,
+ displayprev=>$displayprev,
+ nextstartfrom=>(($startfrom+$resultsperpage<$count)?$startfrom+$resultsperpage:$count),
+ prevstartfrom=>(($startfrom-$resultsperpage>0)?$startfrom-$resultsperpage:0)
+ );
+}
+my @loopres;
+
+my $hilighted=0;
+for (my $i=$startfrom;$i<=($startfrom+$resultsperpage-1<$count-1?$startfrom+$resultsperpage-1:$count-1);$i++){
+### startfrom: $startfrom
+### resultsperpage: $resultsperpage
+### count: $count
+### code: $results[$i]->{booksellerinvoicenumber}
+### datereceived: $results[$i]->{datereceived}
+
+ my %cell;
+ $cell{number}=$i+1;
+ $cell{code}=$results[$i]->{booksellerinvoicenumber};
+ $cell{nullcode}=$results[$i]->{booksellerinvoicenumber} eq "NULL";
+ $cell{emptycode}=$results[$i]->{booksellerinvoicenumber} eq '';
+ $cell{raw_datereceived}=$results[$i]->{datereceived};
+ $cell{datereceived}=format_date($results[$i]->{datereceived});
+ $cell{bibcount}=$results[$i]->{biblio};
+ $cell{reccount}=$results[$i]->{itemsreceived};
+ $cell{itemcount}=$results[$i]->{itemsexpected};
+ $cell{hilighted} = $hilighted%2;
+ $hilighted++;
+ push @loopres, \%cell;
+}
+$template->param(searchresults=>\@loopres, count=>$count) if ($count);
+$template->param(orderby=>$order, filter=>$code, datefrom=>$datefrom,dateto=>$dateto, resultsperpage=>$resultsperpage);
+$template->param(
+ name => $booksellers[0]->{'name'},
+ supplierid => $supplierid,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+
+output_html_with_http_headers $input, $cookie, $template->output;
Index: acqui/spent.pl
===================================================================
RCS file: acqui/spent.pl
diff -N acqui/spent.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ acqui/spent.pl 9 Mar 2007 15:34:17 -0000 1.3
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+
+# script to show a breakdown of committed and spent budgets
+
+# needs to be templated at some point
+
+use C4::Context;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use strict;
+use CGI;
+
+my $dbh = C4::Context->dbh;
+my $input = new CGI;
+my $bookfund = $input->param('bookfund');
+my $start = $input->param('start');
+my $end = $input->param('end');
+
+my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
+ {
+ template_name => "acqui/spent.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { acquisition => 1 },
+ debug => 1,
+ }
+);
+
+my $query =
+"Select quantity,datereceived,freight,unitprice,listprice,ecost,quantityreceived
+ as qrev,subscription,title,itemtype,aqorders.biblionumber,aqorders.booksellerinvoicenumber,
+ quantity-quantityreceived as tleft,
+ aqorders.ordernumber
+ as ordnum,entrydate,budgetdate,booksellerid,aqbasket.basketno
+ from aqorders,aqorderbreakdown,aqbasket
+ left join biblioitems on biblioitems.biblioitemnumber=aqorders.biblioitemnumber
+ where bookfundid=? and
+ aqorders.ordernumber=aqorderbreakdown.ordernumber and
+ aqorders.basketno=aqbasket.basketno
+ and (
+ (datereceived >= ? and datereceived < ?))
+ and (datecancellationprinted is NULL or
+ datecancellationprinted='0000-00-00')
+
+
+ ";
+my $sth = $dbh->prepare($query);
+$sth->execute( $bookfund, $start, $end );
+
+my $total = 0;
+my $toggle;
+my @spent_loop;
+while ( my $data = $sth->fetchrow_hashref ) {
+ my $recv = $data->{'qrev'};
+ if ( $recv > 0 ) {
+ my $subtotal = $recv * $data->{'unitprice'};
+ $data->{'subtotal'} = $subtotal;
+ $data->{'unitprice'} += 0;
+ $total += $subtotal;
+ if ($toggle) {
+ $toggle = 0;
+ }
+ else {
+ $toggle = 1;
+ }
+ $data->{'toggle'} = $toggle;
+ push @spent_loop, $data;
+ }
+
+}
+
+$template->param(
+ SPENTLOOP => \@spent_loop,
+ total => $total
+);
+$sth->finish;
+
+$dbh->disconnect;
+output_html_with_http_headers $input, $cookie, $template->output;
Index: admin/biblio_framework.pl
===================================================================
RCS file: admin/biblio_framework.pl
diff -N admin/biblio_framework.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ admin/biblio_framework.pl 9 Mar 2007 15:34:17 -0000 1.6
@@ -0,0 +1,180 @@
+#!/usr/bin/perl
+# NOTE: 4-character tabs
+
+#written 20/02/2002 by paul.poulain at free.fr
+# This software is placed under the gnu General Public License, v2 (http://www.gnu.org/licenses/gpl.html)
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Context;
+use C4::Output;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+
+
+sub StringSearch {
+ my ($env,$searchstring,$type)=@_;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my $count=@data;
+ my $sth=$dbh->prepare("Select * from biblio_framework where (frameworkcode like ?) order by frameworktext");
+ $sth->execute("$data[0]%");
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ }
+ # $sth->execute;
+ $sth->finish;
+ return (scalar(@results),\@results);
+}
+
+my $input = new CGI;
+my $searchfield=$input->param('frameworkcode');
+my $offset=$input->param('offset');
+my $script_name="/cgi-bin/koha/admin/biblio_framework.pl";
+my $frameworkcode=$input->param('frameworkcode');
+my $pagesize=20;
+my $op = $input->param('op');
+$searchfield=~ s/\,//g;
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name => "admin/biblio_framework.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+if ($op) {
+$template->param(script_name => $script_name,
+ $op => 1); # we show only the TMPL_VAR names $op
+} else {
+$template->param(script_name => $script_name,
+ else => 1); # we show only the TMPL_VAR names $op
+}
+
+
+
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ($op eq 'add_form') {
+ #start the page and read in includes
+ #---- if primkey exists, it's a modify action, so read values to modify...
+ my $data;
+ if ($frameworkcode) {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ }
+ $template->param(frameworkcode => $frameworkcode,
+ frameworktext => $data->{'frameworktext'},
+ );
+;
+ # END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+# called by add_form, used to insert/modify data in DB
+} elsif ($op eq 'add_validate') {
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("replace biblio_framework (frameworkcode,frameworktext) values (?,?)");
+ $sth->execute($input->param('frameworkcode'),$input->param('frameworktext'));
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=biblio_framework.pl\"></html>";
+ exit;
+ # END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+# called by default form, used to confirm deletion of data in DB
+} elsif ($op eq 'delete_confirm') {
+ #start the page and read in includes
+ my $dbh = C4::Context->dbh;
+
+ # Check both categoryitem and biblioitems, see Bug 199
+ my $total = 0;
+ for my $table ('marc_tag_structure') {
+ my $sth=$dbh->prepare("select count(*) as total from $table where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ $total += $sth->fetchrow_hashref->{total};
+ $sth->finish;
+ }
+
+ my $sth=$dbh->prepare("select * from biblio_framework where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+
+ $template->param(frameworkcode => $frameworkcode,
+ frameworktext => $data->{'frameworktext'},
+ total => $total);
+ # END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+# called by delete_confirm, used to effectively confirm deletion of data in DB
+} elsif ($op eq 'delete_confirmed') {
+ #start the page and read in includes
+ my $dbh = C4::Context->dbh;
+ my $frameworkcode=uc($input->param('frameworkcode'));
+ my $sth=$dbh->prepare("delete from marc_tag_structure where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ $sth=$dbh->prepare("delete from marc_subfield_structure where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ $sth=$dbh->prepare("delete from biblio_framework where frameworkcode=?");
+ $sth->execute($frameworkcode);
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=biblio_framework.pl\"></html>";
+ exit;
+ # END $OP eq DELETE_CONFIRMED
+################## DEFAULT ##################################
+} else { # DEFAULT
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,'web');
+ my $toggle="white";
+ my @loop_data;
+ for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ my %row_data;
+ if ($toggle eq 'white'){
+ $row_data{toggle}="#ffffcc";
+ } else {
+ $row_data{toggle}="white";
+ }
+ $row_data{frameworkcode} = $results->[$i]{'frameworkcode'};
+ $row_data{frameworktext} = $results->[$i]{'frameworktext'};
+ push(@loop_data, \%row_data);
+ }
+ $template->param(loop => \@loop_data);
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param(previous => "$script_name?offset=".$prevpage);
+ }
+ if ($offset+$pagesize<$count) {
+ my $nextpage =$offset+$pagesize;
+ $template->param(next => "$script_name?offset=".$nextpage);
+ }
+} #---- END $OP eq DEFAULT
+$template->param(intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+output_html_with_http_headers $input, $cookie, $template->output;
+
+# Local Variables:
+# tab-width: 4
+# End:
Index: admin/koha2marclinks.pl
===================================================================
RCS file: admin/koha2marclinks.pl
diff -N admin/koha2marclinks.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ admin/koha2marclinks.pl 9 Mar 2007 15:34:17 -0000 1.15
@@ -0,0 +1,189 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Auth;
+use CGI;
+use C4::Context;
+use C4::Biblio;
+
+
+my $input = new CGI;
+my $tablename = $input->param('tablename');
+$tablename = "biblio" unless ($tablename);
+my $kohafield = $input->param('kohafield');
+my $op = $input->param('op');
+my $script_name = 'koha2marclinks.pl';
+
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user (
+ {
+ template_name => "admin/koha2marclinks.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { parameters => 1 },
+ debug => 1,
+ }
+);
+
+if ($op) {
+ $template->param(
+ script_name => $script_name,
+ $op => 1
+ ); # we show only the TMPL_VAR names $op
+}
+else {
+ $template->param(
+ script_name => $script_name,
+ else => 1
+ ); # we show only the TMPL_VAR names $op
+}
+
+my $dbh = C4::Context->dbh;
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ( $op eq 'add_form' ) {
+ my $data;
+ my $sth =
+ $dbh->prepare(
+"select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure where kohafield=?"
+ );
+ $sth->execute( $tablename . "." . $kohafield );
+ my ( $defaulttagfield, $defaulttagsubfield, $defaultliblibrarian ) =
+ $sth->fetchrow;
+
+ for ( my $i = 0 ; $i <= 9 ; $i++ ) {
+ my $sth2 =
+ $dbh->prepare(
+"select tagfield,tagsubfield,liblibrarian as lib,tab from marc_subfield_structure where tagfield like ?"
+ );
+ $sth2->execute("$i%");
+ my @marcarray;
+ push @marcarray, " ";
+ while ( my ( $field, $tagsubfield, $liblibrarian ) =
+ $sth2->fetchrow_array )
+ {
+ push @marcarray, "$field $tagsubfield - $liblibrarian";
+ }
+ my $marclist = CGI::scrolling_list(
+ -name => "marc",
+ -values => \@marcarray,
+ -default =>
+ "$defaulttagfield $defaulttagsubfield - $defaultliblibrarian",
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $template->param( "marclist$i" => $marclist );
+ }
+ $template->param(
+ tablename => $tablename,
+ kohafield => $kohafield
+ );
+
+ # END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+ # called by add_form, used to insert/modify data in DB
+}
+elsif ( $op eq 'add_validate' ) {
+
+ #----- empty koha field :
+ $dbh->do(
+"update marc_subfield_structure set kohafield='' where kohafield='$tablename.$kohafield'"
+ );
+
+ #---- reload if not empty
+ my @temp = split / /, $input->param('marc');
+ $dbh->do(
+"update marc_subfield_structure set kohafield='$tablename.$kohafield' where tagfield='$temp[0]' and tagsubfield='$temp[1]'"
+ );
+ print
+"Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=koha2marclinks.pl?tablename=$tablename\"></html>";
+ exit;
+
+ # END $OP eq ADD_VALIDATE
+################## DEFAULT ##################################
+}
+else { # DEFAULT
+ my $env;
+ my $sth =
+ $dbh->prepare(
+"Select tagfield,tagsubfield,liblibrarian,kohafield from marc_subfield_structure"
+ );
+ $sth->execute;
+ my %fields;
+ while ( ( my $tagfield, my $tagsubfield, my $liblibrarian, my $kohafield ) =
+ $sth->fetchrow )
+ {
+ $fields{$kohafield}->{tagfield} = $tagfield;
+ $fields{$kohafield}->{tagsubfield} = $tagsubfield;
+ $fields{$kohafield}->{liblibrarian} = $liblibrarian;
+ }
+
+ #XXX: This might not work. Maybe should use a DBI call instead of SHOW COLUMNS
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from $tablename");
+ $sth2->execute;
+
+ my $toggle = "white";
+ my @loop_data = ();
+ while ( ( my $field ) = $sth2->fetchrow_array ) {
+ if ( $toggle eq 'white' ) {
+ $toggle = "#ffffcc";
+ }
+ else {
+ $toggle = "white";
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $fields{ $tablename . "." . $field }->{tagfield};
+ $row_data{tagsubfield} =
+ $fields{ $tablename . "." . $field }->{tagsubfield};
+ $row_data{liblibrarian} =
+ $fields{ $tablename . "." . $field }->{liblibrarian};
+ $row_data{kohafield} = $field;
+ $row_data{edit} =
+"$script_name?op=add_form&tablename=$tablename&kohafield=$field";
+ $row_data{bgcolor} = $toggle;
+ push( @loop_data, \%row_data );
+ }
+ $template->param(
+ loop => \@loop_data,
+ tablename => CGI::scrolling_list(
+ -name => 'tablename',
+ -values => [
+ 'biblio',
+ 'biblioitems',
+ 'items',
+ ],
+ -default => $tablename,
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0
+ )
+ );
+} #---- END $OP eq DEFAULT
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+output_html_with_http_headers $input, $cookie, $template->output;
Index: admin/marc_subfields_structure.pl
===================================================================
RCS file: admin/marc_subfields_structure.pl
diff -N admin/marc_subfields_structure.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ admin/marc_subfields_structure.pl 9 Mar 2007 15:34:17 -0000 1.40
@@ -0,0 +1,570 @@
+#!/usr/bin/perl
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Auth;
+use CGI;
+use C4::Context;
+
+
+sub StringSearch {
+ my ( $env, $searchstring, $frameworkcode ) = @_;
+ my $dbh = C4::Context->dbh;
+ $searchstring =~ s/\'/\\\'/g;
+ my @data = split( ' ', $searchstring );
+ my $count = @data;
+ my $sth =
+ $dbh->prepare(
+"Select * from marc_subfield_structure where (tagfield like ? and frameworkcode=?) order by tagfield"
+ );
+ $sth->execute( "$searchstring%", $frameworkcode );
+ my @results;
+ my $cnt = 0;
+ my $u = 1;
+
+ while ( my $data = $sth->fetchrow_hashref ) {
+ push( @results, $data );
+ $cnt++;
+ $u++;
+ }
+ $sth->finish;
+ $dbh->disconnect;
+ return ( $cnt, \@results );
+}
+
+my $input = new CGI;
+my $tagfield = $input->param('tagfield');
+my $tagsubfield = $input->param('tagsubfield');
+my $frameworkcode = $input->param('frameworkcode');
+my $pkfield = "tagfield";
+my $offset = $input->param('offset');
+my $script_name = "/cgi-bin/koha/admin/marc_subfields_structure.pl";
+
+my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
+ {
+ template_name => "admin/marc_subfields_structure.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => { parameters => 1 },
+ debug => 1,
+ }
+);
+my $pagesize = 30;
+my $op = $input->param('op');
+$tagfield =~ s/\,//g;
+
+if ($op) {
+ $template->param(
+ script_name => $script_name,
+ tagfield => $tagfield,
+ frameworkcode => $frameworkcode,
+ $op => 1
+ ); # we show only the TMPL_VAR names $op
+}
+else {
+ $template->param(
+ script_name => $script_name,
+ tagfield => $tagfield,
+ frameworkcode => $frameworkcode,
+ else => 1
+ ); # we show only the TMPL_VAR names $op
+}
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ( $op eq 'add_form' ) {
+ my $data;
+ my $dbh = C4::Context->dbh;
+ my $more_subfields = $input->param("more_subfields") + 1;
+
+ # builds kohafield tables
+ my @kohafields;
+ push @kohafields, "";
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from biblio");
+ $sth2->execute;
+ while ( ( my $field ) = $sth2->fetchrow_array ) {
+ push @kohafields, "biblio." . $field;
+ }
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from biblioitems");
+ $sth2->execute;
+ while ( ( my $field ) = $sth2->fetchrow_array ) {
+ if ( $field eq 'notes' ) { $field = 'bnotes'; }
+ push @kohafields, "biblioitems." . $field;
+ }
+ my $sth2 = $dbh->prepare("SHOW COLUMNS from items");
+ $sth2->execute;
+ while ( ( my $field ) = $sth2->fetchrow_array ) {
+ push @kohafields, "items." . $field;
+ }
+
+ # build authorised value list
+ $sth2->finish;
+ $sth2 = $dbh->prepare("select distinct category from authorised_values");
+ $sth2->execute;
+ my @authorised_values;
+ push @authorised_values, "";
+ while ( ( my $category ) = $sth2->fetchrow_array ) {
+ push @authorised_values, $category;
+ }
+ push( @authorised_values, "branches" );
+ push( @authorised_values, "itemtypes" );
+
+ # build thesaurus categories list
+ $sth2->finish;
+ $sth2 = $dbh->prepare("select authtypecode from auth_types");
+ $sth2->execute;
+ my @authtypes;
+ push @authtypes, "";
+ while ( ( my $authtypecode ) = $sth2->fetchrow_array ) {
+ push @authtypes, $authtypecode;
+ }
+
+ # build value_builder list
+ my @value_builder = ('');
+
+ # read value_builder directory.
+ # 2 cases here : on CVS install, $cgidir does not need a /cgi-bin
+ # on a standard install, /cgi-bin need to be added.
+ # test one, then the other
+ my $cgidir = C4::Context->intranetdir . "/cgi-bin";
+ unless ( opendir( DIR, "$cgidir/cataloguing/value_builder" ) ) {
+ $cgidir = C4::Context->intranetdir;
+ opendir( DIR, "$cgidir/cataloguing/value_builder" )
+ || die "can't opendir $cgidir/value_builder: $!";
+ }
+ while ( my $line = readdir(DIR) ) {
+ if ( $line =~ /\.pl$/ ) {
+ push( @value_builder, $line );
+ }
+ }
+ closedir DIR;
+
+ # build values list
+ my $sth =
+ $dbh->prepare(
+"select * from marc_subfield_structure where tagfield=? and frameworkcode=?"
+ ); # and tagsubfield='$tagsubfield'");
+ $sth->execute( $tagfield, $frameworkcode );
+ my @loop_data = ();
+ my $toggle = 1;
+ my $i = 0;
+ while ( $data = $sth->fetchrow_hashref ) {
+ my %row_data; # get a fresh hash for the row data
+ if ( $toggle eq 1 ) {
+ $toggle = 0;
+ }
+ else {
+ $toggle = 1;
+ }
+ $row_data{tab} = CGI::scrolling_list(
+ -name => 'tab',
+ -id => "tab$i",
+ -values =>
+ [ '-1', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10' ],
+ -labels => {
+ '-1' => 'ignore',
+ '0' => '0',
+ '1' => '1',
+ '2' => '2',
+ '3' => '3',
+ '4' => '4',
+ '5' => '5',
+ '6' => '6',
+ '7' => '7',
+ '8' => '8',
+ '9' => '9',
+ '10' => 'items (10)',
+ },
+ -default => $data->{'tab'},
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{tagsubfield} =
+ $data->{'tagsubfield'}
+ . "<input type=\"hidden\" name=\"tagsubfield\" value=\""
+ . $data->{'tagsubfield'}
+ . "\" id=\"tagsubfield\">";
+ $row_data{liblibrarian} = CGI::escapeHTML( $data->{'liblibrarian'} );
+ $row_data{libopac} = CGI::escapeHTML( $data->{'libopac'} );
+ $row_data{seealso} = CGI::escapeHTML( $data->{'seealso'} );
+ $row_data{kohafield} = CGI::scrolling_list(
+ -name => "kohafield",
+ -id => "kohafield$i",
+ -values => \@kohafields,
+ -default => "$data->{'kohafield'}",
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{authorised_value} = CGI::scrolling_list(
+ -name => 'authorised_value',
+ -id => 'authorised_value',
+ -values => \@authorised_values,
+ -default => $data->{'authorised_value'},
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{value_builder} = CGI::scrolling_list(
+ -name => 'value_builder',
+ -id => 'value_builder',
+ -values => \@value_builder,
+ -default => $data->{'value_builder'},
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{authtypes} = CGI::scrolling_list(
+ -name => 'authtypecode',
+ -id => 'authtypecode',
+ -values => \@authtypes,
+ -default => $data->{'authtypecode'},
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{repeatable} = CGI::checkbox(
+ -name => "repeatable$i",
+ -checked => $data->{'repeatable'} ? 'checked' : '',
+ -value => 1,
+ -tabindex => '',
+ -label => '',
+ -id => "repeatable$i"
+ );
+ $row_data{mandatory} = CGI::checkbox(
+ -name => "mandatory$i",
+ -checked => $data->{'mandatory'} ? 'checked' : '',
+ -value => 1,
+ -tabindex => '',
+ -label => '',
+ -id => "mandatory$i"
+ );
+ $row_data{hidden} = CGI::escapeHTML( $data->{hidden} );
+ $row_data{isurl} = CGI::checkbox(
+ -name => "isurl$i",
+ -id => "isurl$i",
+ -checked => $data->{'isurl'} ? 'checked' : '',
+ -value => 1,
+ -tabindex => '',
+ -label => ''
+ );
+ $row_data{row} = $i;
+ $row_data{toggle} = $toggle;
+ $row_data{link} = CGI::escapeHTML( $data->{'link'} );
+ push( @loop_data, \%row_data );
+ $i++;
+ }
+
+ # add more_subfields empty lines for add if needed
+ for ( my $j = $i ; $j <= $more_subfields + $i ; $j++ ) {
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tab} = CGI::scrolling_list(
+ -name => 'tab',
+ -id => "tab$j",
+ -values =>
+ [ '-1', '0', '1', '2', '3', '4', '5', '6', '7', '8', '9', '10' ],
+ -labels => {
+ '-1' => 'ignore',
+ '0' => '0',
+ '1' => '1',
+ '2' => '2',
+ '3' => '3',
+ '4' => '4',
+ '5' => '5',
+ '6' => '6',
+ '7' => '7',
+ '8' => '8',
+ '9' => '9',
+ '10' => 'items (10)',
+ },
+ -default => "",
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{tagsubfield} =
+ "<input type=\"text\" name=\"tagsubfield\" value=\""
+ . $data->{'tagsubfield'}
+ . "\" size=\"1\" id=\"tagsubfield\" maxlength=\"1\">";
+ $row_data{liblibrarian} = "";
+ $row_data{libopac} = "";
+ $row_data{seealso} = "";
+ $row_data{kohafield} = CGI::scrolling_list(
+ -name => 'kohafield',
+ -id => "kohafield$j",
+ -values => \@kohafields,
+ -default => "",
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{hidden} = "";
+ $row_data{repeatable} = CGI::checkbox(
+ -name => "repeatable$j",
+ -id => "repeatable$j",
+ -checked => '',
+ -value => 1,
+ -tabindex => '',
+ -label => ''
+ );
+ $row_data{mandatory} = CGI::checkbox(
+ -name => "mandatory$j",
+ -id => "mandatory$j",
+ -checked => '',
+ -value => 1,
+ -tabindex => '',
+ -label => ''
+ );
+ $row_data{isurl} = CGI::checkbox(
+ -name => "isurl$j",
+ -id => "isurl$j",
+ -checked => '',
+ -value => 1,
+ -tabindex => '',
+ -label => ''
+ );
+ $row_data{value_builder} = CGI::scrolling_list(
+ -name => 'value_builder',
+ -id => 'value_builder',
+ -values => \@value_builder,
+ -default => $data->{'value_builder'},
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{authorised_value} = CGI::scrolling_list(
+ -name => 'authorised_value',
+ -id => 'authorised_value',
+ -values => \@authorised_values,
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{authtypes} = CGI::scrolling_list(
+ -name => 'authtypecode',
+ -id => 'authtypecode',
+ -values => \@authtypes,
+ -size => 1,
+ -tabindex => '',
+ -multiple => 0,
+ );
+ $row_data{link} = CGI::escapeHTML( $data->{'link'} );
+ $row_data{toggle} = $toggle;
+ $row_data{row} = $j;
+ push( @loop_data, \%row_data );
+ }
+ $template->param( 'use-heading-flags-p' => 1 );
+ $template->param( 'heading-edit-subfields-p' => 1 );
+ $template->param(
+ action => "Edit subfields",
+ tagfield =>
+"<input type=\"hidden\" name=\"tagfield\" value=\"$tagfield\">$tagfield",
+ loop => \@loop_data,
+ more_subfields => $more_subfields,
+ more_tag => $tagfield
+ );
+
+ # END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+ # called by add_form, used to insert/modify data in DB
+}
+elsif ( $op eq 'add_validate' ) {
+ my $dbh = C4::Context->dbh;
+ $template->param( tagfield => "$input->param('tagfield')" );
+ my $sth = $dbh->prepare(
+"replace marc_subfield_structure (tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,seealso,authorised_value,authtypecode,value_builder,hidden,isurl,frameworkcode, link)
+ values (?,?,?,?,?,?,?,?,?,?,?,?,?,?,?,?)"
+ );
+ my @tagsubfield = $input->param('tagsubfield');
+ my @liblibrarian = $input->param('liblibrarian');
+ my @libopac = $input->param('libopac');
+ my @kohafield = $input->param('kohafield');
+ my @tab = $input->param('tab');
+ my @seealso = $input->param('seealso');
+ my @hidden = $input->param('hidden');
+ my @authorised_values = $input->param('authorised_value');
+ my @authtypecodes = $input->param('authtypecode');
+ my @value_builder = $input->param('value_builder');
+ my @link = $input->param('link');
+
+ for ( my $i = 0 ; $i <= $#tagsubfield ; $i++ ) {
+ my $tagfield = $input->param('tagfield');
+ my $tagsubfield = $tagsubfield[$i];
+ $tagsubfield = "@" unless $tagsubfield ne '';
+ my $liblibrarian = $liblibrarian[$i];
+ my $libopac = $libopac[$i];
+ my $repeatable = $input->param("repeatable$i") ? 1 : 0;
+ my $mandatory = $input->param("mandatory$i") ? 1 : 0;
+ my $kohafield = $kohafield[$i];
+ my $tab = $tab[$i];
+ my $seealso = $seealso[$i];
+ my $authorised_value = $authorised_values[$i];
+ my $authtypecode = $authtypecodes[$i];
+ my $value_builder = $value_builder[$i];
+ my $hidden = $hidden[$i]; #input->param("hidden$i");
+ my $isurl = $input->param("isurl$i") ? 1 : 0;
+ my $link = $link[$i];
+
+ if ($liblibrarian) {
+ unless ( C4::Context->config('demo') eq 1 ) {
+ $sth->execute(
+ $tagfield,
+ $tagsubfield,
+ $liblibrarian,
+ $libopac,
+ $repeatable,
+ $mandatory,
+ $kohafield,
+ $tab,
+ $seealso,
+ $authorised_value,
+ $authtypecode,
+ $value_builder,
+ $hidden,
+ $isurl,
+ $frameworkcode,
+
+ $link,
+ );
+ }
+ }
+ }
+ $sth->finish;
+ print
+"Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=marc_subfields_structure.pl?tagfield=$tagfield&frameworkcode=$frameworkcode\"></html>";
+ exit;
+
+ # END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+ # called by default form, used to confirm deletion of data in DB
+}
+elsif ( $op eq 'delete_confirm' ) {
+ my $dbh = C4::Context->dbh;
+ my $sth =
+ $dbh->prepare(
+"select * from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
+ );
+
+ #FIXME : called with 2 bind variables when 3 are needed
+ $sth->execute( $tagfield, $tagsubfield );
+ my $data = $sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(
+ liblibrarian => $data->{'liblibrarian'},
+ tagsubfield => $data->{'tagsubfield'},
+ delete_link => $script_name,
+ tagfield => $tagfield,
+ tagsubfield => $tagsubfield,
+ frameworkcode => $frameworkcode,
+ );
+
+ # END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+ # called by delete_confirm, used to effectively confirm deletion of data in DB
+}
+elsif ( $op eq 'delete_confirmed' ) {
+ my $dbh = C4::Context->dbh;
+ unless ( C4::Context->config('demo') eq 1 ) {
+ my $sth =
+ $dbh->prepare(
+"delete from marc_subfield_structure where tagfield=? and tagsubfield=? and frameworkcode=?"
+ );
+ $sth->execute( $tagfield, $tagsubfield, $frameworkcode );
+ $sth->finish;
+ }
+ print
+"Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=marc_subfields_structure.pl?tagfield=$tagfield&frameworkcode=$frameworkcode\"></html>";
+ exit;
+ $template->param( tagfield => $tagfield );
+
+ # END $OP eq DELETE_CONFIRMED
+################## DEFAULT ##################################
+}
+else { # DEFAULT
+ my $env;
+ my ( $count, $results ) = StringSearch( $env, $tagfield, $frameworkcode );
+ my $toggle = 1;
+ my @loop_data = ();
+ for (
+ my $i = $offset ;
+ $i < ( $offset + $pagesize < $count ? $offset + $pagesize : $count ) ;
+ $i++
+ )
+ {
+ if ( $toggle eq 1 ) {
+ $toggle = 0;
+ }
+ else {
+ $toggle = 1;
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $results->[$i]{'tagfield'};
+ $row_data{tagsubfield} = $results->[$i]{'tagsubfield'};
+ $row_data{liblibrarian} = $results->[$i]{'liblibrarian'};
+ $row_data{kohafield} = $results->[$i]{'kohafield'};
+ $row_data{repeatable} = $results->[$i]{'repeatable'};
+ $row_data{mandatory} = $results->[$i]{'mandatory'};
+ $row_data{tab} = $results->[$i]{'tab'};
+ $row_data{seealso} = $results->[$i]{'seealso'};
+ $row_data{authorised_value} = $results->[$i]{'authorised_value'};
+ $row_data{authtypecode} = $results->[$i]{'authtypecode'};
+ $row_data{value_builder} = $results->[$i]{'value_builder'};
+ $row_data{hidden} = $results->[$i]{'hidden'};
+ $row_data{isurl} = $results->[$i]{'isurl'};
+ $row_data{link} = $results->[$i]{'link'};
+ $row_data{delete} =
+"$script_name?op=delete_confirm&tagfield=$tagfield&tagsubfield="
+ . $results->[$i]{'tagsubfield'}
+ . "&frameworkcode=$frameworkcode";
+ $row_data{toggle} = $toggle;
+
+ if ( $row_data{tab} eq -1 ) {
+ $row_data{subfield_ignored} = 1;
+ }
+
+ push( @loop_data, \%row_data );
+ }
+ $template->param( loop => \@loop_data );
+ $template->param(
+ edit_tagfield => $tagfield,
+ edit_frameworkcode => $frameworkcode
+ );
+
+ if ( $offset > 0 ) {
+ my $prevpage = $offset - $pagesize;
+ $template->param(
+ prev => "<a href=\"$script_name?offset=$prevpage\">" );
+ }
+ if ( $offset + $pagesize < $count ) {
+ my $nextpage = $offset + $pagesize;
+ $template->param(
+ next => "<a href=\"$script_name?offset=$nextpage\">" );
+ }
+} #---- END $OP eq DEFAULT
+$template->param(
+ intranetcolorstylesheet =>
+ C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+);
+output_html_with_http_headers $input, $cookie, $template->output;
Index: admin/marctagstructure.pl
===================================================================
RCS file: admin/marctagstructure.pl
diff -N admin/marctagstructure.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ admin/marctagstructure.pl 9 Mar 2007 15:34:17 -0000 1.34
@@ -0,0 +1,388 @@
+#!/usr/bin/perl
+
+
+# Copyright 2000-2002 Katipo Communications
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it under the
+# terms of the GNU General Public License as published by the Free Software
+# Foundation; either version 2 of the License, or (at your option) any later
+# version.
+#
+# Koha is distributed in the hope that it will be useful, but WITHOUT ANY
+# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+# A PARTICULAR PURPOSE. See the GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License along with
+# Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
+# Suite 330, Boston, MA 02111-1307 USA
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Koha;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Context;
+
+
+# retrieve parameters
+my $input = new CGI;
+my $frameworkcode = $input->param('frameworkcode'); # set to select framework
+$frameworkcode="" unless $frameworkcode;
+my $existingframeworkcode = $input->param('existingframeworkcode'); # set when we have to create a new framework (in frameworkcode) by copying an old one (in existingframeworkcode)
+$existingframeworkcode = "" unless $existingframeworkcode;
+my $frameworkinfo = getframeworkinfo($frameworkcode);
+my $searchfield=$input->param('searchfield');
+$searchfield=0 unless $searchfield;
+$searchfield=~ s/\,//g;
+
+my $offset=$input->param('offset') || 0;
+my $op = $input->param('op') || '';
+my $dspchoice = $input->param('select_display');
+my $pagesize=20;
+
+my $script_name="/cgi-bin/koha/admin/marctagstructure.pl";
+
+my $dbh = C4::Context->dbh;
+
+# open template
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "admin/marctagstructure.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+# get framework list
+my $frameworks = getframeworks();
+my @frameworkloop;
+foreach my $thisframeworkcode (keys %$frameworks) {
+ my $selected = 1 if $thisframeworkcode eq $frameworkcode;
+ my %row =(value => $thisframeworkcode,
+ selected => $selected,
+ frameworktext => $frameworks->{$thisframeworkcode}->{'frameworktext'},
+ );
+ push @frameworkloop, \%row;
+}
+
+# check that framework is defined in marc_tag_structure
+my $sth=$dbh->prepare("select count(*) from marc_tag_structure where frameworkcode=?");
+$sth->execute($frameworkcode);
+my ($frameworkexist) = $sth->fetchrow;
+if ($frameworkexist) {
+} else {
+ # if frameworkcode does not exists, then OP must be changed to "create framework" if we are not on the way to create it
+ # (op = itemtyp_create_confirm)
+ if ($op eq "framework_create_confirm") {
+ duplicate_framework($frameworkcode, $existingframeworkcode);
+ $op=""; # unset $op to go back to framework list
+ } else {
+ $op = "framework_create";
+ }
+}
+$template->param(frameworkloop => \@frameworkloop,
+ frameworkcode => $frameworkcode,
+ frameworktext => $frameworkinfo->{frameworktext});
+if ($op) {
+$template->param(script_name => $script_name,
+ $op => 1); # we show only the TMPL_VAR names $op
+} else {
+$template->param(script_name => $script_name,
+ else => 1); # we show only the TMPL_VAR names $op
+}
+
+
+################## ADD_FORM ##################################
+# called by default. Used to create form to add or modify a record
+if ($op eq 'add_form') {
+ #---- if primkey exists, it's a modify action, so read values to modify...
+ my $data;
+ if ($searchfield) {
+ $sth=$dbh->prepare("select tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?");
+ $sth->execute($searchfield,$frameworkcode);
+ $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ }
+ my $sth = $dbh->prepare("select distinct category from authorised_values");
+ $sth->execute;
+ my @authorised_values;
+ push @authorised_values,"";
+ while ((my $category) = $sth->fetchrow_array) {
+ push @authorised_values, $category;
+ }
+ my $authorised_value = CGI::scrolling_list(-name=>'authorised_value',
+ -values=> \@authorised_values,
+ -size=>1,
+ -tabindex=>'',
+ -id=>"authorised_value",
+ -multiple=>0,
+ -default => $data->{'authorised_value'},
+ );
+
+ if ($searchfield) {
+ $template->param(action => "Modify tag",
+ searchfield => $searchfield);
+ $template->param('heading-modify-tag-p' => 1);
+ } else {
+ $template->param(action => "Add tag");
+ $template->param('heading-add-tag-p' => 1);
+ }
+ $template->param('use-heading-flags-p' => 1);
+ $template->param(liblibrarian => $data->{'liblibrarian'},
+ libopac => $data->{'libopac'},
+ repeatable => CGI::checkbox(-name=>'repeatable',
+ -checked=> $data->{'repeatable'}?'checked':'',
+ -value=> 1,
+ -tabindex=>'',
+ -label => '',
+ -id=> 'repeatable'),
+ mandatory => CGI::checkbox(-name => 'mandatory',
+ -checked => $data->{'mandatory'}?'checked':'',
+ -value => 1,
+ -tabindex=>'',
+ -label => '',
+ -id => 'mandatory'),
+ authorised_value => $authorised_value,
+ frameworkcode => $frameworkcode,
+ );
+ # END $OP eq ADD_FORM
+################## ADD_VALIDATE ##################################
+# called by add_form, used to insert/modify data in DB
+} elsif ($op eq 'add_validate') {
+ $sth=$dbh->prepare("replace marc_tag_structure (tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value,frameworkcode) values (?,?,?,?,?,?,?)");
+ my $tagfield =$input->param('tagfield');
+ my $liblibrarian = $input->param('liblibrarian');
+ my $libopac =$input->param('libopac');
+ my $repeatable =$input->param('repeatable');
+ my $mandatory =$input->param('mandatory');
+ my $authorised_value =$input->param('authorised_value');
+ unless (C4::Context->config('demo') eq 1) {
+ $sth->execute($tagfield,
+ $liblibrarian,
+ $libopac,
+ $repeatable?1:0,
+ $mandatory?1:0,
+ $authorised_value,
+ $frameworkcode
+ );
+ }
+ $sth->finish;
+ print "Content-Type: text/html\n\n<META HTTP-EQUIV=Refresh CONTENT=\"0; URL=marctagstructure.pl?searchfield=$tagfield&frameworkcode=$frameworkcode\"></html>";
+ exit;
+ # END $OP eq ADD_VALIDATE
+################## DELETE_CONFIRM ##################################
+# called by default form, used to confirm deletion of data in DB
+} elsif ($op eq 'delete_confirm') {
+ $sth=$dbh->prepare("select tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from marc_tag_structure where tagfield=? and frameworkcode=?");
+ $sth->execute($searchfield,$frameworkcode);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(liblibrarian => $data->{'liblibrarian'},
+ searchfield => $searchfield,
+ frameworkcode => $frameworkcode,
+ );
+ # END $OP eq DELETE_CONFIRM
+################## DELETE_CONFIRMED ##################################
+# called by delete_confirm, used to effectively confirm deletion of data in DB
+} elsif ($op eq 'delete_confirmed') {
+ unless (C4::Context->config('demo') eq 1) {
+ $dbh->do("delete from marc_tag_structure where tagfield='$searchfield' and frameworkcode='$frameworkcode'");
+ $dbh->do("delete from marc_subfield_structure where tagfield='$searchfield' and frameworkcode='$frameworkcode'");
+ }
+ # END $OP eq DELETE_CONFIRMED
+################## ITEMTYPE_CREATE ##################################
+# called automatically if an unexisting frameworkis selected
+} elsif ($op eq 'framework_create') {
+ $sth = $dbh->prepare("select count(*),marc_tag_structure.frameworkcode,frameworktext from marc_tag_structure,biblio_framework where biblio_framework.frameworkcode=marc_tag_structure.frameworkcode group by marc_tag_structure.frameworkcode");
+ $sth->execute;
+ my @existingframeworkloop;
+ while (my ($tot,$thisframeworkcode,$frameworktext) = $sth->fetchrow) {
+ if ($tot>0) {
+ my %line = ( value => $thisframeworkcode,
+ frameworktext => $frameworktext,
+ );
+ push @existingframeworkloop,\%line;
+ }
+ }
+ $template->param(existingframeworkloop => \@existingframeworkloop,
+ frameworkcode => $frameworkcode,
+# FRtext => $frameworkinfo->{frameworktext},
+ );
+################## DEFAULT ##################################
+} else { # DEFAULT
+ # here, $op can be unset or set to "framework_create_confirm".
+ if ($searchfield ne '') {
+ $template->param(searchfield => $searchfield);
+ }
+ my $cnt=0;
+ if ($dspchoice) {
+ #here, user only wants used tags/subfields displayed
+ my $env;
+ $searchfield=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchfield);
+ my $sth=$dbh->prepare("
+ SELECT marc_tag_structure.tagfield AS mts_tagfield,
+ marc_tag_structure.liblibrarian as mts_liblibrarian,
+ marc_tag_structure.libopac as mts_libopac,
+ marc_tag_structure.repeatable as mts_repeatable,
+ marc_tag_structure.mandatory as mts_mandatory,
+ marc_tag_structure.authorised_value as mts_authorized_value,
+ marc_subfield_structure.*
+ FROM marc_tag_structure
+ LEFT JOIN marc_subfield_structure ON (marc_tag_structure.tagfield=marc_subfield_structure.tagfield AND marc_tag_structure.frameworkcode=marc_subfield_structure.frameworkcode) WHERE (marc_tag_structure.tagfield >= ? and marc_tag_structure.frameworkcode=?) AND marc_subfield_structure.tab>=0 ORDER BY marc_tag_structure.tagfield,marc_subfield_structure.tagsubfield");
+ #could be ordoned by tab
+ $sth->execute($data[0], $frameworkcode);
+ my @results = ();
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ $cnt++;
+ }
+ $sth->finish;
+
+ my $toggle=0;
+ my @loop_data = ();
+ my $j=1;
+ my $i=$offset;
+ while ($i < ($offset+$pagesize<$cnt?$offset+$pagesize:$cnt)) {
+ if ($toggle eq 0){
+ $toggle=1;
+ } else {
+ $toggle=0;
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $results[$i]->{'mts_tagfield'};
+ $row_data{liblibrarian} = $results[$i]->{'mts_liblibrarian'};
+ $row_data{repeatable} = $results[$i]->{'mts_repeatable'};
+ $row_data{mandatory} = $results[$i]->{'mts_mandatory'};
+ $row_data{authorised_value} = $results[$i]->{'mts_authorised_value'};
+ $row_data{subfield_link} ="marc_subfields_structure.pl?op=add_form&tagfield=".$results[$i]->{'mts_tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{edit} = "$script_name?op=add_form&searchfield=".$results[$i]->{'mts_tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results[$i]->{'mts_tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{toggle} = $toggle;
+ $j=$i;
+ my @internal_loop = ();
+ while (($results[$i]->{'tagfield'}==$results[$j]->{'tagfield'}) and ($j< ($offset+$pagesize<$cnt?$offset+$pagesize:$cnt))) {
+ my %subfield_data;
+ $subfield_data{tagsubfield} = $results[$j]->{'tagsubfield'};
+ $subfield_data{liblibrarian} = $results[$j]->{'liblibrarian'};
+ $subfield_data{kohafield} = $results[$j]->{'kohafield'};
+ $subfield_data{repeatable} = $results[$j]->{'repeatable'};
+ $subfield_data{mandatory} = $results[$j]->{'mandatory'};
+ $subfield_data{tab} = $results[$j]->{'tab'};
+ $subfield_data{seealso} = $results[$j]->{'seealso'};
+ $subfield_data{authorised_value} = $results[$j]->{'authorised_value'};
+ $subfield_data{authtypecode}= $results[$j]->{'authtypecode'};
+ $subfield_data{value_builder}= $results[$j]->{'value_builder'};
+ $subfield_data{toggle} = $toggle;
+# warn "tagfield : ".$results[$j]->{'tagfield'}." tagsubfield :".$results[$j]->{'tagsubfield'};
+ push @internal_loop,\%subfield_data;
+ $j++;
+ }
+ $row_data{'subfields'}=\@internal_loop;
+ push(@loop_data, \%row_data);
+# undef @internal_loop;
+ $i=$j;
+ }
+ $template->param(select_display => "True",
+ loop => \@loop_data);
+ # $sth->execute;
+ $sth->finish;
+ } else {
+ #here, normal old style : display every tags
+ my $env;
+ my ($count,$results)=StringSearch($env,$searchfield,$frameworkcode);
+ $cnt = $count;
+ my $toggle=0;
+ my @loop_data = ();
+ for (my $i=$offset; $i < ($offset+$pagesize<$count?$offset+$pagesize:$count); $i++){
+ if ($toggle eq 0){
+ $toggle=1;
+ } else {
+ $toggle=0;
+ }
+ my %row_data; # get a fresh hash for the row data
+ $row_data{tagfield} = $results->[$i]{'tagfield'};
+ $row_data{liblibrarian} = $results->[$i]{'liblibrarian'};
+ $row_data{repeatable} = $results->[$i]{'repeatable'};
+ $row_data{mandatory} = $results->[$i]{'mandatory'};
+ $row_data{authorised_value} = $results->[$i]{'authorised_value'};
+ $row_data{subfield_link} ="marc_subfields_structure.pl?tagfield=".$results->[$i]{'tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{edit} = "$script_name?op=add_form&searchfield=".$results->[$i]{'tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{delete} = "$script_name?op=delete_confirm&searchfield=".$results->[$i]{'tagfield'}."&frameworkcode=".$frameworkcode;
+ $row_data{toggle} = $toggle;
+ push(@loop_data, \%row_data);
+ }
+ $template->param(loop => \@loop_data);
+ }
+ if ($offset>0) {
+ my $prevpage = $offset-$pagesize;
+ $template->param(isprevpage => $offset,
+ prevpage=> $prevpage,
+ searchfield => $searchfield,
+ script_name => $script_name,
+ frameworkcode => $frameworkcode,
+ );
+ }
+ if ($offset+$pagesize<$cnt) {
+ my $nextpage =$offset+$pagesize;
+ $template->param(nextpage =>$nextpage,
+ searchfield => $searchfield,
+ script_name => $script_name,
+ frameworkcode => $frameworkcode,
+ );
+ }
+} #---- END $OP eq DEFAULT
+
+$template->param(loggeninuser => $loggedinuser,
+ intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
+ intranetstylesheet => C4::Context->preference("intranetstylesheet"),
+ IntranetNav => C4::Context->preference("IntranetNav"),
+ );
+output_html_with_http_headers $input, $cookie, $template->output;
+
+
+#
+# the sub used for searches
+#
+sub StringSearch {
+ my ($env,$searchstring,$frameworkcode)=@_;
+ my $dbh = C4::Context->dbh;
+ $searchstring=~ s/\'/\\\'/g;
+ my @data=split(' ',$searchstring);
+ my $count=@data;
+ my $sth=$dbh->prepare("Select tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from marc_tag_structure where (tagfield >= ? and frameworkcode=?) order by tagfield");
+ $sth->execute($data[0], $frameworkcode);
+ my @results;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ }
+ # $sth->execute;
+ $sth->finish;
+ return (scalar(@results),\@results);
+}
+
+#
+# the sub used to duplicate a framework from an existing one in MARC parameters tables.
+#
+sub duplicate_framework {
+ my ($newframeworkcode,$oldframeworkcode) = @_;
+ my $sth = $dbh->prepare("select tagfield,liblibrarian,libopac,repeatable,mandatory,authorised_value from marc_tag_structure where frameworkcode=?");
+ $sth->execute($oldframeworkcode);
+ my $sth_insert = $dbh->prepare("insert into marc_tag_structure (tagfield, liblibrarian, libopac, repeatable, mandatory, authorised_value, frameworkcode) values (?,?,?,?,?,?,?)");
+ while ( my ($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value) = $sth->fetchrow) {
+ $sth_insert->execute($tagfield,$liblibrarian,$libopac,$repeatable,$mandatory,$authorised_value,$newframeworkcode);
+ }
+
+ $sth = $dbh->prepare("select frameworkcode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,authtypecode,value_builder,seealso from marc_subfield_structure where frameworkcode=?");
+ $sth->execute($oldframeworkcode);
+ $sth_insert = $dbh->prepare("insert into marc_subfield_structure (frameworkcode,tagfield,tagsubfield,liblibrarian,libopac,repeatable,mandatory,kohafield,tab,authorised_value,authtypecode,value_builder,seealso) values (?,?,?,?,?,?,?,?,?,?,?,?,?)");
+ while ( my ($frameworkcode, $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory, $kohafield, $tab, $authorised_value, $thesaurus_category, $value_builder, $seealso) = $sth->fetchrow) {
+ $sth_insert->execute($newframeworkcode, $tagfield, $tagsubfield, $liblibrarian, $libopac, $repeatable, $mandatory, $kohafield, $tab, $authorised_value, $thesaurus_category, $value_builder, $seealso);
+ }
+}
+
More information about the Koha-cvs
mailing list