[Koha-cvs] koha/intranet/cgi-bin/tools barcodes.pl barcode... [rel_TG]
Tumer Garip
tgarip at neu.edu.tr
Sat Mar 10 02:31:04 CET 2007
CVSROOT: /sources/koha
Module name: koha
Branch: rel_TG
Changes by: Tumer Garip <tgarip1957> 07/03/10 01:31:04
Added files:
intranet/cgi-bin/tools: barcodes.pl barcodesGenerator.pl
exceptionHolidays.pl export.pl fines2.pl
holidays.pl import.pl koha-news.pl
letter.pl newHolidays.pl overduerules.pl
pdfViewer.pl printerConfig.pl
tools-home.pl
Log message:
fresh files for rel_TG
CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/barcodes.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/barcodesGenerator.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/exceptionHolidays.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/export.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/fines2.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/holidays.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/import.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/koha-news.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/letter.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/newHolidays.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/overduerules.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/pdfViewer.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/printerConfig.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
http://cvs.savannah.gnu.org/viewcvs/koha/intranet/cgi-bin/tools/tools-home.pl?cvsroot=koha&only_with_tag=rel_TG&rev=1.1.2.1
Patches:
Index: barcodes.pl
===================================================================
RCS file: barcodes.pl
diff -N barcodes.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ barcodes.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,143 @@
+#!/usr/bin/perl
+
+# script to generate items barcodes
+# written 07/04
+# by Veleda Matias - matias_veleda at hotmail.com - Physics Library UNLP Argentina and
+# Castañeda Sebastian - seba3c at yahoo.com.ar - Physics Library UNLP Argentina and
+
+# 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::Output;
+use C4::Interface::CGI::Output;
+use C4::Database;
+use HTML::Template;
+use C4::Context;
+use C4::Barcodes::PrinterConfig;
+
+
+
+# This function returns the path to deal with the correct files, considering
+# templates set and language.
+sub getPath {
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ($type eq "intranet") {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ } else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
+}
+
+# Load a configuration file. Before use this function, check if that file exists.
+sub loadConfFromFile {
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
+}
+
+# Save settings to a configuration file. It delete previous configuration settings.
+sub saveConfToFile {
+ my $fileName = shift @_;
+ my %keyValues = %{shift @_};
+ my $i;
+ open FILE, ">$fileName";
+ my $i;
+ foreach $i (keys(%keyValues)) {
+ print FILE $i." = ".$keyValues{$i}."\n";
+ }
+ close FILE;
+}
+
+# Load the config file.
+my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my %labelConfig = &loadConfFromFile($filenameConf);
+
+my $input = new CGI;
+# Defines type of page to use in the printer process
+my @labelTable = C4::Barcodes::PrinterConfig::labelsPage($labelConfig{'rows'}, $labelConfig{'columns'});
+
+# It creates a list of posible intervals to choose codes to generate
+my %list = ('continuous' => 'Continuous Range of items', 'individuals' => 'Individual Codes');
+my @listValues = keys(%list);
+my $rangeType = CGI::scrolling_list(-name => 'rangeType',
+ -values => \@listValues,
+ -labels => \%list,
+ -size => 1,
+ -default => ['continuous'],
+ -multiple => 0,
+ -id => "rangeType",
+ -onChange => "changeRange(this)");
+# It creates a list of posible standard codifications. First checks if the user has just added a new code.
+if ($input->param('addCode')) {
+ my $newCountryName = $input->param('countryName');
+ my $newCountryCode = $input->param('countryCode');
+
+ my $countryCodesFilename = &getPath("intranet")."/includes/countryCodes/countryCodes.dat";
+ open COUNTRY_CODES, ">>$countryCodesFilename";
+ print COUNTRY_CODES $newCountryCode." = ".$newCountryName."\n";
+ close COUNTRY_CODES;
+}
+
+# Takes the country codes from a file and use them to set the country list.
+my $countryCodes = &getPath("intranet")."/includes/countryCodes/countryCodes.dat";
+my %list = &loadConfFromFile($countryCodes);
+ at listValues = keys(%list);
+my $number_system = CGI::scrolling_list(-name => 'numbersystem',
+ -values => \@listValues,
+ -labels => \%list,
+ -size => 1,
+ -multiple => 0);
+
+# Set the script name
+my $script_name = "/cgi-bin/koha/tools/barcodesGenerator.pl";
+
+
+# Get the template to use
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "barcodes/barcodes.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+# Replace the template values with the real ones
+$template->param(SCRIPT_NAME => $script_name);
+$template->param(NUMBER_SYSTEM => $number_system);
+$template->param(PAGES => $labelConfig{'pageType'});
+$template->param(RANGE_TYPE => $rangeType);
+$template->param(LABEL_TABLE => \@labelTable);
+$template->param(COL_SPAN => $labelConfig{'columns'});
+if ($input->param('error')) {
+ $template->param(ERROR => 1);
+} else {
+ $template->param(ERROR => 0);
+}
+# Shows the template with the real values replaced
+output_html_with_http_headers $input, $cookie, $template->output;
\ No newline at end of file
Index: barcodesGenerator.pl
===================================================================
RCS file: barcodesGenerator.pl
diff -N barcodesGenerator.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ barcodesGenerator.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,302 @@
+#!/usr/bin/perl
+
+# script to generate items barcodes
+# written 07/04
+# by Veleda Matias - matias_veleda at hotmail.com - Physics Library UNLP Argentina and
+# Castañeda Sebastian - seba3c at yahoo.com.ar - Physics Library UNLP Argentina and
+
+# 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
+
+require Exporter;
+
+use strict;
+
+use CGI;
+use C4::Context;
+use C4::Output;
+use HTML::Template;
+use PDF::API2;
+use PDF::API2::Page;
+use PDF::API2::PDF::Utils;
+use C4::Barcodes::PrinterConfig;
+use Time::localtime;
+
+
+# This function returns the path to deal with the correct files, considering
+# templates set and language.
+sub getPath {
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ($type eq "intranet") {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ } else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
+}
+
+# Load a configuration file. Before use this function, check if that file exists.
+sub loadConfFromFile {
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
+}
+
+# Save settings to a configuration file. It delete previous configuration settings.
+sub saveConfToFile {
+ my $fileName = shift @_;
+ my %keyValues = %{shift @_};
+ my $i;
+ open FILE, ">$fileName";
+ my $i;
+ foreach $i (keys(%keyValues)) {
+ print FILE $i." = ".$keyValues{$i}."\n";
+ }
+ close FILE;
+}
+
+# Load the config file.
+my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my %labelConfig = &loadConfFromFile($filenameConf);
+
+# Creates a CGI object and take its parameters
+my $cgi = new CGI;
+my $from = $cgi->param('from');
+my $to = $cgi->param('to');
+my $individualCodes = $cgi->param('individualCodes');
+my $rangeType = $cgi->param('rangeType');
+my $pageType = $cgi->param('pages');
+my $label = $cgi->param('label');
+my $numbersystem = $cgi->param('numbersystem');
+my $text_under_label = $cgi->param('text_under_label');
+
+# Generate the checksum from an inventary code
+sub checksum {
+
+ sub calculateDigit {
+ my $code = shift @_;
+ my $sum = 0;
+ my $odd_parity = 1;
+ my $i;
+ for ($i = length($code) - 1; $i >= 0; $i--){
+ if ( $odd_parity ) {
+ $sum = $sum + ( 3 * substr($code, $i, 1) );
+ } else {
+ $sum = $sum + substr($code, $i, 1); }
+ $odd_parity = !$odd_parity;
+ }
+ my $check_digit = 10 - ($sum%10);
+ if ($check_digit==10) {
+ $check_digit=0;
+ }
+ return $code.$check_digit;
+ }
+
+ my $currentCode = shift @_;
+ $currentCode = &calculateDigit($currentCode);
+ return $currentCode;
+}
+
+# Assigns a temporary name to the PDF file
+sub assingFilename {
+ my ($from, $to) = @_;
+ my $ip = $cgi->remote_addr();
+ my $random = int(rand(1000000));
+ my $timeObj = localtime();
+ my ($day, $month, $year, $hour, $min, $sec) = ($timeObj->mday,
+ $timeObj->mon + 1,
+ $timeObj->year + 1900,
+ $timeObj->hour,
+ $timeObj->min,
+ $timeObj->sec);
+ my $tmpFileName = $random.'-'.$ip.'-(From '.$from.' to '.$to.')-['.$day.'.'.$month.'.'.$year.']-['.$hour.':'.$min.':'.$sec.'].pdf';
+ return $tmpFileName;
+}
+sub getCallnum {
+#grabs a callnumber for the specified barcode
+my ($barcode) = @_;
+my $query = "select dewey from items,biblioitems where items.biblionumber=biblioitems.biblionumber and items.barcode=?";
+my $dbh = C4::Context->dbh;
+my $sth = $dbh->prepare($query);
+$sth->execute($barcode);
+my ($callnum) = $sth->fetchrow_array();
+warn "Call number is:".$barcode;
+return $callnum;
+}
+# Takes inventary codes from database and if they are between
+# the interval specify by parameters, it generates the correspond barcodes
+sub barcodesGenerator {
+ my ($from, $to, $rangeType, $individualCodes,$text_under_label) = @_;
+ # Returns a database handler
+ my $dbh = C4::Context->dbh;
+ # Create the query to database
+ # Assigns a temporary filename for the pdf file
+ my $tmpFileName = &assingFilename($from, $to);
+ # warn "range type: ".$rangeType;
+ if ($rangeType eq 'continuous') {
+ # Set the temp directory for pdf´s files
+ if (!defined($ENV{'TEMP'})) {
+ $ENV{'TEMP'} = '/tmp/';
+ }
+ $tmpFileName = $ENV{'TEMP'}.$tmpFileName;
+ # Creates a PDF object
+ my $pdf = PDF::API2->new(-file => $tmpFileName);
+ # Set the positions where barcodes are going to be placed
+ C4::Barcodes::PrinterConfig::setPositionsForX($labelConfig{'marginLeft'}, $labelConfig{'labelWidth'}, $labelConfig{'columns'}, $labelConfig{'pageType'});
+ C4::Barcodes::PrinterConfig::setPositionsForY($labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'}, $labelConfig{'rows'}, $labelConfig{'pageType'});
+ # Creates a font object
+ my $tr = $pdf->corefont('Helvetica-Bold');
+ # Barcode position
+ my ($page, $gfx, $text);
+ for (my $code=$from; $code<=$to; $code++) {
+ # Generetase checksum
+ my $codeC = &checksum($code);
+ # Generate the corresponde barcode to $code
+ # warn "Code is :-->".$codeC."<--";
+ my $barcode = $pdf->barcode(-font => $tr, # The font object to use
+ -type => 'ean128', # Standard of codification
+ -code => $codeC, # Text to codify
+ -extn => '012345', # Barcode extension (if it is aplicable)
+ -umzn => 10, # Top limit of the finished bar
+ -lmzn => 10, # Bottom limit of the finished bar
+ -zone => 15, # Bars size
+ -quzn => 0, # Space destinated for legend
+ -ofwt => 0.01, # Bars width
+ -fnsz => 8, # Font size
+ -text => ''
+ );
+
+ (my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label) = C4::Barcodes::PrinterConfig::getLabelPosition(
+ $label,
+ $pdf,
+ $page,
+ $gfx,
+ $text,
+ $tr,
+ $pageType);
+ # Assigns a barcodes to $gfx
+ $gfx->barcode($barcode, $x, $y , (72/$labelConfig{'systemDpi'}));
+ # Assigns the additional information to the barcode (Legend)
+ $text->translate($x - 48, $y - 22);
+ warn "code is ".$codeC;
+ if ($text_under_label) {
+ $text->text($text_under_label);
+ } else {
+ $text->text(getCallnum($code));
+ }
+ }
+ # Writes the objects added in $gfx to $page
+ $pdf->finishobjects($page,$gfx, $text);
+ # Save changes to the PDF
+ $pdf->saveas;
+ # Close the conection with the PDF file
+ $pdf->end;
+ # Show the PDF file
+ print $cgi->redirect("/cgi-bin/koha/barcodes/pdfViewer.pl?tmpFileName=$tmpFileName");
+ } else {
+ my $rangeCondition;
+ if ($individualCodes ne "") {
+ $rangeCondition = "AND (I.barcode IN " . $individualCodes . ")";
+ } else {
+ $rangeCondition = "AND (I.barcode >= " . $from . " AND I.barcode <=" . $to . " )";
+ }
+ warn "above the query";
+ my $query = "SELECT CONCAT('$numbersystem',REPEAT('0',((12 - LENGTH('$numbersystem')) - LENGTH(I.barcode))), I.barcode) AS Codigo, I.dewey as dewey B.title, B.author FROM biblio B, items I WHERE (I.biblionumber = B.biblioNumber ) " .$rangeCondition. " AND (I.barcode <> 'FALTA') ORDER BY Codigo";
+
+ # Prepare the query
+ my $sth = $dbh->prepare($query);
+ # Executes the query
+ $sth->execute;
+ if ($sth->rows) { # There are inventary codes
+ # Set the temp directory for pdf´s files
+ if (!defined($ENV{'TEMP'})) {
+ $ENV{'TEMP'} = '/tmp/';
+ }
+ # Assigns a temporary filename for the pdf file
+ my $tmpFileName = &assingFilename($from, $to);
+ $tmpFileName = $ENV{'TEMP'}.$tmpFileName;
+ # Creates a PDF object
+ my $pdf = PDF::API2->new(-file => $tmpFileName);
+ # Set the positions where barcodes are going to be placed
+ C4::Barcodes::PrinterConfig::setPositionsForX($labelConfig{'marginLeft'}, $labelConfig{'labelWidth'}, $labelConfig{'columns'}, $labelConfig{'pageType'});
+ C4::Barcodes::PrinterConfig::setPositionsForY($labelConfig{'marginBottom'}, $labelConfig{'labelHeigth'}, $labelConfig{'rows'}, $labelConfig{'pageType'});
+ # Creates a font object
+ my $tr = $pdf->corefont('Helvetica-Bold');
+ # Barcode position
+ my ($page, $gfx, $text);
+ while (my ($code,$dewey,$title,$author) = $sth->fetchrow_array) {
+ # Generetase checksum
+ $code = &checksum($code);
+ # Generate the corresponde barcode to $code
+ my $barcode = $pdf->barcode(-font => $tr, # The font object to use
+ -type => 'ean13', # Standard of codification
+ -code => $code, # Text to codify
+ -extn => '012345', # Barcode extension (if it is aplicable)
+ -umzn => 10, # Top limit of the finished bar
+ -lmzn => 10, # Bottom limit of the finished bar
+ -zone => 15, # Bars size
+ -quzn => 0, # Space destinated for legend
+ -ofwt => 0.01, # Bars width
+ -fnsz => 8, # Font size
+ -text => ''
+ );
+
+ (my $x, my $y, $pdf, $page, $gfx, $text, $tr, $label) = C4::Barcodes::PrinterConfig::getLabelPosition(
+ $label,
+ $pdf,
+ $page,
+ $gfx,
+ $text,
+ $tr,
+ $pageType);
+ # Assigns a barcodes to $gfx
+ $gfx->barcode($barcode, $x, $y , (72/$labelConfig{'systemDpi'}));
+ # Assigns the additional information to the barcode (Legend)
+ $text->translate($x - 48, $y - 22);
+ if ($text_under_label) {
+ $text->text($text_under_label);
+ } else {
+ warn "here a dewey:".$dewey;
+ $text->text(substr $dewey, 0, 30);
+ $text->translate($x - 48, $y - 29);
+ #$text->text(substr $author, 0, 30);
+ }
+ }
+ # Writes the objects added in $gfx to $page
+ $pdf->finishobjects($page,$gfx, $text);
+ # Save changes to the PDF
+ $pdf->saveas;
+ # Close the conection with the PDF file
+ $pdf->end;
+ # Show the PDF file
+ print $cgi->redirect("/cgi-bin/koha/tools/pdfViewer.pl?tmpFileName=$tmpFileName");
+ } else {
+ # Rollback and shows the error legend
+ print $cgi->redirect("/cgi-bin/koha/tools/barcodes.pl?error=1");
+ }
+ $sth->finish;
+ }
+}
+
+barcodesGenerator($from, $to, $rangeType, $individualCodes,$text_under_label);
Index: exceptionHolidays.pl
===================================================================
RCS file: exceptionHolidays.pl
diff -N exceptionHolidays.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ exceptionHolidays.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,36 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+
+use C4::Auth;
+
+use C4::Interface::CGI::Output;
+use C4::Calendar::Calendar;
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh();
+
+my $branchcode = $input->param('showBranchName');
+my $weekday = $input->param('showWeekday');
+my $day = $input->param('showDay');
+my $month = $input->param('showMonth');
+my $year = $input->param('showYear');
+my $title = $input->param('showTitle');
+my $description = $input->param('showDescription');
+
+my $calendar = C4::Calendar::Calendar->new(branchcode => $branchcode);
+
+if ($input->param('showOperation') eq 'exception') {
+ $calendar->insert_exception_holiday(day => $day,
+ month => $month,
+ year => $year,
+ title => $title,
+ description => $description);
+} elsif ($input->param('showOperation') eq 'delete') {
+ $calendar->delete_holiday(weekday => $weekday,
+ day => $day,
+ month => $month,
+ year => $year);
+}
+print $input->redirect("/cgi-bin/koha/tools/holidays.pl?branch=$branchcode");
Index: export.pl
===================================================================
RCS file: export.pl
diff -N export.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ export.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,46 @@
+#!/usr/bin/perl
+use strict;
+
+use C4::Auth;
+use C4::Interface::CGI::Output;
+use C4::Biblio;
+use CGI;
+use C4::Auth;
+use MARC::Record;
+use MARC::File::XML;
+my $query = new CGI;
+my $op=$query->param("op");
+if ($op eq "export") {
+ print $query->header('Content-Type: text/marc');
+ my $start_bib = $query->param("start_bib");
+ my $end_bib = $query->param("end_bib");
+ my $dbh=C4::Context->dbh;
+ my $sth;
+ if ($start_bib && $end_bib) {
+ $sth=$dbh->prepare("select marcxml from biblio where biblionumber >=? and biblionumber <=? order by biblionumber");
+ $sth->execute($start_bib,$end_bib);
+ } elsif ($start_bib ) {
+ $sth=$dbh->prepare("select marcxml from biblio where biblionumber >=? order by biblionumber");
+ $sth->execute($start_bib);
+ }else {
+ $sth=$dbh->prepare("select marcxml from biblio order by biblionumber");
+ $sth->execute();
+ }
+ while (my ($marc) = $sth->fetchrow) {
+my $record=MARC::Record->new_from_xml($marc,"UTF-8");
+
+ print $record->as_usmarc;;
+
+ }
+} else {
+ my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/marc.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1, management => 1, tools => 1},
+ debug => 1,
+ });
+ output_html_with_http_headers $query, $cookie, $template->output;
+}
+
Index: fines2.pl
===================================================================
RCS file: fines2.pl
diff -N fines2.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ fines2.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,139 @@
+#!/usr/bin/perl
+
+# This script loops through each overdue item, determines the fine,
+# and updates the total amount of fines due by each user. It relies on
+# the existence of /tmp/fines, which is created by ???
+# Doesnt really rely on it, it relys on being able to write to /tmp/
+# It creates the fines file
+#
+# This script is meant to be run nightly out of cron.
+
+# 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
+
+# $Id: fines2.pl,v 1.1.2.1 2007/03/10 01:31:04 tgarip1957 Exp $
+
+use C4::Context;
+use C4::Search;
+use C4::Circulation::Circ2;
+use C4::Circulation::Fines;
+use C4::Accounts2;
+use C4::Date;
+use C4::Biblio;
+
+#
+my ($numOverdueItems,$data)=Getoverdues();
+
+my $overdueItemsCounted=0 if $DEBUG;
+
+# FIXME - There's got to be a better way to figure out what day
+# today is.
+
+
+my $date=get_today();
+
+
+
+my $bornum;
+
+# FIXME
+# $total isn't used anywhere else in the file,
+# can we delete it?
+#
+my $total=0;
+
+# FIXME
+# this probably ought to be a global variable or constant
+# defined in a central place
+#
+# Yep
+my $maxFine=30;
+
+
+
+
+for (my $i=0;$i<$numOverdueItems;$i++){
+ my @dates=split('-',$data->[$i]->{'date_due'});
+ my $date2=$data->[$i]->{'date_due'};
+ my $due=format_date($date2);
+ my $borrower=BorType($data->[$i]->{'borrowernumber'});
+ if ($date2 lt $date){
+ $overdueItemsCounted++ if $DEBUG;
+my $difference;
+eval {
+ $difference=DATE_subtract($date,$date2);
+};
+ my ($amount,$type,$printout)=
+ CalcFine($data->[$i]->{'itemnumber'},
+ $borrower->{'categorycode'},
+ $difference);
+ if ($amount > $maxFine){
+ $amount=$maxFine;
+ }
+ if ($amount > 0){
+ UpdateFine($data->[$i]->{'itemnumber'},$data->[$i]->{'borrowernumber'},$amount,$type,$due);
+
+
+
+ if ($borrower->{'categorycode'} eq 'C'){
+ my $dbh = C4::Context->dbh;
+ my $sth=$dbh->prepare("Select * from borrowers where borrowernumber=?");
+ $sth->execute($borrower->{'guarantor'});
+ my $tdata=$sth->fetchrow_hashref;
+ $sth->finish;
+ $borrower->{'phone'}=$tdata->{'phone'};
+ }
+# print "$printout\t$borrower->{'cardnumber'}\t$borrower->{'categorycode'}\t$borrower->{'firstname'}\t$borrower->{'surname'}\t$data->[$i]->{'date_due'}\t$type\t$difference\t$borrower->{'emailaddress'}\t$borrower->{'phone'}\t$borrower->{'streetaddress'}\t$borrower->{'city'}\t$amount\n";
+ }
+
+
+ if ($amount ==$maxFine){ # FIXME
+ # this should be a separate function
+ #
+ my $borrower=BorType($data->[$i]->{'borrowernumber'});
+ if ($borrower->{'cardnumber'} ne ''){
+ my $cost=ReplacementCost($data->[$i]->{'itemnumber'});
+ $cost=$maxFine unless $cost;
+ my $dbh = C4::Context->dbh;
+ my $env;
+ my $accountno=getnextacctno($env,$data->[$i]->{'borrowernumber'},$dbh);
+
+ my $item=getiteminformation("",$data->[$i]->{'itemnumber'});
+
+ if ($item->{'itemlost'} ne '1' && $item->{'itemoverdue'} ne '1' ){
+
+
+ my $sth=$dbh->prepare("Insert into accountlines
+ (borrowernumber,itemnumber,accountno,date,amount,
+ description,accounttype,amountoutstanding) values
+ (?,?,?,now(),?,?,'L',?)");
+ $sth->execute($data->[$i]->{'borrowernumber'},$data->[$i]->{'itemnumber'},
+ $accountno,$cost,"Very overdue fee $item->{'title'} $due",$cost);
+ $sth->finish;
+ XMLmoditemonefield($dbh,$item->{'biblionumber'},$item->{'itemnumber'},"itemoverdue","1");
+ }
+
+ }
+ }
+
+ }
+}
+
+
+
+close FILE;
+
Index: holidays.pl
===================================================================
RCS file: holidays.pl
diff -N holidays.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ holidays.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,100 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+
+use C4::Auth;
+
+use C4::Interface::CGI::Output;
+
+use C4::Calendar::Calendar;
+
+my $input = new CGI;
+my $branch = $input->param('branch');
+$branch=C4::Context->preference('defaultBranch') unless $branch;
+my $dbh = C4::Context->dbh();
+
+# Set all the branches.
+my $branches = $dbh->prepare("select branchcode, branchname from branches");
+$branches->execute;
+# It creates a list of branches
+my %list;
+while (my ($branchcode, $branchname) = $branches->fetchrow) {
+ $list{$branchcode} = $branchname;
+}
+my @listValues = keys(%list);
+if (!defined($branch)) {
+ $branch =$listValues[4];
+}
+my $branchesList = CGI::scrolling_list(-name => 'branch', -id=>'branch',
+ -values => \@listValues,
+ -labels => \%list,
+ -size => 1,
+ -default => [$branch],
+ -multiple => 0,
+ -onChange => "changeBranch()");
+
+$branches->finish;
+
+# Get all the holidays
+my $calendar = C4::Calendar::Calendar->new(branchcode => $branch);
+my $week_days_holidays = $calendar->get_week_days_holidays();
+my @week_days;
+foreach my $weekday (keys %$week_days_holidays) {
+ my %week_day;
+ %week_day = (KEY => $weekday,
+ TITLE => $week_days_holidays->{$weekday}{title},
+ DESCRIPTION => $week_days_holidays->{$weekday}{description});
+ push @week_days, \%week_day;
+}
+
+my $day_month_holidays = $calendar->get_day_month_holidays();
+my @day_month_holidays;
+foreach my $monthDay (keys %$day_month_holidays) {
+ my %day_month;
+ %day_month = (KEY => $monthDay,
+ TITLE => $day_month_holidays->{$monthDay}{title},
+ DESCRIPTION => $day_month_holidays->{$monthDay}{description});
+ push @day_month_holidays, \%day_month;
+}
+
+my $exception_holidays = $calendar->get_exception_holidays();
+my @exception_holidays;
+foreach my $yearMonthDay (keys %$exception_holidays) {
+ my %exception_holiday;
+ %exception_holiday = (KEY => $yearMonthDay,
+ TITLE => $exception_holidays->{$yearMonthDay}{title},
+ DESCRIPTION => $exception_holidays->{$yearMonthDay}{description});
+ push @exception_holidays, \%exception_holiday;
+}
+
+my $single_holidays = $calendar->get_single_holidays();
+my @holidays;
+foreach my $yearMonthDay (keys %$single_holidays) {
+ my %holiday;
+ %holiday = (KEY => $yearMonthDay,
+ TITLE => $single_holidays->{$yearMonthDay}{title},
+ DESCRIPTION => $single_holidays->{$yearMonthDay}{description});
+ push @holidays, \%holiday;
+}
+
+# Get the template to use
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/holidays.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+# Replace the template values with the real ones
+$template->param(BRANCHES => $branchesList);
+$template->param(WEEK_DAYS_LOOP => \@week_days);
+$template->param(HOLIDAYS_LOOP => \@holidays);
+$template->param(EXCEPTION_HOLIDAYS_LOOP => \@exception_holidays);
+$template->param(DAY_MONTH_HOLIDAYS_LOOP => \@day_month_holidays);
+$template->param(branch => $branch);
+
+# Shows the template with the real values replaced
+output_html_with_http_headers $input, $cookie, $template->output;
\ No newline at end of file
Index: import.pl
===================================================================
RCS file: import.pl
diff -N import.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ import.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,106 @@
+#!/usr/bin/perl
+
+# $Id: import.pl,v 1.1.2.1 2007/03/10 01:31:04 tgarip1957 Exp $
+
+# Script for handling import of MARC data into Koha db
+# and Z39.50 lookups
+
+# Koha library project www.koha.org
+
+# Licensed under the GPL
+
+
+# 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;
+
+# standard or CPAN modules used
+use CGI;
+
+# Koha modules used
+use C4::Context;
+use C4::Interface::CGI::Output;
+use C4::Auth;
+use C4::Breeding;
+
+#------------------
+# Constants
+
+
+
+# HTML colors for alternating lines
+my $lc1='#dddddd';
+my $lc2='#ddaaaa';
+
+#-------------
+#-------------
+# Initialize
+
+my $userid=$ENV{'REMOTE_USER'};
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh;
+
+my $uploadmarc=$input->param('uploadmarc');
+my $overwrite_biblio = $input->param('overwrite_biblio');
+my $filename = $input->param('filename');
+my $syntax = $input->param('syntax');
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/import.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1, management => 1, tools => 1},
+ debug => 1,
+ });
+
+$template->param(SCRIPT_NAME => $ENV{'SCRIPT_NAME'},
+ uploadmarc => $uploadmarc);
+if ($uploadmarc && length($uploadmarc)>0) {
+ my $marcrecord='';
+ while (<$uploadmarc>) {
+ $marcrecord.=$_;
+ }
+ my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported) = ImportBreeding($marcrecord,$overwrite_biblio,$filename,$syntax,"");
+
+ $template->param(imported => $imported,
+ alreadyindb => $alreadyindb,
+ alreadyinfarm => $alreadyinfarm,
+ notmarcrecord => $notmarcrecord,
+ total => $imported+$alreadyindb+$alreadyinfarm+$notmarcrecord,
+ );
+
+}
+
+output_html_with_http_headers $input, $cookie, $template->output;
+my $menu;
+my $file;
+
+
+#---------------
+# log cleared, as marcimport is (almost) rewritten from scratch.
+# $Log: import.pl,v $
+# Revision 1.1.2.1 2007/03/10 01:31:04 tgarip1957
+# fresh files for rel_TG
+#
+# Revision 1.3 2006/09/27 21:19:22 tgarip1957
+# Finalized XML version for intranet
+#
+# Revision 1.2.4.1 2005/04/07 10:10:52 tipaul
+# copying processz3950queue from 2.0 branch. The 2.2 version misses an important fix
+#
Index: koha-news.pl
===================================================================
RCS file: koha-news.pl
diff -N koha-news.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ koha-news.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,98 @@
+#!/usr/bin/perl
+
+# Script to manage the opac news.
+# written 11/04
+# Castañeda, Carlos Sebastian - seba3c at yahoo.com.ar - Physics Library UNLP Argentina
+# Modified to include news to KOHA intranet - tgarip at neu.edu.tr NEU library -Cyprus
+# 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::NewsChannels;
+
+
+my $cgi = new CGI;
+
+my $id = $cgi->param('id');
+my $title = $cgi->param('title');
+my $new = $cgi->param('new');
+my $lang = $cgi->param('lang');
+my $new_detail = get_opac_new($id);
+
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name => "tools/koha-news.tmpl",
+ query => $cgi,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {management => 1},
+ debug => 1,
+ });
+
+# get lang list
+my @lang_list;
+
+foreach my $language (getalllanguages()) {
+ push @lang_list, { language => $language,
+ selected => ($new_detail->{lang} eq $language?1:0),
+ };
+}
+$template->param(lang_list => \@lang_list);
+
+my $op = $cgi->param('op');
+
+if ($op eq 'add_form') {
+ $template->param(add_form => 1);
+ if ($id) {
+ $template->param(op => 'edit');
+ $template->param($new_detail);
+ $template->param(id => $new_detail->{'idnew'});
+ } else {
+ $template->param(op => 'add');
+ }
+
+} elsif ($op eq 'add') {
+
+ add_opac_new($title, $new, $lang);
+# print $cgi->redirect('/cgi-bin/koha/tools/koha-news.pl');
+
+} elsif ($op eq 'edit') {
+
+ upd_opac_new($id, $title, $new, $lang);
+# print $cgi->redirect('/cgi-bin/koha/tools/koha-news.pl');
+
+} elsif ($op eq 'del') {
+ my @ids = $cgi->param('ids');
+ del_opac_new(join ",", @ids);
+# print $cgi->redirect('/cgi-bin/koha/tools/koha-news.pl');
+
+}
+
+ my ($opac_news_count, $opac_news) = &get_opac_news(undef, $lang);
+ $template->param($lang => 1);
+ $template->param(opac_news => $opac_news);
+ $template->param(opac_news_count => $opac_news_count);
+
+
+
+output_html_with_http_headers $cgi, $cookie, $template->output;
Index: letter.pl
===================================================================
RCS file: letter.pl
diff -N letter.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ letter.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,229 @@
+#!/usr/bin/perl
+
+#script to administer the aqbudget table
+#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)
+
+# ALGO :
+# this script use an $op to know what to do.
+# if $op is empty or none of the above values,
+# - the default screen is build (with all records, or filtered datas).
+# - the user can clic on add, modify or delete record.
+# if $op=add_form
+# - if primkey exists, this is a modification,so we read the $primkey record
+# - builds the add/modify form
+# if $op=add_validate
+# - the user has just send datas, so we create/modify the record
+# if $op=delete_form
+# - we show the record having primkey=$primkey and ask for deletion validation form
+# if $op=delete_confirm
+# - we delete the record having primkey=$primkey
+
+
+# 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::Date;
+use C4::Auth;
+use C4::Context;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Search;
+use HTML::Template;
+
+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 letter where (code like ?) order by module,code");
+ $sth->execute("$data[0]%");
+ my @results;
+ my $cnt=0;
+ while (my $data=$sth->fetchrow_hashref){
+ push(@results,$data);
+ $cnt ++;
+ }
+ # $sth->execute;
+ $sth->finish;
+ return ($cnt,\@results);
+}
+
+my $input = new CGI;
+my $searchfield=$input->param('searchfield');
+my $offset=$input->param('offset');
+my $script_name="/cgi-bin/koha/tools/letter.pl";
+my $code=$input->param('code');
+my $module = $input->param('module');
+my $pagesize=20;
+my $op = $input->param('op');
+$searchfield=~ s/\,//g;
+my $dbh = C4::Context->dbh;
+
+my ($template, $borrowernumber, $cookie)
+ = get_template_and_user({template_name => "tools/letter.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {tools => 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
+}
+
+$template->param(action => $script_name);
+################## 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 $letter;
+ if ($code) {
+ my $sth=$dbh->prepare("select * from letter where module=? and code=?");
+ $sth->execute($module,$code);
+ $letter=$sth->fetchrow_hashref;
+ $sth->finish;
+ }
+ # build field list
+ my @SQLfieldname;
+ my %line = ('value' => "LibrarianFirstname", 'text' => 'LibrarianFirstname');
+ push @SQLfieldname, \%line;
+ my %line = ('value' => "LibrarianSurname", 'text' => 'LibrarianSurname');
+ push @SQLfieldname, \%line;
+ my %line = ('value' => "LibrarianEmailaddress", 'text' => 'LibrarianEmailaddress');
+ push @SQLfieldname, \%line;
+ my $sth2=$dbh->prepare("SHOW COLUMNS from branches");
+ $sth2->execute;
+ my %line = ('value' => "", 'text' => '---BRANCHES---');
+ push @SQLfieldname, \%line;
+ while ((my $field) = $sth2->fetchrow_array) {
+ my %line = ('value' => "branches.".$field, 'text' => "branches.".$field);
+ push @SQLfieldname, \%line;
+ }
+ my $sth2=$dbh->prepare("SHOW COLUMNS from biblio");
+ $sth2->execute;
+ my %line = ('value' => "", 'text' => '---BIBLIO---');
+
+ push @SQLfieldname, \%line;
+ while ((my $field) = $sth2->fetchrow_array) {
+ # note : %line is redefined, otherwise \%line contains the same value for every entry of the list
+ my %line = ('value' => "biblio.".$field, 'text' => "biblio.".$field);
+ push @SQLfieldname, \%line;
+ }
+ my $sth2=$dbh->prepare("SHOW COLUMNS from biblioitems");
+ $sth2->execute;
+ my %line = ('value' => "", 'text' => '---BIBLIOITEMS---');
+ push @SQLfieldname, \%line;
+ while ((my $field) = $sth2->fetchrow_array) {
+ my %line = ('value' => "biblioitems.".$field, 'text' => "biblioitems.".$field);
+ push @SQLfieldname, \%line;
+ }
+ my %line = ('value' => "", 'text' => '---ITEMS---');
+ push @SQLfieldname, \%line;
+ my %line = ('value' => "items.content", 'text' => 'items.content');
+ push @SQLfieldname, \%line;
+
+ my $sth2=$dbh->prepare("SHOW COLUMNS from borrowers");
+ $sth2->execute;
+ my %line = ('value' => "", 'text' => '---BORROWERS---');
+ push @SQLfieldname, \%line;
+ while ((my $field) = $sth2->fetchrow_array) {
+ my %line = ('value' => "borrowers.".$field, 'text' => "borrowers.".$field);
+ push @SQLfieldname, \%line;
+ }
+ if ($code) {
+ $template->param(modify => 1);
+ $template->param(code => $letter->{code});
+ } else {
+ $template->param(adding => 1);
+ }
+ $template->param(name => $letter->{name},title => $letter->{title},
+ content => $letter->{content},
+ $letter->{module} => 1,
+ SQLfieldname => \@SQLfieldname,);
+ # 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 letter (module,code,name,title,content) values (?,?,?,?,?)");
+ $sth->execute($input->param('module'),$input->param('code'),$input->param('name'),$input->param('title'),$input->param('content'));
+ $sth->finish;
+ print $input->redirect("letter.pl");
+ 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 letter where code=?");
+ $sth->execute($code);
+ my $data=$sth->fetchrow_hashref;
+ $sth->finish;
+ $template->param(module => $data->{module});
+ $template->param(code => $code);
+ $template->param(name => $data->{'name'});
+ $template->param(content => $data->{'content'});
+ # 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;
+ my $code=uc($input->param('code'));
+ my $module=$input->param('module');
+ my $sth=$dbh->prepare("delete from letter where module=? and code=?");
+ $sth->execute($module,$code);
+ $sth->finish;
+ print $input->redirect("letter.pl");
+ return;
+ # END $OP eq DELETE_CONFIRMED
+################## DEFAULT ##################################
+} else { # DEFAULT
+ if ($searchfield ne '') {
+ $template->param(search => 1);
+ $template->param(searchfield => $searchfield);
+ }
+ 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++){
+ if ($toggle eq 'white'){
+ $toggle="#ffffcc";
+ } else {
+ $toggle="white";
+ }
+ my %row_data;
+ $row_data{toggle} = $toggle;
+ $row_data{module} = $results->[$i]{'module'};
+ $row_data{code} = $results->[$i]{'code'};
+ $row_data{name} = $results->[$i]{'name'};
+ push(@loop_data, \%row_data);
+ }
+ $template->param(letter => \@loop_data);
+} #---- END $OP eq DEFAULT
+
+output_html_with_http_headers $input, $cookie, $template->output;
+
Index: newHolidays.pl
===================================================================
RCS file: newHolidays.pl
diff -N newHolidays.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ newHolidays.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,41 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+
+use C4::Auth;
+use C4::Output;
+use C4::Interface::CGI::Output;
+use C4::Calendar::Calendar;
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh();
+
+my $branchcode = $input->param('newBranchName');
+my $weekday = $input->param('newWeekday');
+my $day = $input->param('newDay');
+my $month = $input->param('newMonth');
+my $year = $input->param('newYear');
+my $title = $input->param('newTitle');
+my $description = $input->param('newDescription');
+
+my $calendar = C4::Calendar::Calendar->new(branchcode => $branchcode);
+
+if ($input->param('newOperation') eq 'weekday') {
+ $calendar->insert_week_day_holiday(weekday => $weekday,
+ title => $title,
+ description => $description);
+} elsif ($input->param('newOperation') eq 'repeatable') {
+ $calendar->insert_day_month_holiday(day => $day,
+ month => $month,
+ title => $title,
+ description => $description);
+} elsif ($input->param('newOperation') eq 'holiday') {
+ $calendar->insert_single_holiday(day => $day,
+ month => $month,
+ year => $year,
+ title => $title,
+ description => $description);
+
+}
+print $input->redirect("/cgi-bin/koha/tools/holidays.pl?branch=$branchcode");
\ No newline at end of file
Index: overduerules.pl
===================================================================
RCS file: overduerules.pl
diff -N overduerules.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ overduerules.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,202 @@
+#!/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::Context;
+use C4::Auth;
+use C4::Koha;
+use C4::Interface::CGI::Output;
+
+
+my $input = new CGI;
+my $dbh = C4::Context->dbh;
+
+my $type=$input->param('type');
+my $branch = $input->param('branch');
+$branch="" unless $branch;
+my $op = $input->param('op');
+
+# my $flagsrequired;
+# $flagsrequired->{circulation}=1;
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/overduerules.tmpl",
+ query => $input,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1, tools => 1},
+ debug => 1,
+ });
+my $err=0;
+
+# save the values entered into tables
+my %temphash;
+if ($op eq 'save') {
+ my @names=$input->param();
+ my $sth_search = $dbh->prepare("select count(*) as total from overduerules where branchcode=? and categorycode=?");
+
+ my $sth_insert = $dbh->prepare("insert into overduerules (branchcode,categorycode, delay1,letter1,debarred1, delay2,letter2,debarred2, delay3,letter3,debarred3) values (?,?,?,?,?,?,?,?,?,?,?)");
+ my $sth_update=$dbh->prepare("Update overduerules set delay1=?, letter1=?, debarred1=?, delay2=?, letter2=?, debarred2=?, delay3=?, letter3=?, debarred3=? where branchcode=? and categorycode=?");
+ my $sth_delete=$dbh->prepare("delete from overduerules where branchcode=? and categorycode=?");
+ foreach my $key (@names){
+ # ISSUES
+ if ($key =~ /(.*)([1-3])-(.*)/) {
+ my $type = $1; # data type
+ my $num = $2; # From 1 to 3
+ my $bor = $3; # borrower category
+ $temphash{$bor}->{"$type$num"}=$input->param("$key") if (($input->param("$key") ne "") or ($input->param("$key")>0));
+ }
+ }
+ foreach my $bor (keys %temphash){
+ # Do some Checking here : delay1 < delay2 <delay3 all of them being numbers
+ # Raise error if not true
+ if ($temphash{$bor}->{delay1}=~/[^0-9]/ and $temphash{$bor}->{delay1} ne ""){
+ $template->param("ERROR"=>1,"ERRORDELAY"=>"delay1","BORERR"=>$bor);
+ $err=1;
+ } elsif ($temphash{$bor}->{delay2}=~/[^0-9]/ and $temphash{$bor}->{delay2} ne ""){
+ $template->param("ERROR"=>1,"ERRORDELAY"=>"delay2","BORERR"=>$bor);
+ $err=1;
+ } elsif ($temphash{$bor}->{delay3}=~/[^0-9]/ and $temphash{$bor}->{delay3} ne ""){
+ $template->param("ERROR"=>1,"ERRORDELAY"=>"delay3","BORERR"=>$bor);
+ $err=1;
+ }elsif ($temphash{$bor}->{delay3} and ($temphash{$bor}->{delay3}<=$temphash{$bor}->{delay2}
+ or $temphash{$bor}->{delay3}<=$temphash{$bor}->{delay1})
+ or $temphash{$bor}->{delay2} and ($temphash{$bor}->{delay2}<=$temphash{$bor}->{delay1})){
+ $template->param("ERROR"=>1,"ERRORORDER"=>1,"BORERR"=>$bor);
+ $err=1;
+ }
+ unless ($err){
+ if (($temphash{$bor}->{delay1} and ($temphash{$bor}->{"letter1"} or $temphash{$bor}->{"debarred1"}))
+ or ($temphash{$bor}->{delay2} and ($temphash{$bor}->{"letter2"} or $temphash{$bor}->{"debarred2"}))
+ or ($temphash{$bor}->{delay3} and ($temphash{$bor}->{"letter3"} or $temphash{$bor}->{"debarred3"}))) {
+ $sth_search->execute($branch,$bor);
+ my $res = $sth_search->fetchrow_hashref();
+ if ($res->{'total'}>0) {
+ $sth_update->execute(
+ ($temphash{$bor}->{"delay1"}?$temphash{$bor}->{"delay1"}:0),
+ ($temphash{$bor}->{"letter1"}?$temphash{$bor}->{"letter1"}:""),
+ ($temphash{$bor}->{"debarred1"}?$temphash{$bor}->{"debarred1"}:0),
+ ($temphash{$bor}->{"delay2"}?$temphash{$bor}->{"delay2"}:0),
+ ($temphash{$bor}->{"letter2"}?$temphash{$bor}->{"letter2"}:""),
+ ($temphash{$bor}->{"debarred2"}?$temphash{$bor}->{"debarred2"}:0),
+ ($temphash{$bor}->{"delay3"}?$temphash{$bor}->{"delay3"}:0),
+ ($temphash{$bor}->{"letter3"}?$temphash{$bor}->{"letter3"}:""),
+ ($temphash{$bor}->{"debarred3"}?$temphash{$bor}->{"debarred3"}:0),
+ $branch ,$bor
+ );
+ } else {
+ $sth_insert->execute($branch,$bor,
+ ($temphash{$bor}->{"delay1"}?$temphash{$bor}->{"delay1"}:0),
+ ($temphash{$bor}->{"letter1"}?$temphash{$bor}->{"letter1"}:""),
+ ($temphash{$bor}->{"debarred1"}?$temphash{$bor}->{"debarred1"}:0),
+ ($temphash{$bor}->{"delay2"}?$temphash{$bor}->{"delay2"}:0),
+ ($temphash{$bor}->{"letter2"}?$temphash{$bor}->{"letter2"}:""),
+ ($temphash{$bor}->{"debarred2"}?$temphash{$bor}->{"debarred2"}:0),
+ ($temphash{$bor}->{"delay3"}?$temphash{$bor}->{"delay3"}:0),
+ ($temphash{$bor}->{"letter3"}?$temphash{$bor}->{"letter3"}:""),
+ ($temphash{$bor}->{"debarred3"}?$temphash{$bor}->{"debarred3"}:0)
+ );
+ }
+ }
+ }
+ }
+ unless ($err) {$template->param(datasaved=>1);}
+}
+my $branches = getbranches;
+my @branchloop;
+foreach my $thisbranch (keys %$branches) {
+ my $selected = 1 if $thisbranch eq $branch;
+ my %row =(value => $thisbranch,
+ selected => $selected,
+ branchname => $branches->{$thisbranch}->{'branchname'},
+ );
+ push @branchloop, \%row;
+}
+
+my ($countletters,$letters) = getletters("circulation");
+
+my $sth=$dbh->prepare("Select description,categorycode from categories where overduenoticerequired>0 order by description");
+$sth->execute;
+my @line_loop;
+my $toggle= 1;
+# my $i=0;
+while (my $data=$sth->fetchrow_hashref){
+ if ( $toggle eq 1 ) {
+ $toggle = 0;
+ } else {
+ $toggle = 1;
+ }
+ my %row = ( overduename => $data->{'categorycode'},
+ toggle => $toggle,
+ line => $data->{'description'}
+ );
+ if (%temphash){
+ for (my $i=1;$i<=3;$i++){
+ $row{"delay$i"}=$temphash{$data->{'categorycode'}}->{"delay$i"};
+ $row{"debarred$i"}=$temphash{$data->{'categorycode'}}->{"debarred$i"};
+ if ($countletters){
+ my @letterloop;
+ foreach my $thisletter (keys %$letters) {
+ my $selected = 1 if $thisletter eq $temphash{$data->{'categorycode'}}->{"letter$i"};
+ my %letterrow =(value => $thisletter,
+ selected => $selected,
+ lettername => $letters->{$thisletter},
+ );
+ push @letterloop, \%letterrow;
+ }
+ $row{"letterloop$i"}=\@letterloop;
+ } else {
+ $row{"noletter"}=1;
+ $row{"letter$i"}=$temphash{$data->{'categorycode'}}->{"letter$i"};
+ }
+ }
+ } else {
+ #getting values from table
+ my $sth2=$dbh->prepare("SELECT * from overduerules WHERE branchcode=? and categorycode=?");
+ $sth2->execute($branch,$data->{'categorycode'});
+ my $dat=$sth2->fetchrow_hashref;
+ for (my $i=1;$i<=3;$i++){
+ if ($countletters){
+ my @letterloop;
+ foreach my $thisletter (keys %$letters) {
+ my $selected = 1 if $thisletter eq $dat->{"letter$i"};
+ my %letterrow =(value => $thisletter,
+ selected => $selected,
+ lettername => $letters->{$thisletter},
+ );
+ push @letterloop, \%letterrow;
+ }
+ $row{"letterloop$i"}=\@letterloop;
+ } else {
+ $row{"noletter"}=1;
+ if ($dat->{"letter$i"}){$row{"letter$i"}=$dat->{"letter$i"};}
+ }
+ if ($dat->{"delay$i"}){$row{"delay$i"}=$dat->{"delay$i"};}
+ if ($dat->{"debarred$i"}){$row{"debarred$i"}=$dat->{"debarred$i"};}
+ }
+ $sth2->finish;
+ }
+ push @line_loop,\%row;
+}
+$sth->finish;
+
+$template->param(table=> \@line_loop,
+ branchloop => \@branchloop,
+ branch => $branch);
+output_html_with_http_headers $input, $cookie, $template->output;
Index: pdfViewer.pl
===================================================================
RCS file: pdfViewer.pl
diff -N pdfViewer.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ pdfViewer.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,40 @@
+#!/usr/bin/perl
+
+# script to show a PDF file.
+# written 07/04
+# by Veleda Matias - matias_veleda at hotmail.com - Physics Library UNLP Argentina and
+# Castañeda Sebastian - seba3c at yahoo.com.ar - Physics Library UNLP Argentina and
+
+# 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
+
+require Exporter;
+
+use strict;
+use C4::Context;
+use CGI;
+
+# This script take a pdf filename as a parameter and output it to the browser.
+my $cgi = new CGI;
+my $filename = "barcodes.pdf";
+my $tmpFileName = $cgi->param('tmpFileName');
+print "Content-Disposition: attachment; filename = $filename\n\n";
+print $cgi->header(-type => 'application/pdf'),
+ $cgi->start_html(-title=>"Codify to PDF");
+open fh, "<$tmpFileName";
+while (<fh>) {
+ print;
+}
+print $cgi->end_html();
Index: printerConfig.pl
===================================================================
RCS file: printerConfig.pl
diff -N printerConfig.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ printerConfig.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+
+# script to set the labels configuration for the printer process.
+# written 07/04
+# by Veleda Matias - matias_veleda at hotmail.com - Physics Library UNLP Argentina and
+
+# 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
+
+require Exporter;
+
+use strict;
+
+use CGI;
+use C4::Context;
+use C4::Output;
+use C4::Auth;
+use PDF::API2;
+use PDF::API2::Page;
+use PDF::API2::PDF::Utils;
+use C4::Interface::CGI::Output;
+
+# This function returns the path to deal with the correct files, considering
+# templates set and language.
+sub getPath {
+ my $type = shift @_;
+ my $templatesSet = C4::Context->preference('template');
+ my $lang = C4::Context->preference('opaclanguages');
+ if ($type eq "intranet") {
+ return "$ENV{'DOCUMENT_ROOT'}/intranet-tmpl/$templatesSet/$lang";
+ } else {
+ return "$ENV{'DOCUMENT_ROOT'}/opac-tmpl/$templatesSet/$lang";
+ }
+}
+
+# Load a configuration file.
+sub loadConfFromFile {
+ my $fileName = shift @_;
+ my %keyValues;
+ open FILE, "<$fileName";
+ while (<FILE>) {
+ chomp;
+ if (/\s*([\w_]*)\s*=\s*([\[\]\<\>\w_\s:@,\.-]*)\s*/) {
+ $keyValues{$1} = $2;
+ }
+ }
+ close FILE;
+ return %keyValues;
+}
+
+# Save settings to a configuration file.
+sub saveConfToFile {
+ my $fileName = shift @_;
+ my %keyValues = %{shift @_};
+ my $i;
+ open FILE, ">$fileName";
+ my $i;
+ foreach $i (keys(%keyValues)) {
+ print FILE $i." = ".$keyValues{$i}."\n";
+ }
+ close FILE;
+}
+
+# Creates a CGI object and take his parameters
+my $input = new CGI;
+
+if ($input->param('saveSettings')) {
+ my $labelConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+ my %newConfiguration = (pageType => $input->param('pageType'),
+ columns => $input->param('columns'),
+ rows => $input->param('rows'),
+ systemDpi => $input->param('systemDpi'),
+ labelWidth => $input->param('labelWidth'),
+ labelHeigth => $input->param('labelHeigth'),
+ marginBottom => $input->param('marginBottom'),
+ marginLeft => $input->param('marginLeft'));
+ saveConfToFile($labelConf, \%newConfiguration);
+ print $input->redirect('/cgi-bin/koha/barcodes/barcodes.pl')
+}
+
+# Get the template to use
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/printerConfig.tmpl",
+ type => "intranet",
+ query => $input,
+ authnotrequired => 0,
+ flagsrequired => {parameters => 1},
+ debug => 1,
+ });
+
+my $filenameConf = &getPath("intranet")."/includes/labelConfig/itemsLabelConfig.conf";
+my %labelConfig = &loadConfFromFile($filenameConf);
+
+$template->param(COLUMNS => $labelConfig{'columns'});
+$template->param(ROWS => $labelConfig{'rows'});
+$template->param(SYSTEM_DPI => $labelConfig{'systemDpi'});
+$template->param(LABEL_WIDTH => $labelConfig{'labelWidth'});
+$template->param(LABEL_HEIGTH => $labelConfig{'labelHeigth'});
+$template->param(MARGIN_TOP => $labelConfig{'marginBottom'});
+$template->param(MARGIN_LEFT => $labelConfig{'marginLeft'});
+$template->param(SCRIPT_NAME => '/cgi-bin/koha/tools/printerConfig.pl');
+$template->param("$labelConfig{'pageType'}" => 1);
+output_html_with_http_headers $input, $cookie, $template->output;
\ No newline at end of file
Index: tools-home.pl
===================================================================
RCS file: tools-home.pl
diff -N tools-home.pl
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tools-home.pl 10 Mar 2007 01:31:04 -0000 1.1.2.1
@@ -0,0 +1,19 @@
+#!/usr/bin/perl
+
+use strict;
+use CGI;
+use C4::Auth;
+use C4::Interface::CGI::Output;
+
+
+my $query = new CGI;
+my ($template, $loggedinuser, $cookie)
+ = get_template_and_user({template_name => "tools/tools-home.tmpl",
+ query => $query,
+ type => "intranet",
+ authnotrequired => 0,
+ flagsrequired => {tools => 1},
+ debug => 1,
+ });
+
+output_html_with_http_headers $query, $cookie, $template->output;
More information about the Koha-cvs
mailing list