Browse Source

rel_3_0 moved to HEAD (introducing new files)

3.0.x
tipaul 17 years ago
parent
commit
f8e9fb6445
  1. 220
      C4/Barcodes/PrinterConfig.pm
  2. 443
      C4/Branch.pm
  3. 561
      C4/Calendar.pm
  4. 132
      C4/Circulation/Date.pm
  5. 335
      C4/Circulation/Returns.pm
  6. 451
      C4/Languages.pm
  7. 213
      C4/Maintainance.pm
  8. 573
      C4/Record.pm
  9. 142
      C4/tests/Record_test.pl
  10. 1
      C4/tests/testrecords/marc21_marc8.dat
  11. 1
      C4/tests/testrecords/marc21_marc8_combining_chars.dat
  12. 1
      C4/tests/testrecords/marc21_marc8_errors.dat
  13. 1
      C4/tests/testrecords/marc21_utf8.dat
  14. 1
      C4/tests/testrecords/marc21_utf8_combining_chars.dat
  15. 44
      C4/tests/testrecords/marcxml_utf8.xml
  16. 46
      C4/tests/testrecords/marcxml_utf8_entityencoded.xml
  17. 136
      acqui/neworderbiblio.pl
  18. 232
      acqui/orderreceive.pl
  19. 172
      acqui/parcels.pl
  20. 80
      acqui/spent.pl
  21. 180
      admin/biblio_framework.pl
  22. 189
      admin/koha2marclinks.pl
  23. 570
      admin/marc_subfields_structure.pl
  24. 388
      admin/marctagstructure.pl
  25. 267
      catalogue/dictionary.pl
  26. 62
      catalogue/issuehistory.pl
  27. 538
      catalogue/search.pl
  28. 62
      catalogue/suggest.pl
  29. 77
      cataloguing/addbiblio-nomarc.pl
  30. 235
      cataloguing/additem-nomarc.pl
  31. 39
      cataloguing/plugin_launcher.pl
  32. 53
      cataloguing/savebiblio.pl
  33. 95
      cataloguing/saveitem.pl
  34. 125
      cataloguing/thesaurus_popup.pl
  35. 186
      cataloguing/value_builder/labs_theses.pl
  36. 97
      cataloguing/value_builder/marc21_field_003.pl
  37. 119
      cataloguing/value_builder/marc21_field_005.pl
  38. 126
      cataloguing/value_builder/marc21_field_006.pl
  39. 96
      cataloguing/value_builder/marc21_field_007.pl
  40. 155
      cataloguing/value_builder/marc21_field_008.pl
  41. 151
      cataloguing/value_builder/marc21_field_008_authorities.pl
  42. 97
      cataloguing/value_builder/marc21_field_040c.pl
  43. 97
      cataloguing/value_builder/marc21_field_040d.pl
  44. 114
      cataloguing/value_builder/marc21_leader.pl
  45. 106
      cataloguing/value_builder/marc21_leader_authorities.pl
  46. 107
      cataloguing/value_builder/marc21_leader_book.pl
  47. 108
      cataloguing/value_builder/marc21_leader_computerfile.pl
  48. 106
      cataloguing/value_builder/marc21_leader_video.pl
  49. 130
      cataloguing/value_builder/unimarc_field_100.pl
  50. 114
      cataloguing/value_builder/unimarc_field_105.pl
  51. 88
      cataloguing/value_builder/unimarc_field_106.pl
  52. 104
      cataloguing/value_builder/unimarc_field_110.pl
  53. 122
      cataloguing/value_builder/unimarc_field_115a.pl
  54. 108
      cataloguing/value_builder/unimarc_field_115b.pl
  55. 111
      cataloguing/value_builder/unimarc_field_116.pl
  56. 97
      cataloguing/value_builder/unimarc_field_117.pl
  57. 106
      cataloguing/value_builder/unimarc_field_120.pl
  58. 102
      cataloguing/value_builder/unimarc_field_121a.pl
  59. 100
      cataloguing/value_builder/unimarc_field_121b.pl
  60. 96
      cataloguing/value_builder/unimarc_field_122.pl
  61. 88
      cataloguing/value_builder/unimarc_field_123a.pl
  62. 94
      cataloguing/value_builder/unimarc_field_123d.pl
  63. 94
      cataloguing/value_builder/unimarc_field_123e.pl
  64. 94
      cataloguing/value_builder/unimarc_field_123f.pl
  65. 94
      cataloguing/value_builder/unimarc_field_123g.pl
  66. 94
      cataloguing/value_builder/unimarc_field_123i.pl
  67. 94
      cataloguing/value_builder/unimarc_field_123j.pl
  68. 94
      cataloguing/value_builder/unimarc_field_124.pl
  69. 88
      cataloguing/value_builder/unimarc_field_124a.pl
  70. 88
      cataloguing/value_builder/unimarc_field_124b.pl
  71. 88
      cataloguing/value_builder/unimarc_field_124c.pl
  72. 88
      cataloguing/value_builder/unimarc_field_124d.pl
  73. 88
      cataloguing/value_builder/unimarc_field_124e.pl
  74. 88
      cataloguing/value_builder/unimarc_field_124f.pl
  75. 88
      cataloguing/value_builder/unimarc_field_124g.pl
  76. 94
      cataloguing/value_builder/unimarc_field_125.pl
  77. 89
      cataloguing/value_builder/unimarc_field_125a.pl
  78. 88
      cataloguing/value_builder/unimarc_field_125b.pl
  79. 94
      cataloguing/value_builder/unimarc_field_126.pl
  80. 117
      cataloguing/value_builder/unimarc_field_126a.pl
  81. 93
      cataloguing/value_builder/unimarc_field_126b.pl
  82. 92
      cataloguing/value_builder/unimarc_field_127.pl
  83. 88
      cataloguing/value_builder/unimarc_field_128a.pl
  84. 88
      cataloguing/value_builder/unimarc_field_128b.pl
  85. 88
      cataloguing/value_builder/unimarc_field_128c.pl
  86. 107
      cataloguing/value_builder/unimarc_field_130.pl
  87. 107
      cataloguing/value_builder/unimarc_field_135a.pl
  88. 132
      cataloguing/value_builder/unimarc_field_140.pl
  89. 104
      cataloguing/value_builder/unimarc_field_141.pl
  90. 254
      cataloguing/value_builder/unimarc_field_210c.pl
  91. 161
      cataloguing/value_builder/unimarc_field_225a.pl
  92. 386
      cataloguing/value_builder/unimarc_field_4XX.pl
  93. 118
      cataloguing/value_builder/unimarc_field_60X.pl
  94. 98
      cataloguing/value_builder/unimarc_field_700-4.pl
  95. 158
      cataloguing/value_builder/unimarc_field_700_701_702.pl
  96. 105
      cataloguing/value_builder/unimarc_leader.pl
  97. 101
      cataloguing/value_builder/usmarc_field_952v.pl
  98. 216
      cataloguing/z3950_search.pl
  99. 208
      circ/bookcount.pl
  100. 170
      circ/branchoverdues.pl

220
C4/Barcodes/PrinterConfig.pm

@ -0,0 +1,220 @@
package C4::Barcodes::PrinterConfig;
# 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;
require Exporter;
use vars qw($VERSION @EXPORT);
use PDF::API2;
use PDF::API2::Page;
# set the version for version checking
$VERSION = 0.01;
=head1 NAME
C4::Barcodes::PrinterConfig - Koha module dealing with labels in a PDF.
=head1 SYNOPSIS
use C4::Barcodes::PrinterConfig;
=head1 DESCRIPTION
This package is used to deal with labels in a pdf file. Giving some parameters,
this package contains several functions to handle every label considering the
environment of the pdf file.
=head1 FUNCTIONS
=over 2
=cut
@EXPORT = qw(&labelsPage &getLabelPosition setPositionsForX setPositionsForY);
my @positionsForX; # Takes all the X positions of the pdf file.
my @positionsForY; # Takes all the Y positions of the pdf file.
my $firstLabel = 1; # Test if the label passed as a parameter is the first label to be printed into the pdf file.
=item setPositionsForX
C4::Barcodes::PrinterConfig::setPositionsForX($marginLeft, $labelWidth, $columns, $pageType);
Calculate and stores all the X positions across the pdf page.
C<$marginLeft> Indicates how much left margin do you want in your page type.
C<$labelWidth> Indicates the width of the label that you are going to use.
C<$columns> Indicates how many columns do you want in your page type.
C<$pageType> Page type to print (eg: a4, legal, etc).
=cut
#'
sub setPositionsForX {
my ($marginLeft, $labelWidth, $columns, $pageType) = @_;
my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch
my $whereToStart = ($marginLeft + ($labelWidth/2));
my $firstLabel = $whereToStart*$defaultDpi;
my $spaceBetweenLabels = $labelWidth*$defaultDpi;
my @positions;
for (my $i = 0; $i < $columns ; $i++) {
push @positions, ($firstLabel+($spaceBetweenLabels*$i));
}
@positionsForX = @positions;
}
=item setPositionsForY
C4::Barcodes::PrinterConfig::setPositionsForY($marginBottom, $labelHeigth, $rows, $pageType);
Calculate and stores all tha Y positions across the pdf page.
C<$marginBottom> Indicates how much bottom margin do you want in your page type.
C<$labelHeigth> Indicates the height of the label that you are going to use.
C<$rows> Indicates how many rows do you want in your page type.
C<$pageType> Page type to print (eg: a4, legal, etc).
=cut
#'
sub setPositionsForY {
my ($marginBottom, $labelHeigth, $rows, $pageType) = @_;
my $defaultDpi = 72/25.4; # By default we know 25.4 mm -> 1 inch -> 72 dots per inch
my $whereToStart = ($marginBottom + ($labelHeigth/2));
my $firstLabel = $whereToStart*$defaultDpi;
my $spaceBetweenLabels = $labelHeigth*$defaultDpi;
my @positions;
for (my $i = 0; $i < $rows; $i++) {
unshift @positions, ($firstLabel+($spaceBetweenLabels*$i));
}
@positionsForY = @positions;
}
=item getLabelPosition
(my $x, my $y, $pdfObject, $pageObject, $gfxObject, $textObject, $coreObject, $labelPosition) =
C4::Barcodes::PrinterConfig::getLabelPosition($labelPosition,
$pdfObject,
$page,
$gfx,
$text,
$fontObject,
$pageType);
Return the (x,y) position of the label that you are going to print considering the environment.
C<$labelPosition> Indicates which label positions do you want to place by x and y coordinates.
C<$pdfObject> The PDF object in use.
C<$page> The page in use.
C<$gfx> The gfx resource to handle with barcodes objects.
C<$text> The text resource to handle with text.
C<$fontObject> The font object
C<$pageType> Page type to print (eg: a4, legal, etc).
=cut
#'
sub getLabelPosition {
my ($labelNum, $pdf, $page, $gfxObject, $textObject, $fontObject, $pageType) = @_;
my $indexX = $labelNum % @positionsForX;
my $indexY = int($labelNum / @positionsForX);
# Calculates the next label position and return that label number
my $nextIndexX = $labelNum % @positionsForX;
my $nextIndexY = $labelNum % @positionsForY;
if ($firstLabel) {
$page = $pdf->page;
$page->mediabox($pageType);
$gfxObject = $page->gfx;
$textObject = $page->text;
$textObject->font($fontObject, 7);
$firstLabel = 0;
} elsif (($nextIndexX == 0) && ($nextIndexY == 0)) {
$page = $pdf->page;
$page->mediabox($pageType);
$gfxObject = $page->gfx;
$textObject = $page->text;
$textObject->font($fontObject, 7);
}
$labelNum = $labelNum + 1;
if ($labelNum == (@positionsForX*@positionsForY)) {
$labelNum = 0;
}
return ($positionsForX[$indexX], $positionsForY[$indexY], $pdf, $page, $gfxObject, $textObject, $fontObject, $labelNum);
}
=item labelsPage
my @labelTable = C4::Barcodes::PrinterConfig::labelsPage($rows, $columns);
This function will help you to build the labels panel, where you can choose
wich label position do you want to start the printer process.
C<$rows> Indicates how many rows do you want in your page type.
C<$columns> Indicates how many rows do you want in your page type.
=cut
#'
sub labelsPage{
my ($rows, $columns) = @_;
my @pageType;
my $tagname = 0;
my $labelname = 1;
my $check;
for (my $i = 1; $i <= $rows; $i++) {
my @column;
for (my $j = 1; $j <= $columns; $j++) {
my %cell;
if ($tagname == 0) {
$check = 'checked';
} else {
$check = '';
}
%cell = (check => $check,
tagname => $tagname,
labelname => $labelname);
$tagname = $tagname + 1;
$labelname = $labelname + 1;
push @column, \%cell;
}
my %columns = (columns => \@column);
push @pageType, \%columns;
}
return @pageType;
}
1;
__END__
=back
=head1 AUTHOR
Koha Physics Library UNLP <matias_veleda@hotmail.com>
=cut

443
C4/Branch.pm

@ -0,0 +1,443 @@
package C4::Branch;
# 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$
use strict;
require Exporter;
use C4::Context;
use C4::Koha;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
C4::Branch - Koha branch module
=head1 SYNOPSIS
use C4::Branch;
=head1 DESCRIPTION
The functions in this module deal with branches.
=head1 FUNCTIONS
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
&GetBranchCategory
&GetBranchName
&GetBranch
&GetBranches
&GetBranchDetail
&get_branchinfos_of
&ModBranch
&CheckBranchCategorycode
&GetBranchInfo
&ModBranchCategoryInfo
&DelBranch
);
=head2 GetBranches
$branches = &GetBranches();
returns informations about ALL branches.
Create a branch selector with the following code
IndependantBranches Insensitive...
=head3 in PERL SCRIPT
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;
}
=head3 in TEMPLATE
<select name="branch">
<option value="">Default</option>
<!-- TMPL_LOOP name="branchloop" -->
<option value="<!-- TMPL_VAR name="value" -->" <!-- TMPL_IF name="selected" -->selected<!-- /TMPL_IF -->><!-- TMPL_VAR name="branchname" --></option>
<!-- /TMPL_LOOP -->
</select>
=cut
sub GetBranches {
my $onlymine=@_;
# returns a reference to a hash of references to ALL branches...
my %branches;
my $dbh = C4::Context->dbh;
my $sth;
my $query="SELECT * from branches";
if ($onlymine && C4::Context->userenv && C4::Context->userenv->{branch}){
$query .= " WHERE branchcode =".$dbh->quote(C4::Context->userenv->{branch});
}
$query.=" order by branchname";
$sth = $dbh->prepare($query);
$sth->execute;
while ( my $branch = $sth->fetchrow_hashref ) {
my $nsth =
$dbh->prepare(
"select categorycode from branchrelations where branchcode = ?");
$nsth->execute( $branch->{'branchcode'} );
while ( my ($cat) = $nsth->fetchrow_array ) {
# FIXME - This seems wrong. It ought to be
# $branch->{categorycodes}{$cat} = 1;
# otherwise, there's a namespace collision if there's a
# category with the same name as a field in the 'branches'
# table (i.e., don't create a category called "issuing").
# In addition, the current structure doesn't really allow
# you to list the categories that a branch belongs to:
# you'd have to list keys %$branch, and remove those keys
# that aren't fields in the "branches" table.
$branch->{$cat} = 1;
}
$branches{ $branch->{'branchcode'} } = $branch;
}
return ( \%branches );
}
=head2 GetBranchName
=cut
sub GetBranchName {
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
$sth = $dbh->prepare("Select branchname from branches where branchcode=?");
$sth->execute($branchcode);
my $branchname = $sth->fetchrow_array;
$sth->finish;
return ($branchname);
}
=head2 ModBranch
&ModBranch($newvalue);
This function modify an existing branches.
C<$newvalue> is a ref to an array wich is containt all the column from branches table.
=cut
sub ModBranch {
my ($data) = @_;
my $dbh = C4::Context->dbh;
if ($data->{add}) {
my $query = "
INSERT INTO branches
(branchcode,branchname,branchaddress1,
branchaddress2,branchaddress3,branchphone,
branchfax,branchemail,branchip,branchprinter)
VALUES (?,?,?,?,?,?,?,?,?,?)
";
my $sth = $dbh->prepare($query);
$sth->execute(
$data->{'branchcode'}, $data->{'branchname'},
$data->{'branchaddress1'}, $data->{'branchaddress2'},
$data->{'branchaddress3'}, $data->{'branchphone'},
$data->{'branchfax'}, $data->{'branchemail'},
$data->{'branchip'}, $data->{'branchprinter'},
);
} else {
my $query = "
UPDATE branches
SET branchname=?,branchaddress1=?,
branchaddress2=?,branchaddress3=?,branchphone=?,
branchfax=?,branchemail=?,branchip=?,branchprinter=?
WHERE branchcode=?
";
my $sth = $dbh->prepare($query);
$sth->execute(
$data->{'branchname'},
$data->{'branchaddress1'}, $data->{'branchaddress2'},
$data->{'branchaddress3'}, $data->{'branchphone'},
$data->{'branchfax'}, $data->{'branchemail'},
$data->{'branchip'}, $data->{'branchprinter'},
$data->{'branchcode'},
);
}
# sort out the categories....
my @checkedcats;
my $cats = GetBranchCategory();
foreach my $cat (@$cats) {
my $code = $cat->{'categorycode'};
if ( $data->{$code} ) {
push( @checkedcats, $code );
}
}
my $branchcode = uc( $data->{'branchcode'} );
my $branch = GetBranchInfo($branchcode);
$branch = $branch->[0];
my $branchcats = $branch->{'categories'};
my @addcats;
my @removecats;
foreach my $bcat (@$branchcats) {
unless ( grep { /^$bcat$/ } @checkedcats ) {
push( @removecats, $bcat );
}
}
foreach my $ccat (@checkedcats) {
unless ( grep { /^$ccat$/ } @$branchcats ) {
push( @addcats, $ccat );
}
}
foreach my $cat (@addcats) {
my $sth =
$dbh->prepare(
"insert into branchrelations (branchcode, categorycode) values(?, ?)"
);
$sth->execute( $branchcode, $cat );
$sth->finish;
}
foreach my $cat (@removecats) {
my $sth =
$dbh->prepare(
"delete from branchrelations where branchcode=? and categorycode=?"
);
$sth->execute( $branchcode, $cat );
$sth->finish;
}
}
=head2 GetBranchCategory
$results = GetBranchCategory($categorycode);
C<$results> is an ref to an array.
=cut
sub GetBranchCategory {
# returns a reference to an array of hashes containing branches,
my ($catcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
# print DEBUG "GetBranchCategory: entry: catcode=".cvs($catcode)."\n";
if ($catcode) {
$sth =
$dbh->prepare(
"select * from branchcategories where categorycode = ?");
$sth->execute($catcode);
}
else {
$sth = $dbh->prepare("Select * from branchcategories");
$sth->execute();
}
my @results;
while ( my $data = $sth->fetchrow_hashref ) {
push( @results, $data );
}
$sth->finish;
# print DEBUG "GetBranchCategory: exit: returning ".cvs(\@results)."\n";
return \@results;
}
=head2 GetBranch
$branch = GetBranch( $query, $branches );
=cut
sub GetBranch ($$) {
my ( $query, $branches ) = @_; # get branch for this query from branches
my $branch = $query->param('branch');
my %cookie = $query->cookie('userenv');
($branch) || ($branch = $cookie{'branchname'});
( $branches->{$branch} ) || ( $branch = ( keys %$branches )[0] );
return $branch;
}
=head2 GetBranchDetail
$branchname = &GetBranchDetail($branchcode);
Given the branch code, the function returns the corresponding
branch name for a comprehensive information display
=cut
sub GetBranchDetail {
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("SELECT * FROM branches WHERE branchcode = ?");
$sth->execute($branchcode);
my $branchname = $sth->fetchrow_hashref();
$sth->finish();
return $branchname;
}
=head2 get_branchinfos_of
my $branchinfos_of = get_branchinfos_of(@branchcodes);
Associates a list of branchcodes to the information of the branch, taken in
branches table.
Returns a href where keys are branchcodes and values are href where keys are
branch information key.
print 'branchname is ', $branchinfos_of->{$code}->{branchname};
=cut
sub get_branchinfos_of {
my @branchcodes = @_;
my $query = '
SELECT branchcode,
branchname
FROM branches
WHERE branchcode IN ('
. join( ',', map( { "'" . $_ . "'" } @branchcodes ) ) . ')
';
return C4::Koha::get_infos_of( $query, 'branchcode' );
}
=head2 GetBranchInfo
$results = GetBranchInfo($branchcode);
returns C<$results>, a reference to an array of hashes containing branches.
=cut
sub GetBranchInfo {
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth;
if ($branchcode) {
$sth =
$dbh->prepare(
"Select * from branches where branchcode = ? order by branchcode");
$sth->execute($branchcode);
}
else {
$sth = $dbh->prepare("Select * from branches order by branchcode");
$sth->execute();
}
my @results;
while ( my $data = $sth->fetchrow_hashref ) {
my $nsth =
$dbh->prepare(
"select categorycode from branchrelations where branchcode = ?");
$nsth->execute( $data->{'branchcode'} );
my @cats = ();
while ( my ($cat) = $nsth->fetchrow_array ) {
push( @cats, $cat );
}
$nsth->finish;
$data->{'categories'} = \@cats;
push( @results, $data );
}
$sth->finish;
return \@results;
}
=head2 DelBranch
&DelBranch($branchcode);
=cut
sub DelBranch {
my ($branchcode) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("delete from branches where branchcode = ?");
$sth->execute($branchcode);
$sth->finish;
}
=head2 ModBranchCategoryInfo
&ModBranchCategoryInfo($data);
sets the data from the editbranch form, and writes to the database...
=cut
sub ModBranchCategoryInfo {
my ($data) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("replace branchcategories (categorycode,categoryname,codedescription) values (?,?,?)");
$sth->execute(uc( $data->{'categorycode'} ),$data->{'categoryname'}, $data->{'codedescription'} );
$sth->finish;
}
=head2 DeleteBranchCategory
DeleteBranchCategory($categorycode);
=cut
sub DeleteBranchCategory {
my ($categorycode) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("delete from branchcategories where categorycode = ?");
$sth->execute($categorycode);
$sth->finish;
}
=head2 CheckBranchCategorycode
$number_rows_affected = CheckBranchCategorycode($categorycode);
=cut
sub CheckBranchCategorycode {
# check to see if the branchcode is being used in the database somewhere....
my ($categorycode) = @_;
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
"select count(*) from branchrelations where categorycode=?");
$sth->execute($categorycode);
my ($total) = $sth->fetchrow_array;
return $total;
}
=head1 AUTHOR
Koha Developement team <info@koha.org>
=cut

561
C4/Calendar.pm

@ -0,0 +1,561 @@
package C4::Calendar;
# 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;
require Exporter;
use vars qw($VERSION @EXPORT);
#use Date::Manip;
# use Date::Calc;
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v).".".join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
C4::Calendar::Calendar - Koha module dealing with holidays.
=head1 SYNOPSIS
use C4::Calendar::Calendar;
=head1 DESCRIPTION
This package is used to deal with holidays. Through this package, you can set all kind of holidays for the library.
=head1 FUNCTIONS
=over 2
=cut
@EXPORT = qw(&new
&change_branchcode
&get_week_days_holidays
&get_day_month_holidays
&get_exception_holidays
&get_single_holidays
&insert_week_day_holiday
&insert_day_month_holiday
&insert_single_holiday
&insert_exception_holiday
&delete_holiday
&isHoliday
&addDate
&daysBetween);
=item new
$calendar = C4::Calendar::Calendar->new(branchcode => $branchcode);
C<$branchcode> Is the branch code wich you want to use calendar.
=cut
sub new {
my $classname = shift @_;
my %options = @_;
my %hash;
my $self = bless(\%hash, $classname);
foreach my $optionName (keys %options) {
$self->{lc($optionName)} = $options{$optionName};
}
$self->_init;
return $self;
}
sub _init {
my $self = shift @_;
my $dbh = C4::Context->dbh();
my $week_days_sql = $dbh->prepare("select weekday, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and (NOT(ISNULL(weekday)))");
$week_days_sql->execute;
my %week_days_holidays;
while (my ($weekday, $title, $description) = $week_days_sql->fetchrow) {
$week_days_holidays{$weekday}{title} = $title;
$week_days_holidays{$weekday}{description} = $description;
}
$week_days_sql->finish;
$self->{'week_days_holidays'} = \%week_days_holidays;
my $day_month_sql = $dbh->prepare("select day, month, title, description from repeatable_holidays where ('$self->{branchcode}' = branchcode) and ISNULL(weekday)");
$day_month_sql->execute;
my %day_month_holidays;
while (my ($day, $month, $title, $description) = $day_month_sql->fetchrow) {
$day_month_holidays{"$month/$day"}{title} = $title;
$day_month_holidays{"$month/$day"}{description} = $description;
}
$day_month_sql->finish;
$self->{'day_month_holidays'} = \%day_month_holidays;
my $exception_holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 1)");
$exception_holidays_sql->execute;
my %exception_holidays;
while (my ($day, $month, $year, $title, $description) = $exception_holidays_sql->fetchrow) {
$exception_holidays{"$year/$month/$day"}{title} = $title;
$exception_holidays{"$year/$month/$day"}{description} = $description;
}
$exception_holidays_sql->finish;
$self->{'exception_holidays'} = \%exception_holidays;
my $holidays_sql = $dbh->prepare("select day, month, year, title, description from special_holidays where ('$self->{branchcode}' = branchcode) and (isexception = 0)");
$holidays_sql->execute;
my %single_holidays;
while (my ($day, $month, $year, $title, $description) = $holidays_sql->fetchrow) {
$single_holidays{"$year/$month/$day"}{title} = $title;
$single_holidays{"$year/$month/$day"}{description} = $description;
}
$holidays_sql->finish;
$self->{'single_holidays'} = \%single_holidays;
}
=item change_branchcode
$calendar->change_branchcode(branchcode => $branchcode)
Change the calendar branch code. This means to change the holidays structure.
C<$branchcode> Is the branch code wich you want to use calendar.
=cut
sub change_branchcode {
my ($self, $branchcode) = @_;
my %options = @_;
foreach my $optionName (keys %options) {
$self->{lc($optionName)} = $options{$optionName};
}
$self->_init;
return $self;
}
=item get_week_days_holidays
$week_days_holidays = $calendar->get_week_days_holidays();
Returns a hash reference to week days holidays.
=cut
sub get_week_days_holidays {
my $self = shift @_;
my $week_days_holidays = $self->{'week_days_holidays'};
return $week_days_holidays;
}
=item get_day_month_holidays
$day_month_holidays = $calendar->get_day_month_holidays();
Returns a hash reference to day month holidays.
=cut
sub get_day_month_holidays {
my $self = shift @_;
my $day_month_holidays = $self->{'day_month_holidays'};
return $day_month_holidays;
}
=item get_exception_holidays
$exception_holidays = $calendar->exception_holidays();
Returns a hash reference to exception holidays. This kind of days are those
which stands for a holiday, but you wanted to make an exception for this particular
date.
=cut
sub get_exception_holidays {
my $self = shift @_;
my $exception_holidays = $self->{'exception_holidays'};
return $exception_holidays;
}
=item get_single_holidays
$single_holidays = $calendar->get_single_holidays();
Returns a hash reference to single holidays. This kind of holidays are those which
happend just one time.
=cut
sub get_single_holidays {
my $self = shift @_;
my $single_holidays = $self->{'single_holidays'};
return $single_holidays;
}
=item insert_week_day_holiday
insert_week_day_holiday(weekday => $weekday,
title => $title,
description => $description);
Inserts a new week day for $self->{branchcode}.
C<$day> Is the week day to make holiday.
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
=cut
sub insert_week_day_holiday {
my $self = shift @_;
my %options = @_;
my $dbh = C4::Context->dbh();
my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ( '',?,?,NULL,NULL,?,? )");
$insertHoliday->execute( $self->{branchcode}, $options{weekday},$options{title}, $options{description});
$insertHoliday->finish;
$self->{'week_days_holidays'}->{$options{weekday}}{title} = $options{title};
$self->{'week_days_holidays'}->{$options{weekday}}{description} = $options{description};
return $self;
}
=item insert_day_month_holiday
insert_day_month_holiday(day => $day,
month => $month,
title => $title,
description => $description);
Inserts a new day month holiday for $self->{branchcode}.
C<$day> Is the day month to make the date to insert.
C<$month> Is month to make the date to insert.
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
=cut
sub insert_day_month_holiday {
my $self = shift @_;
my %options = @_;
my $dbh = C4::Context->dbh();
my $insertHoliday = $dbh->prepare("insert into repeatable_holidays (id,branchcode,weekday,day,month,title,description) values ('', ?, NULL, ?, ?, ?,? )");
$insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{title}, $options{description});
$insertHoliday->finish;
$self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{title} = $options{title};
$self->{'day_month_holidays'}->{"$options{month}/$options{day}"}{description} = $options{description};
return $self;
}
=item insert_single_holiday
insert_single_holiday(day => $day,
month => $month,
year => $year,
title => $title,
description => $description);
Inserts a new single holiday for $self->{branchcode}.
C<$day> Is the day month to make the date to insert.
C<$month> Is month to make the date to insert.
C<$year> Is year to make the date to insert.
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
=cut
sub insert_single_holiday {
my $self = shift @_;
my %options = @_;
my $dbh = C4::Context->dbh();
my $isexception = 0;
my $insertHoliday = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)");
$insertHoliday->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description});
$insertHoliday->finish;
$self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
$self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
return $self;
}
=item insert_exception_holiday
insert_exception_holiday(day => $day,
month => $month,
year => $year,
title => $title,
description => $description);
Inserts a new exception holiday for $self->{branchcode}.
C<$day> Is the day month to make the date to insert.
C<$month> Is month to make the date to insert.
C<$year> Is year to make the date to insert.
C<$title> Is the title to store for the holiday formed by $year/$month/$day.
C<$description> Is the description to store for the holiday formed by $year/$month/$day.
=cut
sub insert_exception_holiday {
my $self = shift @_;
my %options = @_;
my $dbh = C4::Context->dbh();
my $isexception = 1;
my $insertException = $dbh->prepare("insert into special_holidays (id,branchcode,day,month,year,isexception,title,description) values ('', ?,?,?,?,?,?,?)");
$insertException->execute( $self->{branchcode}, $options{day},$options{month},$options{year}, $isexception, $options{title}, $options{description});
$insertException->finish;
$self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{title} = $options{title};
$self->{'exceptions_holidays'}->{"$options{year}/$options{month}/$options{day}"}{description} = $options{description};
return $self;
}
=item delete_holiday
delete_holiday(weekday => $weekday
day => $day,
month => $month,
year => $year);
Delete a holiday for $self->{branchcode}.
C<$weekday> Is the week day to delete.
C<$day> Is the day month to make the date to delete.
C<$month> Is month to make the date to delete.
C<$year> Is year to make the date to delete.
=cut
sub delete_holiday {
my $self = shift @_;
my %options = @_;
# Verify what kind of holiday that day is. For example, if it is
# a repeatable holiday, this should check if there are some exception
# for that holiday rule. Otherwise, if it is a regular holiday, it´s
# ok just deleting it.
my $dbh = C4::Context->dbh();
my $isSingleHoliday = $dbh->prepare("select id from special_holidays where (branchcode = '$self->{branchcode}') and (day = $options{day}) and (month = $options{month}) and (year = $options{year})");
$isSingleHoliday->execute;
if ($isSingleHoliday->rows) {
my $id = $isSingleHoliday->fetchrow;
$isSingleHoliday->finish; # Close the last query
my $deleteHoliday = $dbh->prepare("delete from special_holidays where (id = $id)");
$deleteHoliday->execute;
$deleteHoliday->finish; # Close the last query
delete($self->{'single_holidays'}->{"$options{year}/$options{month}/$options{day}"});
} else {
$isSingleHoliday->finish; # Close the last query
my $isWeekdayHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') and (weekday = $options{weekday})");
$isWeekdayHoliday->execute;
if ($isWeekdayHoliday->rows) {
my $id = $isWeekdayHoliday->fetchrow;
$isWeekdayHoliday->finish; # Close the last query
my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (WEEKDAY(CONCAT(special_holidays.year,'-',special_holidays.month,'-',special_holidays.day)) = $options{weekday}) and (branchcode = '$self->{branchcode}')");
$updateExceptions->execute;
$updateExceptions->finish; # Close the last query
my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = $id)");
$deleteHoliday->execute;
$deleteHoliday->finish;
delete($self->{'week_days_holidays'}->{$options{weekday}});
} else {
$isWeekdayHoliday->finish; # Close the last query
my $isDayMonthHoliday = $dbh->prepare("select id from repeatable_holidays where (branchcode = '$self->{branchcode}') and (day = '$options{day}') and (month = '$options{month}')");
$isDayMonthHoliday->execute;
if ($isDayMonthHoliday->rows) {
my $id = $isDayMonthHoliday->fetchrow;
$isDayMonthHoliday->finish;
my $updateExceptions = $dbh->prepare("update special_holidays set isexception = 0 where (special_holidays.branchcode = '$self->{branchcode}') and (special_holidays.day = '$options{day}') and (special_holidays.month = '$options{month}')");
$updateExceptions->execute;
$updateExceptions->finish; # Close the last query
my $deleteHoliday = $dbh->prepare("delete from repeatable_holidays where (id = '$id')");
$deleteHoliday->execute;
$deleteHoliday->finish; # Close the last query
$isDayMonthHoliday->finish; # Close the last query
delete($self->{'day_month_holidays'}->{"$options{month}/$options{day}"});
}
}
}
return $self;
}
=item isHoliday
$isHoliday = isHoliday($day, $month $year);
C<$day> Is the day to check wether if is a holiday or not.
C<$month> Is the month to check wether if is a holiday or not.
C<$year> Is the year to check wether if is a holiday or not.
=cut
sub isHoliday {
my ($self, $day, $month, $year) = @_;
my $weekday = Date_DayOfWeek($month, $day, $year) % 7;
my $weekDays = $self->get_week_days_holidays();
my $dayMonths = $self->get_day_month_holidays();
my $exceptions = $self->get_exception_holidays();
my $singles = $self->get_single_holidays();
if (defined($exceptions->{"$year/$month/$day"})) {
return 0;
} else {
if ((exists($weekDays->{$weekday})) ||
(exists($dayMonths->{"$month/$day"})) ||
(exists($singles->{"$year/$month/$day"}))) {
return 1;
} else {
return 0;
}
}
}
=item addDate
my ($day, $month, $year) = $calendar->addDate($day, $month, $year, $offset)
C<$day> Is the starting day of the interval.
C<$month> Is the starting month of the interval.
C<$year> Is the starting year of the interval.
C<$offset> Is the number of days that this function has to count from $date.
=cut
sub addDate {
my ($self, $day, $month, $year, $offset) = @_;
if ($offset < 0) { # In case $offset is negative
$offset = $offset*(-1);
}
my $daysMode = C4::Context->preference('useDaysMode');
if ($daysMode eq 'normal') {
($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, ($offset - 1));
} else {
while ($offset > 0) {
if (!($self->isHoliday($day, $month, $year))) {
$offset = $offset - 1;
}
if ($offset > 0) {
($year, $month, $day) = &Date::Calc::Add_Delta_Days($year, $month, $day, 1);
}
}
}
return($day, $month, $year);
}
=item daysBetween
my $daysBetween = $calendar->daysBetween($dayFrom, $monthFrom, $yearFrom,
$dayTo, $monthTo, $yearTo)
C<$dayFrom> Is the starting day of the interval.
C<$monthFrom> Is the starting month of the interval.
C<$yearFrom> Is the starting year of the interval.
C<$dayTo> Is the ending day of the interval.
C<$monthTo> Is the ending month of the interval.
C<$yearTo> Is the ending year of the interval.
=cut
sub daysBetween {
my ($self, $dayFrom, $monthFrom, $yearFrom, $dayTo, $monthTo, $yearTo) = @_;
my $daysMode = C4::Context->preference('useDaysMode');
my $count = 1;
my $continue = 1;
if ($daysMode eq 'normal') {
while ($continue) {
if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) {
($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1);
$count++;
} else {
$continue = 0;
}
}
} else {
while ($continue) {
if (($yearFrom != $yearTo) || ($monthFrom != $monthTo) || ($dayFrom != $dayTo)) {
if (!($self->isHoliday($dayFrom, $monthFrom, $yearFrom))) {
$count++;
}
($yearFrom, $monthFrom, $dayFrom) = &Date::Calc::Add_Delta_Days($yearFrom, $monthFrom, $dayFrom, 1);
} else {
$continue = 0;
}
}
}
return($count);
}
1;
__END__
=back
=head1 AUTHOR
Koha Physics Library UNLP <matias_veleda@hotmail.com>
=cut

132
C4/Circulation/Date.pm

@ -0,0 +1,132 @@
package C4::Circulation::Date;
# Copyright 2005 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:$
use strict;
use C4::Context;
require Exporter;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v );
};
@ISA = qw(Exporter);
@EXPORT = qw(
&display_date_format
&format_date
&format_date_in_iso
);
=head1 DESCRIPTION
C4::Circulation::Date provides routines for format dates to display in human readable forms.
=head1 FUNCTIONS
=over 2
=cut
=head2 get_date_format
$dateformat = get_date_format();
Takes no input, and returns the format that the library prefers dates displayed in
=cut
sub get_date_format {
# Get the database handle
my $dbh = C4::Context->dbh;
return C4::Context->preference('dateformat');
}
=head2 display_date_format
$displaydateformat = display_date_format();
Takes no input, and returns a string showing the format the library likes dates displayed in
=cut
sub display_date_format {
my $dateformat = get_date_format();
if ( $dateformat eq "us" ) {
return "mm/dd/yyyy";
}
elsif ( $dateformat eq "metric" ) {
return "dd/mm/yyyy";
}
elsif ( $dateformat eq "iso" ) {
return "yyyy-mm-dd";
}
else {
return
"Invalid date format: $dateformat. Please change in system preferences";
}
}
=head2 format_date
$formatteddate = format_date($date);
Takes a date, from mysql and returns it in the format specified by the library
This is less flexible than C4::Date::format_date, which can handle dates of many formats
if you need that flexibility use C4::Date, if you are just using it to format the output from mysql as
in circulation.pl use this one, it is much faster.
=cut
sub format_date {
my $olddate = shift;
my $newdate;
if ( !$olddate ) {
return "";
}
my $dateformat = get_date_format();
if ( $dateformat eq "us" ) {
my @datearray=split('-',$olddate);
$newdate = "$datearray[1]/$datearray[2]/$datearray[0]";
}
elsif ( $dateformat eq "metric" ) {
my @datearray=split('-',$olddate);
$newdate = "$datearray[2]/$datearray[1]/$datearray[0]";
}
elsif ( $dateformat eq "iso" ) {
$newdate = $olddate;
}
else {
return
"Invalid date format: $dateformat. Please change in system preferences";
}
}
1;

335
C4/Circulation/Returns.pm

@ -0,0 +1,335 @@
package C4::Circulation::Returns;
# $Id$
#package to deal with Returns
#written 3/11/99 by olwen@katipo.co.nz
# 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
# FIXME - None of the functions (certainly none of the exported
# functions) are used anywhere anymore. Presumably this module is
# obsolete.
use strict;
require Exporter;
use DBI;
use C4::Context;
use C4::Accounts2;
use C4::InterfaceCDK;
use C4::Circulation::Main;
# FIXME - C4::Circulation::Main and C4::Circulation::Returns
# use each other, so functions get redefined.
use C4::Scan;
use C4::Stats;
use C4::Members;
use C4::Print;
use C4::Biblio;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
$VERSION = 0.01;
@ISA = qw(Exporter);
@EXPORT = qw(&returnrecord &calc_odues &Returns);
# FIXME - This is only used in C4::Circmain and C4::Circulation, both
# of which appear to be obsolete. Presumably this function is obsolete
# as well.
# Otherwise, it needs a POD.
sub Returns {
my ($env)=@_;
my $dbh = C4::Context->dbh;
my @items;
@items[0]=" "x50;
my $reason;
my $item;
my $reason;
my $borrower;
my $itemno;
my $itemrec;
my $borrowernumber;
my $amt_owing;
my $odues;
my $issues;
my $resp;
# until (($reason eq "Circ") || ($reason eq "Quit")) {
until ($reason ne "") {
($reason,$item) =
returnwindow($env,"Enter Returns",
$item,\@items,$borrower,$amt_owing,$odues,$dbh,$resp); #C4::Circulation
#debug_msg($env,"item = $item");
#if (($reason ne "Circ") && ($reason ne "Quit")) {
if ($reason eq "") {
$resp = "";
($resp,$borrowernumber,$borrower,$itemno,$itemrec,$amt_owing) =
checkissue($env,$dbh,$item);
if ($borrowernumber ne "") {
($issues,$odues,$amt_owing) = borrdata2($env,$borrowernumber);
} else {
$issues = "";
$odues = "";
$amt_owing = "";
}
if ($resp ne "") {
#if ($resp eq "Returned") {
if ($itemno ne "" ) {
my $item = GetBiblioFromItemNumber($itemno);
# FIXME - This relies on C4::Circulation::Main to have a
# "use C4::Circulation::Issues;" line, which is bogus.
my $fmtitem = C4::Circulation::Issues::formatitem($env,$item,"",$amt_owing);
unshift @items,$fmtitem;
if ($items[20] > "") {
pop @items;
}
}
#} elsif ($resp ne "") {
# error_msg($env,"$resp");
#}
#if ($resp ne "Returned") {
# error_msg($env,"$resp");
# $borrowernumber = "";
#}
}
}
}
# clearscreen;
return($reason);
}
# FIXME - Only used in &Returns and in telnet/doreturns.pl, both of
# which appear obsolete. Presumably this function is obsolete as well.
# Otherwise, it needs a POD.
sub checkissue {
my ($env,$dbh, $item) = @_;
my $reason='Circ';
my $borrowernumber;
my $borrower;
my $itemno;
my $itemrec;
my $amt_owing;
$item = uc $item;
my $sth=$dbh->prepare("select * from items,biblio
where barcode = ?
and (biblio.biblionumber=items.biblionumber)");
$sth->execute($item);
if ($itemrec=$sth->fetchrow_hashref) {
$sth->finish;
$itemno = $itemrec->{'itemnumber'};
my $sth=$dbh->prepare("select * from issues
where (itemnumber=?)
and (returndate is null)");
$sth->execute($itemrec->{'itemnumber'});
if (my $issuerec=$sth->fetchrow_hashref) {
$sth->finish;
my $sth= $dbh->prepare("select * from borrowers where
(borrowernumber = ?)");
$sth->execute($issuerec->{'borrowernumber'});
$env->{'borrowernumber'}=$issuerec->{'borrowernumber'};
$borrower = $sth->fetchrow_hashref;
$borrowernumber = $issuerec->{'borrowernumber'};
$itemno = $issuerec->{'itemnumber'};
$amt_owing = returnrecord($env,$dbh,$borrowernumber,$itemno);
$reason = "Returned";
} else {
$sth->finish;
updatelastseen($env,$dbh,$itemrec->{'itemnumber'});
$reason = "Item not issued";
}
my ($resfound,$resrec) = find_reserves($env,$dbh,$itemrec->{'itemnumber'});
if ($resfound eq "y") {
my $btsh = $dbh->prepare("select * from borrowers
where borrowernumber = ?");
$btsh->execute($resrec->{'borrowernumber'});
my $resborrower = $btsh->fetchrow_hashref;
#printreserve($env,$resrec,$resborrower,$itemrec);
my $mess = "Reserved for collection at branch $resrec->{'branchcode'}";
C4::InterfaceCDK::error_msg($env,$mess);
$btsh->finish;
}
} else {
$sth->finish;
$reason = "Item not found";
}
return ($reason,$borrowernumber,$borrower,$itemno,$itemrec,$amt_owing);
# end checkissue
}
# FIXME - Only used in &C4::Circulation::Main::previousissue,
# &checkissue, C4/Circulation.pm, and tkperl/tkcirc, all of which
# appear to be obsolete. Presumably this function is obsolete as well.
# Otherwise, it needs a POD.
sub returnrecord {
# mark items as returned
my ($env,$dbh,$borrowernumber,$itemno)=@_;
#my $amt_owing = calc_odues($env,$dbh,$borrowernumber,$itemno);
my @datearr = localtime(time);
my $dateret = (1900+$datearr[5])."-".$datearr[4]."-".$datearr[3];
my $sth = $dbh->prepare("update issues set returndate = now(), branchcode = ? where
(borrowernumber = ?) and (itemnumber = ?)
and (returndate is null)");
$sth->execute($env->{'branchcode'},$borrowernumber,$itemno);
$sth->finish;
updatelastseen($env,$dbh,$itemno);
# check for overdue fine
my $oduecharge;
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?)
and (itemnumber = ?)
and (accounttype = 'FU' or accounttype='O')");
$sth->execute($borrowernumber,$itemno);
if (my $data = $sth->fetchrow_hashref) {
# alter fine to show that the book has been returned.
my $usth = $dbh->prepare("update accountlines
set accounttype = 'F'
where (borrowernumber = ?)
and (itemnumber = ?)
and (accountno = ?) ");
$usth->execute($borrowernumber,$itemno,$data->{'accountno'});
$usth->finish();
$oduecharge = $data->{'amountoutstanding'};
}
$sth->finish;
# check for charge made for lost book
my $sth = $dbh->prepare("select * from accountlines
where (borrowernumber = ?)
and (itemnumber = ?)
and (accounttype = 'L')");
$sth->execute($borrowernumber,$itemno);
if (my $data = $sth->fetchrow_hashref) {
# writeoff this amount
my $offset;
my $amount = $data->{'amount'};
my $acctno = $data->{'accountno'};
my $amountleft;
if ($data->{'amountoutstanding'} == $amount) {
$offset = $data->{'amount'};
$amountleft = 0;
} else {
$offset = $amount - $data->{'amountoutstanding'};
$amountleft = $data->{'amountoutstanding'} - $amount;
}
my $usth = $dbh->prepare("update accountlines
set accounttype = 'LR',amountoutstanding='0'
where (borrowernumber = ?)
and (itemnumber = ?)
and (accountno = ?) ");
$usth->execute($borrowernumber,$itemno,$acctno);
$usth->finish;
my $nextaccntno = C4::Accounts::getnextacctno($env,$borrowernumber,$dbh);
$usth = $dbh->prepare("insert into accountlines
(borrowernumber,accountno,date,amount,description,accounttype,amountoutstanding)
values (?,?,now(),?,'Book Returned','CR',?)");
$usth->execute($borrowernumber,$nextaccntno,0-$amount,$amountleft);
$usth->finish;
$uquery = "insert into accountoffsets
(borrowernumber, accountno, offsetaccount, offsetamount)
values (?,?,?,?)";
$usth = $dbh->prepare("");
$usth->execute($borrowernumber,$data->{'accountno'},$nextaccntno,$offset);
$usth->finish;
}
$sth->finish;
UpdateStats($env,'branch','return','0','',$itemno);
return($oduecharge);
}
# FIXME - Only used in tkperl/tkcirc. Presumably this function is
# obsolete.
# Otherwise, it needs a POD.
sub calc_odues {
# calculate overdue fees
my ($env,$dbh,$borrowernumber,$itemno)=@_;
my $amt_owing;
return($amt_owing);
}
# This function is only used in &checkissue and &returnrecord, both of
# which appear to be obsolete. So presumably this function is obsolete
# too.
# Otherwise, it needs a POD.
sub updatelastseen {
my ($env,$dbh,$itemnumber)= @_;
my $br = $env->{'branchcode'};
my $sth = $dbh->prepare("update items
set datelastseen = now(), holdingbranch = ?
where (itemnumber = ?)");
$sth->execute($br,$itemnumber);
$sth->finish;
}
# FIXME - There's also a &C4::Circulation::Circ2::find_reserves, but
# that one looks rather different.
# FIXME - This is only used in &checkissue, which appears to be
# obsolete. So presumably this function is obsolete too.
sub find_reserves {
my ($env,$dbh,$itemno) = @_;
warn "!!!!! SHOULD NOT BE HERE : Returns::find_reserves is deprecated !!!";
my $itemdata = GetBiblioFromItemNumber($itemno);
my $sth = $dbh->prepare("select * from reserves where found is null
and biblionumber = ? and cancellationdate is NULL
order by priority,reservedate ");
$sth->execute($itemdata->{'biblionumber'};
my $resfound = "n";
my $resrec;
while (($resrec=$sth->fetchrow_hashref) && ($resfound eq "n")) {
if ($resrec->{'found'} eq "W") {
if ($resrec->{'itemnumber'} eq $itemno) {
$resfound = "y";
}
} elsif ($resrec->{'constrainttype'} eq "a") {
$resfound = "y";
} else {
my $consth = $dbh->prepare("select * from reserveconstraints where borrowernumber = ? and reservedate = ? and biblionumber = ? and biblioitemnumber = ?");
$consth->execute($resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'},$itemdata->{'biblioitemnumber'});
if (my $conrec=$consth->fetchrow_hashref) {
if ($resrec->{'constrainttype'} eq "o") {
$resfound = "y";
}
} else {
if ($resrec->{'constrainttype'} eq "e") {
$resfound = "y";
}
}
$consth->finish;
}
if ($resfound eq "y") {
my $updsth = $dbh->prepare("update reserves
set found = 'W',itemnumber = ?
where borrowernumber = ?
and reservedate = ?
and biblionumber = ?");
$updsth->execute($itemno,$resrec->{'borrowernumber'},$resrec->{'reservedate'},$resrec->{'biblionumber'});
$updsth->finish;
my $itbr = $resrec->{'branchcode'};
if ($resrec->{'branchcode'} ne $env->{'branchcode'}) {
my $updsth = $dbh->prepare("update items
set holdingbranch = 'TR'
where itemnumber = ?");
$updsth->execute($itemno);
$updsth->finish;
}
}
}
$sth->finish;
return ($resfound,$resrec);
}

451
C4/Languages.pm

@ -0,0 +1,451 @@
package C4::Languages;
# Copyright 2006 (C) LibLime
# Joshua Ferraro <jmf@liblime.com>
#
# 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$
use strict; use warnings; #FIXME: turn off warnings before release
require Exporter;
use C4::Context;
use vars qw($VERSION @ISA @EXPORT);
$VERSION = do { my @v = '$Revision$' =~ /\d+/g; shift(@v) . "." . join( "_", map { sprintf "%03d", $_ } @v ); };
=head1 NAME
C4::Languages - Perl Module containing language list functions for Koha
=head1 SYNOPSIS
use C4::Languages;
=head1 DESCRIPTION
=head1 FUNCTIONS
=cut
@ISA = qw(Exporter);
@EXPORT = qw(
&getFrameworkLanguages
&getTranslatedLanguages
&getAllLanguages
);
my $DEBUG = 0;
=head2 getFrameworkLanguages
Returns a reference to an array of hashes:
my $languages = getFrameworkLanguages();
for my $language(@$languages) {
print "$language->{language_code}\n"; # language code in iso 639-2
print "$language->{language_name}\n"; # language name in native script
print "$language->{language_locale_name}\n"; # language name in current locale
}
=cut
sub getFrameworkLanguages {
# get a hash with all language codes, names, and locale names
my $all_languages = getAllLanguages();
my @languages;
# find the available directory names
my $dir=C4::Context->config('intranetdir')."/misc/sql-datas/";
opendir (MYDIR,$dir);
my @listdir= grep { !/^\.|CVS/ && -d "$dir/$_"} readdir(MYDIR);
closedir MYDIR;
# pull out all data for the dir names that exist
for my $dirname (@listdir) {
for my $language_set (@$all_languages) {
my $language_name = $language_set->{language_name};
my $language_locale_name = $language_set->{language_locale_name};
if ($dirname eq $language_set->{language_code}) {
push @languages, {'language_code'=>$dirname, 'language_name'=>$language_name, 'language_locale_name'=>$language_locale_name}
}
}
}
return \@languages;
}
=head2 getTranslatedLanguages
Returns a reference to an array of hashes:
my $languages = getTranslatedLanguages();
print "Available translated langauges:\n";
for my $language(@$trlanguages) {
print "$language->{language_code}\n"; # language code in iso 639-2
print "$language->{language_name}\n"; # language name in native script
print "$language->{language_locale_name}\n"; # language name in current locale
}
=cut
sub getTranslatedLanguages {
my ($interface, $theme) = @_;
my $htdocs;
my $all_languages = getAllLanguages();
my @languages;
my $lang;
if ( $interface eq 'opac' ) {
$htdocs = C4::Context->config('opachtdocs');
if ( $theme and -d "$htdocs/$theme" ) {
(@languages) = _get_language_dirs($htdocs,$theme);
return _get_final_languages($all_languages,@languages);
}
else {
for my $theme ( _get_themes('opac') ) {
push @languages, _get_language_dirs($htdocs,$theme);
}
return _get_final_languages($all_languages,@languages);
}
}
elsif ( $interface eq 'intranet' ) {
$htdocs = C4::Context->config('intrahtdocs');
if ( $theme and -d "$htdocs/$theme" ) {
@languages = _get_language_dirs($htdocs,$theme);
return _get_final_languages($all_languages,@languages);
}
else {
foreach my $theme ( _get_themes('opac') ) {
push @languages, _get_language_dirs($htdocs,$theme);
}
return _get_final_languages($all_languages,@languages);
}
}
else {
my $htdocs = C4::Context->config('intrahtdocs');
foreach my $theme ( _get_themes('intranet') ) {
push @languages, _get_language_dirs($htdocs,$theme);
}
$htdocs = C4::Context->config('opachtdocs');
foreach my $theme ( _get_themes('opac') ) {
push @languages, _get_language_dirs($htdocs,$theme);
}
return _get_final_languages($all_languages,@languages);
}
}
=head2 getAllLanguages
Returns a reference to an array of hashes:
my $alllanguages = getAllLanguages();
print "Available translated langauges:\n";
for my $language(@$alllanguages) {
print "$language->{language_code}\n";
print "$language->{language_name}\n";
print "$language->{language_locale_name}\n";
}
=cut
sub getAllLanguages {
my $languages_loop = [
{
language_code => "",
language_name => "No Limit",
language_locale_name => "",
selected => "selected",
},
{
language_code => "ara",
language_name =>
"&#1575;&#1604;&#1593;&#1585;&#1576;&#1610;&#1577;",
language_locale_name => "Arabic",
,
},
{
language_code => "bul",
language_name =>
"&#1041;&#1098;&#1083;&#1075;&#1072;&#1088;&#1089;&#1082;&#1080;",
language_locale_name => "Bulgarian",
,
},
{
language_code => "chi",
language_name => "&#20013;&#25991;",
language_locale_name => "Chinese",
,
},
{
language_code => "scr",
language_name => "Hrvatski",
language_locale_name => "Croatian",
,
},
{
language_code => "cze",
language_name => "&#x010D;e&#353;tina",
language_locale_name => "Czech",
,
},
{
language_code => "dan",
language_name => "D&aelig;nsk",
language_locale_name => "Danish",
,
},
{
language_code => "dut",
language_name => "ned&#601;rl&#593;ns",
language_locale_name => "Dutch",
,
},
{
language_code => "en",
language_name => "English",
language_locale_name => "English",
,
},
{
language_code => "fr",
language_name => "Fran&ccedil;ais",
language_locale_name => "French",
,
},
{
language_code => "ger",
language_name => "Deutsch",
language_locale_name => "German",
,
},
{
language_code => "gre",
language_name =>
"&#949;&#955;&#955;&#951;&#957;&#953;&#954;&#940;",
language_locale_name => "Greek, Modern [1453- ]",
,
},
{
language_code => "heb",
language_name => "&#1506;&#1489;&#1512;&#1497;&#1514;",
language_locale_name => "Hebrew",
,
},
{
language_code => "hin",
language_name => "&#2361;&#2367;&#2344;&#2381;&#2342;&#2368;",
language_locale_name => "Hindi",
,
},
{
language_code => "hun",
language_name => "Magyar",
language_locale_name => "Hungarian",
,
},
{
language_code => "ind",
language_name => "",
language_locale_name => "Indonesian",
,
},
{
language_code => "ita",
language_name => "Italiano",
language_locale_name => "Italian",
,
},
{
language_code => "jpn",
language_name => "&#26085;&#26412;&#35486;",
language_locale_name => "Japanese",
,
},
{
language_code => "kor",
language_name => "&#54620;&#44397;&#50612;",
language_locale_name => "Korean",
,
},
{
language_code => "lat",
language_name => "Latina",
language_locale_name => "Latin",
,
},
{
language_code => "nor",
language_name => "Norsk",
language_locale_name => "Norwegian",
,
},
{
language_code => "per",
language_name => "&#1601;&#1575;&#1585;&#1587;&#1609;",
language_locale_name => "Persian",
,
},
{
language_code => "pol",
language_name => "Polski",
language_locale_name => "Polish",
,
},
{
language_code => "por",
language_name => "Portugu&ecirc;s",
language_locale_name => "Portuguese",
,
},
{
language_code => "rum",
language_name => "Rom&acirc;n&#259;",
language_locale_name => "Romanian",
,
},
{
language_code => "rus",
language_name =>
"&#1056;&#1091;&#1089;&#1089;&#1082;&#1080;&#1081;",
language_locale_name => "Russian",
,
},
{
language_code => "spa",
language_name => "Espa&ntilde;ol",
language_locale_name => "Spanish",
,
},
{
language_code => "swe",
language_name => "Svenska",
language_locale_name => "Swedish",
,
},
{
language_code => "tha",
language_name =>
"&#3616;&#3634;&#3625;&#3634;&#3652;&#3607;&#3618;",
language_locale_name => "Thai",
,
},
{
language_code => "tur",
language_name => "T&uuml;rk&ccedil;e",
language_locale_name => "Turkish",
,
},
{
language_code => "ukr",
language_name =>
"&#1059;&#1082;&#1088;&#1072;&#1111;&#1085;&#1089;&#1100;&#1082;&#1072;",
language_locale_name => "Ukrainian",
,
},
];
return $languages_loop;
}
=head2 _get_themes
Internal function, returns an array of all available themes.
(@themes) = &_get_themes('opac');
(@themes) = &_get_themes('intranet');
=cut
sub _get_themes {
my $interface = shift;
my $htdocs;
my @themes;
if ( $interface eq 'intranet' ) {
$htdocs = C4::Context->config('intrahtdocs');
}
else {
$htdocs = C4::Context->config('opachtdocs');
}
opendir D, "$htdocs";
my @dirlist = readdir D;
foreach my $directory (@dirlist) {
# if there's an en dir, it's a valid theme
-d "$htdocs/$directory/en" and push @themes, $directory;
}
return @themes;
}
=head2 _get_language_dirs
Internal function, returns an array of directory names, excluding non-language directories
=cut
sub _get_language_dirs {
my ($htdocs,$theme) = @_;
my @languages;
opendir D, "$htdocs/$theme";
for my $language ( readdir D ) {
next if $language =~/^\./;
next if $language eq 'all';
next if $language =~/png$/;
next if $language =~/css$/;
next if $language =~/CVS$/;
next if $language =~/itemtypeimg$/;
next if $language =~/\.txt$/i; #Don't read the readme.txt !
next if $language eq 'images';
push @languages, $language;
}
return (@languages);
}
=head2 _get_final_languages
Internal function for building the ref to array of hashes
FIXME: this could be rewritten and simplified using map
=cut
sub _get_final_languages {
my ($all_languages,@languages) = @_;
my @final_languages;
my %seen_languages;
for my $language (@languages) {
unless ($seen_languages{$language}) {
for my $language_code (@$all_languages) {
if ($language eq $language_code->{'language_code'}) {
push @final_languages, $language_code;
}
}
$seen_languages{$language}++;
}
}
return \@final_languages;
}
1;
__END__
=back
=head1 AUTHOR
Joshua Ferraro
=cut

213
C4/Maintainance.pm

@ -0,0 +1,213 @@
package C4::Maintainance; #assumes C4/Maintainance
#package to deal with marking up output
# 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::Context;
require Exporter;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
$VERSION = 0.01;
=head1 NAME
C4::Maintenance - Koha catalog maintenance functions
=head1 SYNOPSIS
use C4::Maintenance;
=head1 DESCRIPTION
The functions in this module perform various catalog-maintenance
functions, including deleting and undeleting books, fixing
miscategorized items, etc.
=head1 FUNCTIONS
=over 2
=cut
@ISA = qw(Exporter);
@EXPORT = qw(&listsubjects &shiftgroup &deletedbib &undeletebib
&updatetype &logaction);
=item listsubjects
($count, $results) = &listsubjects($subject, $n, $offset);
Finds the subjects that begin with C<$subject> in the bibliosubject
table of the Koha database.
C<&listsubjects> returns a two-element array. C<$results> is a
reference-to-array, in which each element is a reference-to-hash
giving information about the given subject. C<$count> is the number of
elements in C<@{$results}>.
Probably the only interesting field in C<$results->[$i]> is
C<subject>, the subject in question.
C<&listsubject> returns up to C<$n> items, starting at C<$offset>. If
C<$n> is 0, it will return all matching subjects.
=cut
#'
# FIXME - This API is bogus. The way it's currently used, it should
# just return a list of strings.
sub listsubjects {
my ($sub,$num,$offset)=@_;
my $dbh = C4::Context->dbh;
my $query="Select * from bibliosubject where subject like ? group by subject";
my @bind = ("$sub%");
# FIXME - Make $num and $offset optional.
# If $num was given, make sure $offset was, too.
if ($num != 0){
$query.=" limit ?,?";
push(@bind,$offset,$num);
}
my $sth=$dbh->prepare($query);
# print $query;
$sth->execute(@bind);
my @results;
my $i=0;
while (my $data=$sth->fetchrow_hashref){
$results[$i]=$data;
$i++;
}
$sth->finish;
return($i,\@results);
}
=item shiftgroup
&shiftgroup($biblionumber, $biblioitemnumber);
Changes the biblionumber associated with a given biblioitem.
C<$biblioitemnumber> is the number of the biblioitem to change.
C<$biblionumber> is the biblionumber to associate it with.
=cut
#'
sub shiftgroup{
my ($biblionumber,$bi)=@_;
my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("update biblioitems set biblionumber=? where biblioitemnumber=?");
$sth->execute($biblionumber,$bi);
$sth->finish;
$sth=$dbh->prepare("update items set biblionumber=? where biblioitemnumber=?");
$sth->execute($biblionumber,$bi);
$sth->finish;
}
=item deletedbib
($count, $results) = &deletedbib($title);
Looks up deleted books whose title begins with C<$title>.
C<&deletedbib> returns a two-element list. C<$results> is a
reference-to-array; each element is a reference-to-hash whose keys are
the fields of the deletedbiblio table in the Koha database. C<$count>
is the number of elements in C<$results>.
=cut
#'
sub deletedbib{
my ($title)=@_;
my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("Select * from deletedbiblio where title like ? order by title");
$sth->execute("$title%");
my @results;
my $i=0;
while (my $data=$sth->fetchrow_hashref){
$results[$i]=$data;
$i++;
}
$sth->finish;
return($i,\@results);
}
=item undeletebib
&undeletebib($biblionumber);
Undeletes a book. C<&undeletebib> looks up the book with the given
biblionumber in the deletedbiblio table of the Koha database, and
moves its entry to the biblio table.
=cut
#'
sub undeletebib{
my ($biblionumber)=@_;
my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("select * from deletedbiblio where biblionumber=?");
$sth->execute($biblionumber);
if (my @data=$sth->fetchrow_array){
$sth->finish;
# FIXME - Doesn't this keep the same biblionumber? Isn't this
# forbidden by the definition of 'biblio'? Or doesn't it matter?
my $query="INSERT INTO biblio VALUES (";
my $count = @data;
$query .= ("?," x $count);
$query=~ s/\,$/\)/;
# print $query;
$sth=$dbh->prepare($query);
$sth->execute(@data);
$sth->finish;
}
$sth=$dbh->prepare("DELETE FROM deletedbiblio WHERE biblionumber=?");
$sth->execute($biblionumber);
$sth->finish;
}
=item updatetype
&updatetype($biblioitemnumber, $itemtype);
Changes the type of the item with the given biblioitemnumber to be
C<$itemtype>.
=cut
#'
sub updatetype{
my ($bi,$type)=@_;
my $dbh = C4::Context->dbh;
my $sth=$dbh->prepare("Update biblioitems set itemtype=? where biblioitemnumber=?");
$sth->execute($type,$bi);
$sth->finish;
}
END { } # module clean-up code here (global destructor)
1;
__END__
=back
=head1 AUTHOR
Koha Developement team <info@koha.org>
=cut

573
C4/Record.pm

@ -0,0 +1,573 @@
package C4::Record;
#
# Copyright 2006 (C) LibLime
# Joshua Ferraro <jmf@liblime.com>
#
# 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$
#
use strict;# use warnings; #FIXME: turn off warnings before release
# please specify in which methods a given module is used
use MARC::Record; # marc2marcxml, marcxml2marc, html2marc, changeEncoding
use MARC::File::XML; # marc2marcxml, marcxml2marc, html2marcxml, changeEncoding
use MARC::Crosswalk::DublinCore; # marc2dcxml
use Unicode::Normalize; # _entity_encode
use XML::LibXSLT;
use XML::LibXML;
use vars qw($VERSION @ISA @EXPORT);
# set the version for version checking
$VERSION = do { my @v = '$Revision$' =~ /\d+/g;
shift(@v) . "." . join("_", map {sprintf "%03d", $_ } @v); };
@ISA = qw(Exporter);
# only export API methods
@EXPORT = qw(
&marc2marc
&marc2marcxml
&marcxml2marc
&marc2dcxml
&marc2modsxml
&html2marcxml
&html2marc
&changeEncoding
);
=head1 NAME
C4::Record - MARC, MARCXML, DC, MODS, XML, etc. Record Management Functions and API
=head1 SYNOPSIS
New in Koha 3.x. This module handles all record-related management functions.
=head1 API (EXPORTED FUNCTIONS)
=head2 marc2marc - Convert from one flavour of ISO-2709 to another
=over 4
my ($error,$newmarc) = marc2marc($marc,$to_flavour,$from_flavour,$encoding);
Returns an ISO-2709 scalar
=back
=cut
sub marc2marc {
my ($marc,$to_flavour,$from_flavour,$encoding) = @_;
my $error = "Feature not yet implemented\n";
return ($error,$marc);
}
=head2 marc2marcxml - Convert from ISO-2709 to MARCXML
=over 4
my ($error,$marcxml) = marc2marcxml($marc,$encoding,$flavour);
Returns a MARCXML scalar
=over 2
C<$marc> - an ISO-2709 scalar or MARC::Record object
C<$encoding> - UTF-8 or MARC-8 [UTF-8]
C<$flavour> - MARC21 or UNIMARC
C<$dont_entity_encode> - a flag that instructs marc2marcxml not to entity encode the xml before returning (optional)
=back
=back
=cut
sub marc2marcxml {
my ($marc,$encoding,$flavour,$dont_entity_encode) = @_;
my $error; # the error string
my $marcxml; # the final MARCXML scalar
# test if it's already a MARC::Record object, if not, make it one
my $marc_record_obj;
if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
$marc_record_obj = $marc;
} else { # it's not a MARC::Record object, make it one
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
# conversion to MARC::Record object failed, populate $error
if ($@) { $error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR };
}
# only proceed if no errors so far
unless ($error) {
# check the record for warnings
my @warnings = $marc_record_obj->warnings();
if (@warnings) {
warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
foreach my $warn (@warnings) { warn "\t".$warn };
}
unless($encoding) {$encoding = "UTF-8"}; # set default encoding
unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set default MARC flavour
# attempt to convert the record to MARCXML
eval { $marcxml = $marc_record_obj->as_xml_record($flavour) }; #handle exceptions
# record creation failed, populate $error
if ($@) {
$error .= "Creation of MARCXML failed:".$MARC::File::ERROR;
$error .= "Additional information:\n";
my @warnings = $@->warnings();
foreach my $warn (@warnings) { $error.=$warn."\n" };
# record creation was successful
} else {
# check the record for warning flags again (warnings() will be cleared already if there was an error, see above block
@warnings = $marc_record_obj->warnings();
if (@warnings) {
warn "\nWarnings encountered while processing ISO-2709 record with title \"".$marc_record_obj->title()."\":\n";
foreach my $warn (@warnings) { warn "\t".$warn };
}
}
# only proceed if no errors so far
unless ($error) {
# entity encode the XML unless instructed not to
unless ($dont_entity_encode) {
my ($marcxml_entity_encoded) = _entity_encode($marcxml);
$marcxml = $marcxml_entity_encoded;
}
}
}
# return result to calling program
return ($error,$marcxml);
}
=head2 marcxml2marc - Convert from MARCXML to ISO-2709
=over 4
my ($error,$marc) = marcxml2marc($marcxml,$encoding,$flavour);
Returns an ISO-2709 scalar
=over 2
C<$marcxml> - a MARCXML record
C<$encoding> - UTF-8 or MARC-8 [UTF-8]
C<$flavour> - MARC21 or UNIMARC
=back
=back
=cut
sub marcxml2marc {
my ($marcxml,$encoding,$flavour) = @_;
my $error; # the error string
my $marc; # the final ISO-2709 scalar
unless($encoding) {$encoding = "UTF-8"}; # set the default encoding
unless($flavour) {$flavour = C4::Context->preference("marcflavour")}; # set the default MARC flavour
# attempt to do the conversion
eval { $marc = MARC::Record->new_from_xml($marcxml,$encoding,$flavour) }; # handle exceptions
# record creation failed, populate $error
if ($@) {$error .="\nCreation of MARCXML Record failed: ".$@;
$error.=$MARC::File::ERROR if ($MARC::File::ERROR);
};
# return result to calling program
return ($error,$marc);
}
=head2 marc2dcxml - Convert from ISO-2709 to Dublin Core
=over 4
my ($error,$dcxml) = marc2dcxml($marc,$qualified);
Returns a DublinCore::Record object, will eventually return a Dublin Core scalar
FIXME: should return actual XML, not just an object
=over 2
C<$marc> - an ISO-2709 scalar or MARC::Record object
C<$qualified> - specify whether qualified Dublin Core should be used in the input or output [0]
=back
=back
=cut
sub marc2dcxml {
my ($marc,$qualified) = @_;
my $error;
# test if it's already a MARC::Record object, if not, make it one
my $marc_record_obj;
if ($marc =~ /^MARC::Record/) { # it's already a MARC::Record object
$marc_record_obj = $marc;
} else { # it's not a MARC::Record object, make it one
eval { $marc_record_obj = MARC::Record->new_from_usmarc($marc) }; # handle exceptions
# conversion to MARC::Record object failed, populate $error
if ($@) {
$error .="\nCreation of MARC::Record object failed: ".$MARC::File::ERROR;
}
}
my $crosswalk = MARC::Crosswalk::DublinCore->new;
if ($qualified) {
$crosswalk = MARC::Crosswalk::DublinCore->new( qualified => 1 );
}
my $dcxml = $crosswalk->as_dublincore($marc_record_obj);
my $dcxmlfinal = "<?xml version=\"1.0\"?>\n";
$dcxmlfinal .= "<metadata
xmlns=\"http://example.org/myapp/\"
xmlns:xsi=\"http://www.w3.org/2001/XMLSchema-instance\"
xsi:schemaLocation=\"http://example.org/myapp/ http://example.org/myapp/schema.xsd\"
xmlns:dc=\"http://purl.org/dc/elements/1.1/\"
xmlns:dcterms=\"http://purl.org/dc/terms/\">";
foreach my $element ( $dcxml->elements() ) {
$dcxmlfinal.="<"."dc:".$element->name().">".$element->content()."</"."dc:".$element->name()."\n";
}
$dcxmlfinal .= "\n</metadata>";
return ($error,$dcxmlfinal);
}
=head2 marc2modsxml - Convert from ISO-2709 to MODS
=over 4
my ($error,$modsxml) = marc2modsxml($marc);
Returns a MODS scalar
=back
=cut
sub marc2modsxml {
my ($marc) = @_;
# grab the XML, run it through our stylesheet, push it out to the browser
my $xmlrecord = marc2marcxml($marc);
my $xslfile = C4::Context->config('intranetdir')."/misc/xslt/MARC21slim2MODS3-1.xsl";
my $parser = XML::LibXML->new();
my $xslt = XML::LibXSLT->new();
my $source = $parser->parse_string($xmlrecord);
my $style_doc = $parser->parse_file($xslfile);
my $stylesheet = $xslt->parse_stylesheet($style_doc);
my $results = $stylesheet->transform($source);
my $newxmlrecord = $stylesheet->output_string($results);
return ($newxmlrecord);
}
=head2 html2marcxml
=over 4
my ($error,$marcxml) = html2marcxml($tags,$subfields,$values,$indicator,$ind_tag);
Returns a MARCXML scalar
this is used in addbiblio.pl and additem.pl to build the MARCXML record from
the form submission.
FIXME: this could use some better code documentation
=back
=cut
sub html2marcxml {
my ($tags,$subfields,$values,$indicator,$ind_tag) = @_;
my $error;
# add the header info
my $marcxml= MARC::File::XML::header(C4::Context->preference('TemplateEncoding'),C4::Context->preference('marcflavour'));
# some flags used to figure out where in the record we are
my $prevvalue;
my $prevtag=-1;
my $first=1;
my $j = -1;
# handle characters that would cause the parser to choke FIXME: is there a more elegant solution?
for (my $i=0;$i<=@$tags;$i++){
@$values[$i] =~ s/&/&amp;/g;
@$values[$i] =~ s/</&lt;/g;
@$values[$i] =~ s/>/&gt;/g;
@$values[$i] =~ s/"/&quot;/g;
@$values[$i] =~ s/'/&apos;/g;
if ((@$tags[$i] ne $prevtag)){
$j++ unless (@$tags[$i] eq "");
#warn "IND:".substr(@$indicator[$j],0,1).substr(@$indicator[$j],1,1)." ".@$tags[$i];
if (!$first){
$marcxml.="</datafield>\n";
if ((@$tags[$i] > 10) && (@$values[$i] ne "")){
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
$marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
$first=0;
} else {
$first=1;
}
} else {
if (@$values[$i] ne "") {
# handle the leader
if (@$tags[$i] eq "000") {
$marcxml.="<leader>@$values[$i]</leader>\n";
$first=1;
# rest of the fixed fields
} elsif (@$tags[$i] < 010) { #FIXME: <10 was the way it was, there might even be a better way
$marcxml.="<controlfield tag=\"@$tags[$i]\">@$values[$i]</controlfield>\n";
$first=1;
} else {
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
$marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
$first=0;
}
}
}
} else { # @$tags[$i] eq $prevtag
if (@$values[$i] eq "") {
} else {
if ($first){
my $ind1 = substr(@$indicator[$j],0,1);
my $ind2 = substr(@$indicator[$j],1,1);
$marcxml.="<datafield tag=\"@$tags[$i]\" ind1=\"$ind1\" ind2=\"$ind2\">\n";
$first=0;
}
$marcxml.="<subfield code=\"@$subfields[$i]\">@$values[$i]</subfield>\n";
}
}
$prevtag = @$tags[$i];
}
$marcxml.= MARC::File::XML::footer();
#warn $marcxml;
return ($error,$marcxml);
}
=head2 html2marc
=over 4
Probably best to avoid using this ... it has some rather striking problems:
=over 2
* saves blank subfields
* subfield order is hardcoded to always start with 'a' for repeatable tags (because it is hardcoded in the addfield routine).
* only possible to specify one set of indicators for each set of tags (ie, one for all the 650s). (because they were stored in a hash with the tag as the key).
* the underlying routines didn't support subfield reordering or subfield repeatability.
=back
I've left it in here because it could be useful if someone took the time to fix it. -- kados
=back
=cut
sub html2marc {
my ($dbh,$rtags,$rsubfields,$rvalues,%indicators) = @_;
my $prevtag = -1;
my $record = MARC::Record->new();
# my %subfieldlist=();
my $prevvalue; # if tag <10
my $field; # if tag >=10
for (my $i=0; $i< @$rtags; $i++) {
# rebuild MARC::Record
# warn "0=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ";
if (@$rtags[$i] ne $prevtag) {
if ($prevtag < 10) {
if ($prevvalue) {
if (($prevtag ne '000') && ($prevvalue ne "")) {
$record->add_fields((sprintf "%03s",$prevtag),$prevvalue);
} elsif ($prevvalue ne ""){
$record->leader($prevvalue);
}
}
} else {
if (($field) && ($field ne "")) {
$record->add_fields($field);
}
}
$indicators{@$rtags[$i]}.=' ';
# skip blank tags, I hope this works
if (@$rtags[$i] eq ''){
$prevtag = @$rtags[$i];
undef $field;
next;
}
if (@$rtags[$i] <10) {
$prevvalue= @$rvalues[$i];
undef $field;
} else {
undef $prevvalue;
if (@$rvalues[$i] eq "") {
undef $field;
} else {
$field = MARC::Field->new( (sprintf "%03s",@$rtags[$i]), substr($indicators{@$rtags[$i]},0,1),substr($indicators{@$rtags[$i]},1,1), @$rsubfields[$i] => @$rvalues[$i]);
}
# warn "1=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
}
$prevtag = @$rtags[$i];
} else {
if (@$rtags[$i] <10) {
$prevvalue=@$rvalues[$i];
} else {
if (length(@$rvalues[$i])>0) {
$field->add_subfields(@$rsubfields[$i] => @$rvalues[$i]);
# warn "2=>".@$rtags[$i].@$rsubfields[$i]." = ".@$rvalues[$i].": ".$field->as_formatted;
}
}
$prevtag= @$rtags[$i];
}
}
#}
# the last has not been included inside the loop... do it now !
#use Data::Dumper;
#warn Dumper($field->{_subfields});
$record->add_fields($field) if (($field) && $field ne "");
#warn "HTML2MARC=".$record->as_formatted;
return $record;
}
=head2 changeEncoding - Change the encoding of a record
=over 4
my ($error, $newrecord) = changeEncoding($record,$format,$flavour,$to_encoding,$from_encoding);
Changes the encoding of a record
=over 2
C<$record> - the record itself can be in ISO-2709, a MARC::Record object, or MARCXML for now (required)
C<$format> - MARC or MARCXML (required)
C<$flavour> - MARC21 or UNIMARC, if MARC21, it will change the leader (optional) [defaults to Koha system preference]
C<$to_encoding> - the encoding you want the record to end up in (optional) [UTF-8]
C<$from_encoding> - the encoding the record is currently in (optional, it will probably be able to tell unless there's a problem with the record)
=back
FIXME: the from_encoding doesn't work yet
FIXME: better handling for UNIMARC, it should allow management of 100 field
FIXME: shouldn't have to convert to and from xml/marc just to change encoding someone needs to re-write MARC::Record's 'encoding' method to actually alter the encoding rather than just changing the leader
=back
=cut
sub changeEncoding {
my ($record,$format,$flavour,$to_encoding,$from_encoding) = @_;
my $newrecord;
my $error;
unless($flavour) {$flavour = C4::Context->preference("marcflavour")};
unless($to_encoding) {$to_encoding = "UTF-8"};
# ISO-2709 Record (MARC21 or UNIMARC)
if (lc($format) =~ /^marc$/o) {
# if we're converting encoding of an ISO2709 file, we need to roundtrip through XML
# because MARC::Record doesn't directly provide us with an encoding method
# It's definitely less than idea and should be fixed eventually - kados
my $marcxml; # temporary storage of MARCXML scalar
($error,$marcxml) = marc2marcxml($record,$to_encoding,$flavour);
unless ($error) {
($error,$newrecord) = marcxml2marc($marcxml,$to_encoding,$flavour);
}
# MARCXML Record
} elsif (lc($format) =~ /^marcxml$/o) { # MARCXML Record
my $marc;
($error,$marc) = marcxml2marc($record,$to_encoding,$flavour);
unless ($error) {
($error,$newrecord) = marc2marcxml($record,$to_encoding,$flavour);
}
} else {
$error.="Unsupported record format:".$format;
}
return ($error,$newrecord);
}
=head1 INTERNAL FUNCTIONS
=head2 _entity_encode - Entity-encode an array of strings
=over 4
my ($entity_encoded_string) = _entity_encode($string);
or
my (@entity_encoded_strings) = _entity_encode(@strings);
Entity-encode an array of strings
=back
=cut
sub _entity_encode {
my @strings = @_;
my @strings_entity_encoded;
foreach my $string (@strings) {
my $nfc_string = NFC($string);
$nfc_string =~ s/([\x{0080}-\x{fffd}])/sprintf('&#x%X;',ord($1))/sgoe;
push @strings_entity_encoded, $nfc_string;
}
return @strings_entity_encoded;
}
END { } # module clean-up code here (global destructor)
1;
__END__
=head1 AUTHOR
Joshua Ferraro <jmf@liblime.com>
=head1 MODIFICATIONS
# $Id$
=cut

142
C4/tests/Record_test.pl

@ -0,0 +1,142 @@
#!/usr/bin/perl
#
# Copyright 2006 (C) LibLime
# Joshua Ferraro <jmf@liblime.com>
#
# 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$
#
use strict; use warnings; #FIXME: turn off warnings before release
# specify the number of tests
use Test::More tests => 23;
#use C4::Context;
use C4::Record;
=head1 NAME
Record_test.pl - test suite for Record.pm
=head1 SYNOPSIS
$ export KOHA_CONF=/path/to/koha.conf
$ ./Record_test.pl
=cut
## FIXME: Preliminarily grab the modules dir so we can run this in context
ok (1, 'module compiled');
# open some files for testing
open MARC21MARC8,"testrecords/marc21_marc8.dat" or die $!;
my $marc21_marc8; # = scalar (MARC21MARC8);
foreach my $line (<MARC21MARC8>) {
$marc21_marc8 .= $line;
}
$marc21_marc8 =~ s/\n$//;
close MARC21MARC8;
open (MARC21UTF8,"<:utf8","testrecords/marc21_utf8.dat") or die $!;
my $marc21_utf8;
foreach my $line (<MARC21UTF8>) {
$marc21_utf8 .= $line;
}
$marc21_utf8 =~ s/\n$//;
close MARC21UTF8;
open MARC21MARC8COMBCHARS,"testrecords/marc21_marc8_combining_chars.dat" or die $!;
my $marc21_marc8_combining_chars;
foreach my $line(<MARC21MARC8COMBCHARS>) {
$marc21_marc8_combining_chars.=$line;
}
$marc21_marc8_combining_chars =~ s/\n$//; #FIXME: why is a newline ending up here?
close MARC21MARC8COMBCHARS;
open (MARC21UTF8COMBCHARS,"<:utf8","testrecords/marc21_utf8_combining_chars.dat") or die $!;
my $marc21_utf8_combining_chars;
foreach my $line(<MARC21UTF8COMBCHARS>) {
$marc21_utf8_combining_chars.=$line;
}
close MARC21UTF8COMBCHARS;
open (MARCXMLUTF8,"<:utf8","testrecords/marcxml_utf8.xml") or die $!;
my $marcxml_utf8;
foreach my $line (<MARCXMLUTF8>) {
$marcxml_utf8 .= $line;
}
close MARCXMLUTF8;
$marcxml_utf8 =~ s/\n//g;
## The Tests:
my $error; my $marc; my $marcxml; my $dcxml; # some scalars to store values
## MARC to MARCXML
print "\n1. Checking conversion of simple ISO-2709 (MARC21) records to MARCXML\n";
ok (($error,$marcxml) = marc2marcxml($marc21_marc8,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 (MARC21)');
ok (!$error, 'no errors in conversion');
$marcxml =~ s/\n//g;
$marcxml =~ s/v\/ s/v\/s/g; # FIXME: bug in new_from_xml_record!!
is ($marcxml,$marcxml_utf8, 'record matches antitype');
ok (($error,$marcxml) = marc2marcxml($marc21_utf8,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 (MARC21)');
ok (!$error, 'no errors in conversion');
$marcxml =~ s/\n//g;
$marcxml =~ s/v\/ s/v\/s/g;
is ($marcxml,$marcxml_utf8, 'record matches antitype');
print "\n2. checking binary MARC21 records with combining characters to MARCXML\n";
ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'MARC-8','MARC21'), 'marc2marcxml - from MARC-8 to MARC-8 with combining characters(MARC21)');
ok (!$error, 'no errors in conversion');
ok (($error,$marcxml) = marc2marcxml($marc21_marc8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from MARC-8 to UTF-8 with combining characters (MARC21)');
ok (!$error, 'no errors in conversion');
ok (($error,$marcxml) = marc2marcxml($marc21_utf8_combining_chars,'UTF-8','MARC21'), 'marc2marcxml - from UTF-8 to UTF-8 with combining characters (MARC21)');
ok (!$error, 'no errors in conversion');
ok (($error,$dcxml) = marc2dcxml($marc21_utf8), 'marc2dcxml - from ISO-2709 to Dublin Core');
ok (!$error, 'no errors in conversion');
print "\n3. checking ability to alter encoding\n";
ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from MARC-8 to UTF-8');
ok (!$error, 'no errors in conversion');
ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from UTF-8 to MARC-8');
ok (!$error, 'no errors in conversion');
ok (($error,$marc) = changeEncoding($marc21_marc8,'MARC','MARC21','MARC-8'), 'changeEncoding - MARC21 from MARC-8 to MARC-8');
ok (!$error, 'no errors in conversion');
ok (($error,$marc) = changeEncoding($marc21_utf8,'MARC','MARC21','UTF-8'), 'changeEncoding - MARC21 from UTF-8 to UTF-8');
ok (!$error, 'no errors in conversion');
__END__
=head1 TODO
Still lots more to test including UNIMARC support
=head1 AUTHOR
Joshua Ferraro <jmf@liblime.com>
=head1 MODIFICATIONS
# $Id$
=cut

1
C4/tests/testrecords/marc21_marc8.dat

@ -0,0 +1 @@
00463 2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148

1
C4/tests/testrecords/marc21_marc8_combining_chars.dat

@ -0,0 +1 @@
01442cam 2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056ocm11030895 OCoLC20060516100102.0840720s1984 ne b 001 0 eng  a 83048926  aDLCcDLCdMUQdNLGGC aB84431862bccb a0800606035 (Fortress Press) :c$35.951 aNLGGCb84037516600aBM485b.L57 1984 vol. 200a296.1 sa296.1219 a11.372bcl0 a296.1bST66  aWN300aJewish writings of the Second Temple period :bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus /cedited by Michael E. Stone. aAssen, Netherlands :bVan Gorcum ;aPhiladelphia :bFortress Press,c1984. axxiii, 697 p. ;c25 cm. 0aCompendia rerum Iudaicarum ad Novum Testamentum.nSection 2,pLiterature of the Jewish people in the period of the Second Temple and the Talmud ;v2 aBibliography: p. 603-653. aIncludes indexes. 0aJewish religious literaturexHistory and criticism. 0aJudaismxHistoryyPost-exilic period, 586 B.C.-210 A.D.xSources. 6aLittâerature religieuse juivexHistoire et critique.17aOude Testament.2gtt17aApocriefen.2gtt17aDode-Zeerollen.2gtt1 aStone, Michael E.,d1938- k296.1 ST66 aC0bWN3

1
C4/tests/testrecords/marc21_marc8_errors.dat

@ -0,0 +1 @@
00462 2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148

1
C4/tests/testrecords/marc21_utf8.dat

@ -0,0 +1 @@
00463 a2200169 450000100060000000300050000600500170001100800410002802000150006909000150008410000340009924500510013325000250018465000220020994200250023195200370025684893ACLS19990324000000.0930421s19xx xxu 00010 eng d a0854562702 c1738d17381 aChristie, Agatha,d1890-1976.10aWhy didn't they ask Evans? /cAgatha Christie. aLarge print edition. 0aLarge type books. aONecLPkLP Christie bNPLp31000000010273r12.00u2148

1
C4/tests/testrecords/marc21_utf8_combining_chars.dat

@ -0,0 +1 @@
01442cam a2200373 a 4500001001300000003000600013005001700019008004100036010001700077040002500094016001900119020004200138029002100180050002800201082002300229084001500252092001700267049000800284245015300292260007900445300002800524440015300552500003000705500002200735650005600757650007000813650005700883650002500940650002100965650002500986700003001011942001501041994001201056ocm11030895 OCoLC20060516100102.0840720s1984 ne b 001 0 eng  a 83048926  aDLCcDLCdMUQdNLGGC aB84431862bccb a0800606035 (Fortress Press) :c$35.951 aNLGGCb84037516600aBM485b.L57 1984 vol. 200a296.1 sa296.1219 a11.372bcl0 a296.1bST66  aWN300aJewish writings of the Second Temple period :bApocrypha, Pseudepigrapha, Qumran, sectarian writings, Philo, Josephus /cedited by Michael E. Stone. aAssen, Netherlands :bVan Gorcum ;aPhiladelphia :bFortress Press,c1984. axxiii, 697 p. ;c25 cm. 0aCompendia rerum Iudaicarum ad Novum Testamentum.nSection 2,pLiterature of the Jewish people in the period of the Second Temple and the Talmud ;v2 aBibliography: p. 603-653. aIncludes indexes. 0aJewish religious literaturexHistory and criticism. 0aJudaismxHistoryyPost-exilic period, 586 B.C.-210 A.D.xSources. 6aLittérature religieuse juivexHistoire et critique.17aOude Testament.2gtt17aApocriefen.2gtt17aDode-Zeerollen.2gtt1 aStone, Michael E.,d1938- k296.1 ST66 aC0bWN3

44
C4/tests/testrecords/marcxml_utf8.xml

@ -0,0 +1,44 @@
<?xml version="1.0" encoding="UTF-8"?>
<record
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
xmlns="http://www.loc.gov/MARC21/slim">
<leader>00463 a2200169 4500</leader>
<controlfield tag="001">84893</controlfield>
<controlfield tag="003">ACLS</controlfield>
<controlfield tag="005">19990324000000.0</controlfield>
<controlfield tag="008">930421s19xx xxu 00010 eng d</controlfield>
<datafield tag="020" ind1=" " ind2=" ">
<subfield code="a">0854562702</subfield>
</datafield>
<datafield tag="090" ind1=" " ind2=" ">
<subfield code="c">1738</subfield>
<subfield code="d">1738</subfield>
</datafield>
<datafield tag="100" ind1="1" ind2=" ">
<subfield code="a">Christie, Agatha,</subfield>
<subfield code="d">1890-1976.</subfield>
</datafield>
<datafield tag="245" ind1="1" ind2="0">
<subfield code="a">Why didn't they ask Evans? /</subfield>
<subfield code="c">Agatha Christie.</subfield>
</datafield>
<datafield tag="250" ind1=" " ind2=" ">
<subfield code="a">Large print edition.</subfield>
</datafield>
<datafield tag="650" ind1=" " ind2="0">
<subfield code="a">Large type books.</subfield>
</datafield>
<datafield tag="942" ind1=" " ind2=" ">
<subfield code="a">ONe</subfield>
<subfield code="c">LP</subfield>
<subfield code="k">LP Christie</subfield>
</datafield>
<datafield tag="952" ind1=" " ind2=" ">
<subfield code="b">NPL</subfield>
<subfield code="p">31000000010273</subfield>
<subfield code="r">12.00</subfield>
<subfield code="u">2148</subfield>
</datafield>
</record>

46
C4/tests/testrecords/marcxml_utf8_entityencoded.xml

@ -0,0 +1,46 @@
<?xml version="1.0" encoding="UTF-8"?>
<collection
xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
xsi:schemaLocation="http://www.loc.gov/MARC21/slim http://www.loc.gov/standards/marcxml/schema/MARC21slim.xsd"
xmlns="http://www.loc.gov/MARC21/slim">
<record>
<leader>00463 a2200169 4500</leader>
<controlfield tag="001">84893</controlfield>
<controlfield tag="003">ACLS</controlfield>
<controlfield tag="005">19990324000000.0</controlfield>
<controlfield tag="008">930421s19xx xxu 00010 eng d</controlfield>
<datafield tag="020" ind1=" " ind2=" ">
<subfield code="a">0854562702</subfield>
</datafield>
<datafield tag="090" ind1=" " ind2=" ">
<subfield code="c">1738</subfield>
<subfield code="d">1738</subfield>
</datafield>
<datafield tag="100" ind1="1" ind2=" ">
<subfield code="a">Christie, Agatha,</subfield>
<subfield code="d">1890-1976.</subfield>
</datafield>
<datafield tag="245" ind1="1" ind2="0">
<subfield code="a">Why didn't they ask Evans? /</subfield>
<subfield code="c">Agatha Christie.</subfield>
</datafield>
<datafield tag="250" ind1=" " ind2=" ">
<subfield code="a">Large print edition.</subfield>
</datafield>
<datafield tag="650" ind1=" " ind2="0">
<subfield code="a">Large type books.</subfield>
</datafield>
<datafield tag="942" ind1=" " ind2=" ">
<subfield code="a">ONe</subfield>
<subfield code="c">LP</subfield>
<subfield code="k">LP Christie</subfield>
</datafield>
<datafield tag="952" ind1=" " ind2=" ">
<subfield code="b">NPL</subfield>
<subfield code="p">31000000010273</subfield>
<subfield code="r">12.00</subfield>
<subfield code="u">2148</subfield>
</datafield>
</record>
</collection>

136
acqui/neworderbiblio.pl

@ -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;

232
acqui/orderreceive.pl

@ -0,0 +1,232 @@
#!/usr/bin/perl
# $Id$
#script to recieve orders
#written by chris@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;

172
acqui/parcels.pl

@ -0,0 +1,172 @@
#!/usr/bin/perl
# $Id$
#script to show display basket of orders
#written by chris@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;

80
acqui/spent.pl

@ -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;

180
admin/biblio_framework.pl

@ -0,0 +1,180 @@
#!/usr/bin/perl
# NOTE: 4-character tabs
#written 20/02/2002 by paul.poulain@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:

189
admin/koha2marclinks.pl

@ -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&amp;tablename=$tablename&amp;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;

570
admin/marc_subfields_structure.pl

@ -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&amp;tagfield=$tagfield&amp;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;

388
admin/marctagstructure.pl

@ -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&amp;searchfield=".$results[$i]->{'mts_tagfield'}."&frameworkcode=".$frameworkcode;
$row_data{delete} = "$script_name?op=delete_confirm&amp;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&amp;searchfield=".$results->[$i]{'tagfield'}."&frameworkcode=".$frameworkcode;
$row_data{delete} = "$script_name?op=delete_confirm&amp;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);
}
}

267
catalogue/dictionary.pl

@ -0,0 +1,267 @@
#!/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::Search;
use C4::AuthoritiesMarc;
use C4::Context;
use C4::Biblio;
=head1 NAME
dictionnary.pl : script to search in biblio & authority an existing value
=head1 SYNOPSIS
useful when the user want to search a term before running a query. For example, to see if "computer" is used in the database
The parameter "marclist" tells which field is searched (title, author, subject, but could be anything else)
This script searches in both biblios & authority
* in biblio, the script search in all marc fields related to what the user is looking for (for example, if the dictionnary is used on "author", the script searches in biblio.author, but also in additional authors & any MARC field related to author (through the "seealso" MARC constraint)
* in authority, the script search everywhere. Thus, the accepted & rejected forms are found.
The script shows all results & the user can choose what he want, that is copied into search form.
=cut
my $input = new CGI;
my $field =$input->param('marclist');
#warn "field :$field";
my ($tablename, $kohafield)=split /./,$field;
#my $tablename=$input->param('tablename');
$tablename="biblio" unless ($tablename);
#my $kohafield = $input->param('kohafield');
my @search = $input->param('search');
# warn " ".$search[0];
my $index = $input->param('index');
# warn " index: ".$index;
my $op=$input->param('op');
if (($search[0]) and not ($op eq 'do_search')){
$op='do_search';
}
my $script_name = 'catalogue/dictionary.pl';
my $query;
my $type=$input->param('type');
#warn " ".$type;
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie);
my $env;
my $startfrom=$input->param('startfrom');
$startfrom=0 if(!defined $startfrom);
my $searchdesc;
my $resultsperpage;
#warn "Starting process";
if ($op eq "do_search") {
#
# searching in biblio
#
my $sth=$dbh->prepare("Select distinct tagfield,tagsubfield from marc_subfield_structure where kohafield = ?");
$sth->execute("$field");
my (@tags, @and_or, @operator, @excluding,@value);
while ((my $tagfield,my $tagsubfield,my $liblibrarian) = $sth->fetchrow) {
push @tags, $dbh->quote("$tagfield$tagsubfield");
}
$resultsperpage= $input->param('resultsperpage');
$resultsperpage = 19 if(!defined $resultsperpage);
my $orderby = $input->param('orderby');
findseealso($dbh,\@tags);
my @results, my $total;
my $strsth="select distinct subfieldvalue, count(marc_subfield_table.bibid) from marc_subfield_table,marc_word where marc_word.word like ? and marc_subfield_table.bibid=marc_word.bibid and marc_subfield_table.tagorder=marc_word.tagorder and marc_word.tagsubfield in ";
my $listtags="(";
foreach my $tag (@tags){
$listtags .= $tag .",";
}
$listtags =~s/,$/)/;
$strsth .= $listtags." and marc_word.tagsubfield=concat(marc_subfield_table.tag,marc_subfield_table.subfieldcode) group by subfieldvalue ";
# warn "search in biblio : ".$strsth;
my $value = uc($search[0]);
$value=~s/\*/%/g;
$value.= "%" if not($value=~m/%/);
# warn " texte : ".$value;
$sth=$dbh->prepare($strsth);
$sth->execute($value);
my $total;
my @catresults;
my $javalue;
while (my ($value,$ctresults)=$sth->fetchrow) {
# This $javalue is used for the javascript selectentry function (javalue for javascript value !)
$javalue = $value;
$javalue =~s/'/\\'/g;
push @catresults,{value=> $value,
javalue=> $javalue,
even=>($total-$startfrom*$resultsperpage)%2,
count=>$ctresults
} if (($total>=$startfrom*$resultsperpage) and ($total<($startfrom+1)*$resultsperpage));
$total++;
}
my $strsth="Select distinct authtypecode from marc_subfield_structure where (";
foreach my $listtags (@tags){
my @taglist=split /,/,$listtags;
foreach my $curtag (@taglist){
$curtag =~s/\s+//;
$strsth.="(tagfield='".substr($curtag,1,3)."' AND tagsubfield='".substr($curtag,4,1)."') OR";
}
}
$strsth=~s/ OR$/)/;
my $strsth = $strsth." and authtypecode is not NULL";
# warn $strsth;
my $sth=$dbh->prepare($strsth);
$sth->execute;
#
# searching in authorities
#
my @authresults;
my $authnbresults;
while ((my $authtypecode) = $sth->fetchrow) {
my ($curauthresults,$nbresults) = authoritysearch($dbh,[''],[''],[''],['contains'],
\@search,$startfrom*$resultsperpage, $resultsperpage,$authtypecode);
if (defined(@$curauthresults)) {
for (my $i = 0; $i < @$curauthresults ;$i++) {
@$curauthresults[$i]->{jamainentry} = @$curauthresults[$i]->{mainentry};
@$curauthresults[$i]->{jamainentry} =~ s/'/\\'/g;
}
}
push @authresults, @$curauthresults;
$authnbresults+=$nbresults;
# warn "auth : $authtypecode nbauthresults : $nbresults";
}
#
# OK, filling the template with authorities & biblio entries found.
#
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "catalogue/dictionary.tmpl",
query => $input,
type => $type,
authnotrequired => 0,
flagsrequired => {catalogue => 1},
debug => 1,
});
# multi page display gestion
my $displaynext=0;
my $displayprev=$startfrom;
if(($total - (($startfrom+1)*($resultsperpage))) > 0 ) {
$displaynext = 1;
}
my @field_data = ();
for(my $i = 0 ; $i <= $#tags ; $i++) {
push @field_data, { term => "marclist", val=>$tags[$i] };
push @field_data, { term => "and_or", val=>$and_or[$i] };
push @field_data, { term => "excluding", val=>$excluding[$i] };
push @field_data, { term => "operator", val=>$operator[$i] };
push @field_data, { term => "value", val=>$value[$i] };
}
my @numbers = ();
if ($total>$resultsperpage) {
for (my $i=1; $i<$total/$resultsperpage+1; $i++) {
if ($i<16) {
my $highlight=0;
($startfrom==($i-1)) && ($highlight=1);
push @numbers, { number => $i,
highlight => $highlight ,
searchdata=> \@field_data,
startfrom => ($i-1)};
}
}
}
my $from = $startfrom*$resultsperpage+1;
my $to;
if($total < (($startfrom+1)*$resultsperpage))
{
$to = $total;
} else {
$to = (($startfrom+1)*$resultsperpage);
}
$template->param(anindex => $input->param('index'));
$template->param(result => \@results,
catresult=> \@catresults,
search => $search[0],
marclist =>$field,
authresult => \@authresults,
nbresults => $authnbresults,
startfrom=> $startfrom,
displaynext=> $displaynext,
displayprev=> $displayprev,
resultsperpage => $resultsperpage,
startfromnext => $startfrom+1,
startfromprev => $startfrom-1,
searchdata=>\@field_data,
total=>$total,
from=>$from,
to=>$to,
numbers=>\@numbers,
MARC_ON => C4::Context->preference("marc"),
);
} else {
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "catalogue/dictionary.tmpl",
query => $input,
type => $type,
authnotrequired => 0,
flagsrequired => {catalogue => 1},
debug => 1,
});
#warn "type : $type";
}
$template->param(search => $search[0],
marclist =>$field,
type=>$type,
anindex => $input->param('index'),
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
);
# Print the page
output_html_with_http_headers $input, $cookie, $template->output;
# Local Variables:
# tab-width: 4
# End:

62
catalogue/issuehistory.pl

@ -0,0 +1,62 @@
#!/usr/bin/perl
# 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$
use strict;
require Exporter;
use CGI;
use C4::Auth;
use C4::Interface::CGI::Output;
use C4::Circulation::Circ2; # GetIssuesFromBiblio
my $query = new CGI;
my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
{
template_name => "catalogue/issuehistory.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
flagsrequired => { circulate => 1 },
}
);
# getting cgi params.
my $params = $query->Vars;
my $biblionumber = $params->{'biblionumber'};
my $title = $params->{'title'};
my $author = $params->{'author'};
my $issues = GetIssuesFromBiblio($biblionumber);
my $total = scalar @$issues;
if ( $total && !$title ) {
$title = $issues->[0]->{'title'};
$author = $issues->[0]->{'author'};
}
$template->param(
biblionumber => $biblionumber,
total => scalar @$issues,
title => $title,
author => $author,
issues => $issues
);
output_html_with_http_headers $query, $cookie, $template->output;

538
catalogue/search.pl

@ -0,0 +1,538 @@
#!/usr/bin/perl
# Script to perform searching
# For documentation try 'perldoc /path/to/search'
#
# $Header$
#
# Copyright 2006 LibLime
#
# 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
search - a search script for finding records in a Koha system (Version 2.4)
=head1 OVERVIEW
This script contains a demonstration of a new search API for Koha 2.4. It is
designed to be simple to use and configure, yet capable of performing feats
like stemming, field weighting, relevance ranking, support for multiple
query language formats (CCL, CQL, PQF), full or nearly full support for the
bib1 attribute set, extended attribute sets defined in Zebra profiles, access
to the full range of Z39.50 query options, federated searches on Z39.50
targets, etc.
I believe the API as represented in this script is mostly sound, even if the
individual functions in Search.pm and Koha.pm need to be cleaned up. Of course,
you are free to disagree :-)
I will attempt to describe what is happening at each part of this script.
-- JF
=head2 INTRO
This script performs two functions:
=over
=item 1. interacts with Koha to retrieve and display the results of a search
=item 2. loads the advanced search page
=back
These two functions share many of the same variables and modules, so the first
task is to load what they have in common and determine which template to use.
Once determined, proceed to only load the variables and procedures necessary
for that function.
=head2 THE ADVANCED SEARCH PAGE
If we're loading the advanced search page this script will call a number of
display* routines which populate objects that are sent to the template for
display of things like search indexes, languages, search limits, branches,
etc. These are not stored in the template for two reasons:
=over
=item 1. Efficiency - we have more control over objects inside the script, and it's possible to not duplicate things like indexes (if the search indexes were stored in the template they would need to be repeated)
=item 2. Customization - if these elements were moved to the sql database it would allow a simple librarian to determine which fields to display on the page without editing any html (also how the fields should behave when being searched).
=back
However, they create one problem : the strings aren't translated. I have an idea
for how to do this that I will purusue soon.
=head2 PERFORMING A SEARCH
If we're performing a search, this script performs three primary
operations:
=over
=item 1. builds query strings (yes, plural)
=item 2. perform the search and return the results array
=item 3. build the HTML for output to the template
=back
There are several additional secondary functions performed that I will
not cover in detail.
=head3 1. Building Query Strings
There are several types of queries needed in the process of search and retrieve:
=over
=item 1 Koha query - the query that is passed to Zebra
This is the most complex query that needs to be built.The original design goal was to use a custom CCL2PQF query parser to translate an incoming CCL query into a multi-leaf query to pass to Zebra. It needs to be multi-leaf to allow field weighting, koha-specific relevance ranking, and stemming. When I have a chance I'll try to flesh out this section to better explain.
This query incorporates query profiles that aren't compatible with non-Zebra Z39.50 targets to acomplish the field weighting and relevance ranking.
=item 2 Federated query - the query that is passed to other Z39.50 targets
This query is just the user's query expressed in CCL CQL, or PQF for passing to a non-zebra Z39.50 target (one that doesn't support the extended profile that Zebra does).
=item 3 Search description - passed to the template / saved for future refinements of the query (by user)
This is a simple string that completely expresses the query in a way that can be parsed by Koha for future refinements of the query or as a part of a history feature. It differs from the human search description in several ways:
1. it does not contain commas or = signs
2.
=item 4 Human search description - what the user sees in the search_desc area
This is a simple string nearly identical to the Search description, but more human readable. It will contain = signs or commas, etc.
=back
=head3 2. Perform the Search
This section takes the query strings and performs searches on the named servers, including the Koha Zebra server, stores the results in a deeply nested object, builds 'faceted results', and returns these objects.
=head3 3. Build HTML
The final major section of this script takes the objects collected thusfar and builds the HTML for output to the template and user.
=head3 Additional Notes
Not yet completed...
=cut
use strict; # always use
## STEP 1. Load things that are used in both search page and
# results page and decide which template to load, operations
# to perform, etc.
## load Koha modules
use C4::Context;
use C4::Interface::CGI::Output;
use C4::Auth;
use C4::Search;
use C4::Languages; # getAllLanguages
use C4::Koha;
use POSIX qw(ceil floor);
use C4::Branch; # GetBranches
# create a new CGI object
# not sure undef_params option is working, need to test
use CGI qw('-no_undef_params');
my $cgi = new CGI;
my ($template,$borrowernumber,$cookie);
# decide which template to use
my $template_name;
my @params = $cgi->param("limit");
if ((@params>1) || ($cgi->param("q")) ) {
$template_name = 'catalogue/results.tmpl';
}
else {
$template_name = 'catalogue/advsearch.tmpl';
}
# load the template
($template, $borrowernumber, $cookie) = get_template_and_user({
template_name => $template_name,
query => $cgi,
type => "intranet",
authnotrequired => 0,
flagsrequired => { catalogue => 1 },
}
);
=head1 BUGS and FIXMEs
There are many, most are documented in the code. The one that
isn't fully documented, but referred to is the need for a full
query parser.
=cut
## URI Re-Writing
# FIXME: URI re-writing should be tested more carefully and may better
# handled by mod_rewrite or something else. The code below almost works,
# but doesn't quite handle limits correctly when they are the only
# param passed -- I'll work on this soon -- JF
#my $rewrite_flag;
#my $uri = $cgi->url(-base => 1);
#my $relative_url = $cgi->url(-relative=>1);
#$uri.="/".$relative_url."?";
#warn "URI:$uri";
#my @cgi_params_list = $cgi->param();
#my $url_params = $cgi->Vars;
#for my $each_param_set (@cgi_params_list) {
# $uri.= join "", map "\&$each_param_set=".$_, split("\0",$url_params->{$each_param_set}) if $url_params->{$each_param_set};
#}
#warn "New URI:$uri";
# Only re-write a URI if there are params or if it already hasn't been re-written
#unless (($cgi->param('r')) || (!$cgi->param()) ) {
# print $cgi->redirect( -uri=>$uri."&r=1",
# -cookie => $cookie);
# exit;
#}
# load the branches
my $branches = GetBranches();
my @branch_loop;
push @branch_loop, {value => "", branchname => "All Branches", };
for my $branch_hash (keys %$branches) {
push @branch_loop, {value => "branch: $branch_hash", branchname => $branches->{$branch_hash}->{'branchname'}, };
}
$template->param(branchloop => \@branch_loop,);
# load the itemtypes (Called Collection Codes in the template -- used for circ rules )
my $itemtypes = GetItemTypes;
my @itemtypesloop;
my $selected=1;
my $cnt;
my $imgdir = getitemtypeimagesrc();
foreach my $thisitemtype (sort keys %$itemtypes) {
my %row =( number=>$cnt++,
imageurl=>$imgdir."/".$itemtypes->{$thisitemtype}->{'imageurl'},
code => $thisitemtype,
selected => $selected,
description => $itemtypes->{$thisitemtype}->{'description'},
count5 => $cnt % 5,
);
$selected = 0 if ($selected) ;
push @itemtypesloop, \%row;
}
$template->param(itemtypeloop => \@itemtypesloop);
# # load the itypes (Called item types in the template -- just authorized values for searching)
# my ($itypecount,@itype_loop) = GetCcodes();
# $template->param(itypeloop=>\@itype_loop,);
# load the languages ( for switching from one template to another )
# my @languages_options = displayLanguages($cgi);
# my $languages_count = @languages_options;
# if($languages_count > 1){
# $template->param(languages => \@languages_options);
# }
# The following should only be loaded if we're bringing up the advanced search template
if ( $template_name eq "catalogue/advsearch.tmpl" ) {
# load the servers (used for searching -- to do federated searching, etc.)
my $primary_servers_loop;# = displayPrimaryServers();
$template->param(outer_servers_loop => $primary_servers_loop,);
my $secondary_servers_loop;# = displaySecondaryServers();
$template->param(outer_sup_servers_loop => $secondary_servers_loop,);
# load the limit types (icon-based limits in advanced search page)
my $outer_limit_types_loop = displayLimitTypes();
$template->param(outer_limit_types_loop => $outer_limit_types_loop,);
# load the search indexes (what a user can choose to search by)
my $indexes = displayIndexes();
# determine what to display next to the search boxes (ie, boolean option
# shouldn't appear on the first one, scan indexes should, adding a new
# box should only appear on the last, etc.
# FIXME: this stuff should be cleaned up a bit and the html should be turned
# into flags for the template -- I'll work on that soon -- JF
my @search_boxes_array;
my $search_boxes_count = 1; # should be a syspref
for (my $i=0;$i<=$search_boxes_count;$i++) {
my $this_index =[@$indexes]; # clone the data, not just the reference
#@$this_index[$i]->{selected} = "selected";
if ($i==0) {
push @search_boxes_array,
{indexes => $this_index,
search_boxes_label => 1,
scan_index => 1,
};
}
elsif ($i==$search_boxes_count) {
push @search_boxes_array,
{indexes => $indexes,
add_field => "1",};
}
else {
push @search_boxes_array,
{indexes => $indexes,};
}
}
$template->param(uc(C4::Context->preference("marcflavour")) => 1,
search_boxes_loop => \@search_boxes_array);
# load the language limits (for search)
my $languages_limit_loop = getAllLanguages();
$template->param(search_languages_loop => $languages_limit_loop,);
# load the subtype limits
my $outer_subtype_limits_loop = displaySubtypesLimit();
$template->param(outer_subtype_limits_loop => $outer_subtype_limits_loop,);
my $expanded_options;
if (not defined $cgi->param('expanded_options')){
$expanded_options = C4::Context->preference("expandedSearchOption");
}
else {
$expanded_options = $cgi->param('expanded_options');
}
$template->param(expanded_options => $expanded_options);
# load the sort_by options for the template
my $sort_by = $cgi->param('sort_by');
my $sort_by_loop = displaySortby($sort_by);
$template->param(sort_by_loop => $sort_by_loop);
output_html_with_http_headers $cgi, $cookie, $template->output;
exit;
}
### OK, if we're this far, we're performing an actual search
# Fetch the paramater list as a hash in scalar context:
# * returns paramater list as tied hash ref
# * we can edit the values by changing the key
# * multivalued CGI paramaters are returned as a packaged string separated by "\0" (null)
my $params = $cgi->Vars;
# Params that can have more than one value
# sort by is used to sort the query
my @sort_by;
@sort_by = split("\0",$params->{'sort_by'}) if $params->{'sort_by'};
# load the sort_by options for the template
my $sort_by = $params->{'sort_by'};
my $sort_by_loop = displaySortby($sort_by);
$template->param(sort_by_loop => $sort_by_loop);
#
# Use the servers defined, or just search our local catalog(default)
my @servers;
@servers = split("\0",$params->{'server'}) if $params->{'server'};
unless (@servers) {
#FIXME: this should be handled using Context.pm
@servers = ("biblioserver");
# @servers = C4::Context->config("biblioserver");
}
# operators include boolean and proximity operators and are used
# to evaluate multiple operands
my @operators;
@operators = split("\0",$params->{'op'}) if $params->{'op'};
# indexes are query qualifiers, like 'title', 'author', etc. They
# can be simple or complex
my @indexes;
@indexes = split("\0",$params->{'idx'}) if $params->{'idx'};
# an operand can be a single term, a phrase, or a complete ccl query
my @operands;
@operands = split("\0",$params->{'q'}) if $params->{'q'};
# limits are use to limit to results to a pre-defined category such as branch or language
my @limits;
@limits = split("\0",$params->{'limit'}) if $params->{'limit'};
my $available;
foreach my $limit(@limits) {
if ($limit =~/available/) {
$available = 1;
}
}
$template->param(available => $available);
push @limits, map "yr:".$_, split("\0",$params->{'limit-yr'}) if $params->{'limit-yr'};
# Params that can only have one value
my $query = $params->{'q'};
my $scan = $params->{'scan'};
my $results_per_page = $params->{'count'} || 20;
my $offset = $params->{'offset'} || 0;
my $hits;
my $expanded_facet = $params->{'expand'};
# Define some global variables
my $error; # used for error handling
my $search_desc; # the query expressed in terms that humans understand
my $koha_query; # the query expressed in terms that zoom understands with field weighting and stemming
my $federated_query;
my $query_type; # usually not needed, but can be used to trigger ccl, cql, or pqf queries if set
my @results;
## I. BUILD THE QUERY
($error,$search_desc,$koha_query,$federated_query,$query_type) = buildQuery($query,\@operators,\@operands,\@indexes,\@limits);
## II. DO THE SEARCH AND GET THE RESULTS
my $total; # the total results for the whole set
my $facets; # this object stores the faceted results that display on the left-hand of the results page
my @results_array;
my $results_hashref;
eval {
($error, $results_hashref, $facets) = getRecords($koha_query,$federated_query,\@sort_by,\@servers,$results_per_page,$offset,$expanded_facet,$branches,$query_type,$scan);
};
if ($@ || $error) {
$template->param(query_error => $error.$@);
output_html_with_http_headers $cgi, $cookie, $template->output;
exit;
}
# At this point, each server has given us a result set
# now we build that set for template display
my @sup_results_array;
for (my $i=0;$i<=@servers;$i++) {
my $server = $servers[$i];
if ($server =~/biblioserver/) { # this is the local bibliographic server
$hits = $results_hashref->{$server}->{"hits"};
my @newresults = searchResults( $search_desc,$hits,$results_per_page,$offset,@{$results_hashref->{$server}->{"RECORDS"}});
$total = $total + $results_hashref->{$server}->{"hits"};
if ($hits) {
$template->param(total => $hits);
$template->param(searchdesc => ($query_type?"$query_type=":"")."$search_desc" );
$template->param(results_per_page => $results_per_page);
$template->param(SEARCH_RESULTS => \@newresults);
my @page_numbers;
my $pages = ceil($hits / $results_per_page);
my $current_page_number = 1;
$current_page_number = ($offset / $results_per_page + 1) if $offset;
my $previous_page_offset = $offset - $results_per_page unless ($offset - $results_per_page <0);
my $next_page_offset = $offset + $results_per_page;
for (my $j=1; $j<=$pages;$j++) {
my $this_offset = (($j*$results_per_page)-$results_per_page);
my $this_page_number = $j;
my $highlight = 1 if ($this_page_number == $current_page_number);
push @page_numbers, { offset => $this_offset, pg => $this_page_number, highlight => $highlight, sort_by => join " ",@sort_by };
}
$template->param(PAGE_NUMBERS => \@page_numbers,
previous_page_offset => $previous_page_offset,
next_page_offset => $next_page_offset) unless $pages < 2;
}
} # end of the if local
else {
# check if it's a z3950 or opensearch source
my $zed3950 = 0; # FIXME :: Hardcoded value.
if ($zed3950) {
my @inner_sup_results_array;
for my $sup_record ( @{$results_hashref->{$server}->{"RECORDS"}} ) {
my $marc_record_object = MARC::Record->new_from_usmarc($sup_record);
my $control_number = $marc_record_object->field('010')->subfield('a') if $marc_record_object->field('010');
$control_number =~ s/^ //g;
my $link = "http://catalog.loc.gov/cgi-bin/Pwebrecon.cgi?SAB1=".$control_number."&BOOL1=all+of+these&FLD1=LC+Control+Number+LCCN+%28K010%29+%28K010%29&GRP1=AND+with+next+set&SAB2=&BOOL2=all+of+these&FLD2=Keyword+Anywhere+%28GKEY%29+%28GKEY%29&PID=6211&SEQ=20060816121838&CNT=25&HIST=1";
my $title = $marc_record_object->title();
push @inner_sup_results_array, {
'title' => $title,
'link' => $link,
};
}
my $servername = $server;
push @sup_results_array, { servername => $servername, inner_sup_results_loop => \@inner_sup_results_array};
$template->param(outer_sup_results_loop => \@sup_results_array);
}
}
} #/end of the for loop
#$template->param(FEDERATED_RESULTS => \@results_array);
$template->param(
#classlist => $classlist,
total => $total,
searchdesc => ($query_type?"$query_type=":"")."$search_desc",
opacfacets => 1,
facets_loop => $facets,
suggestion => C4::Context->preference("suggestion"),
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("BiblioDefaultView") => 1,
scan_use => $scan,
search_error => $error,
);
## Now let's find out if we have any supplemental data to show the user
# and in the meantime, save the current query for statistical purposes, etc.
my $koha_spsuggest; # a flag to tell if we've got suggestions coming from Koha
my @koha_spsuggest; # place we store the suggestions to be returned to the template as LOOP
my $phrases = $search_desc;
my $ipaddress;
if ( C4::Context->preference("kohaspsuggest") ) {
eval {
my $koha_spsuggest_dbh;
# FIXME: this needs to be moved to Context.pm
eval {
$koha_spsuggest_dbh=DBI->connect("DBI:mysql:suggest:66.213.78.76","auth","Free2cirC");
};
if ($@) {
warn "can't connect to spsuggest db";
}
else {
my $koha_spsuggest_insert = "INSERT INTO phrase_log(phr_phrase,phr_resultcount,phr_ip) VALUES(?,?,?)";
my $koha_spsuggest_query = "SELECT display FROM distincts WHERE strcmp(soundex(suggestion), soundex(?)) = 0 order by soundex(suggestion) limit 0,5";
my $koha_spsuggest_sth = $koha_spsuggest_dbh->prepare($koha_spsuggest_query);
$koha_spsuggest_sth->execute($phrases);
while (my $spsuggestion = $koha_spsuggest_sth->fetchrow_array) {
$spsuggestion =~ s/(:|\/)//g;
my %line;
$line{spsuggestion} = $spsuggestion;
push @koha_spsuggest,\%line;
$koha_spsuggest = 1;
}
# Now save the current query
$koha_spsuggest_sth=$koha_spsuggest_dbh->prepare($koha_spsuggest_insert);
#$koha_spsuggest_sth->execute($phrases,$results_per_page,$ipaddress);
$koha_spsuggest_sth->finish;
$template->param( koha_spsuggest => $koha_spsuggest ) unless $hits;
$template->param( SPELL_SUGGEST => \@koha_spsuggest,
);
}
};
if ($@) {
warn "Kohaspsuggest failure:".$@;
}
}
# VI. BUILD THE TEMPLATE
output_html_with_http_headers $cgi, $cookie, $template->output;

62
catalogue/suggest.pl

@ -0,0 +1,62 @@
#!/usr/bin/perl
# WARNING: 4-character tab stops here
# 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;
require Exporter;
use CGI;
use C4::Auth;
use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Interface::CGI::Output;
use C4::Biblio;
use C4::Acquisition;
use C4::Koha; # XXX subfield_is_koha_internal_p
# Creates the list of active tags using the active MARC configuration
my $query=new CGI;
my $Q=$query->param('Q');
my @words = split / /,$Q;
my $dbh = C4::Context->dbh;
my $suggestions = findsuggestion($dbh,\@words);
my @loop_suggests;
foreach my $line (@$suggestions) {
my ($word,$suggestion,$count) = split /\|/,$line;
push @loop_suggests, { word => $word, suggestion =>$suggestion, count => $count };
}
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "catalogue/suggest.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$template->param("loop" => \@loop_suggests,
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
);
output_html_with_http_headers $query, $cookie, $template->output;

77
cataloguing/addbiblio-nomarc.pl

@ -0,0 +1,77 @@
#!/usr/bin/perl
# $Id$
#
# TODO
#
# Add info on biblioitems and items already entered as you enter new ones
#
# 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
# $Log$
# Revision 1.3 2007/03/09 15:36:10 tipaul
# rel_3_0 moved to HEAD (introducing new files)
#
# Revision 1.1.2.2 2006/12/18 16:35:18 toins
# removing use HTML::Template from *.pl.
#
# Revision 1.1.2.1 2006/09/26 16:05:05 toins
# adding missing template & fix wrong link on scripts.
#
# Revision 1.1 2006/01/17 16:40:54 tipaul
# moving acqui.simple directory to cataloguing, as acqui.simple contains cataloguing scripts...
#
# Revision 1.3 2005/05/04 08:45:22 tipaul
# synch'ing 2.2 and head
#
# Revision 1.2.4.1 2005/03/25 12:52:42 tipaul
# needs "editcatalogue" flag, not "catalogue"
#
# Revision 1.2 2003/05/09 23:47:22 rangi
# This script is now templated
# 3 more to go i think
#
use CGI;
use strict;
use C4::Output;
use C4::Auth;
use C4::Interface::CGI::Output;
my $input = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "cataloguing/addbiblio-nomarc.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1 },
debug => 1,
}
);
my $error = $input->param('error');
$template->param(
ERROR => $error,
);
output_html_with_http_headers $input, $cookie, $template->output;

235
cataloguing/additem-nomarc.pl

@ -0,0 +1,235 @@
#!/usr/bin/perl
# $Id$
# 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
# $Log$
# Revision 1.6 2007/03/09 15:36:10 tipaul
# rel_3_0 moved to HEAD (introducing new files)
#
# Revision 1.4.2.3 2006/12/14 15:41:54 toins
# admin/branches.pl works now with mod_perl.
# New module : Branch.pm containt all functions dealings with branches.
#
# Revision 1.4.2.2 2006/12/05 11:35:30 toins
# Biblio.pm cleaned.
# additionalauthors, bibliosubject, bibliosubtitle tables are now unused.
# Some functions renamed according to the coding guidelines.
#
# Revision 1.4.2.1 2006/09/26 16:05:05 toins
# adding missing template & fix wrong link on scripts.
#
# Revision 1.4 2006/07/27 13:52:49 toins
# 1 sub renamed and cleaned.
#
# Revision 1.3 2006/07/21 10:12:00 toins
# subs renamed according to coding guidelines.
#
# Revision 1.2 2006/07/12 17:17:12 toins
# getitemtypes renamed to GetItemTypes
#
# Revision 1.1 2006/01/17 16:40:54 tipaul
# moving acqui.simple directory to cataloguing, as acqui.simple contains cataloguing scripts...
#
# Revision 1.8 2005/10/26 09:11:34 tipaul
# big commit, still breaking things...
#
# * synch with rel_2_2. Probably the last non manual synch, as rel_2_2 should not be modified deeply.
# * code cleaning (cleaning warnings from perl -w) continued
#
# Revision 1.4.2.1 2005/03/25 12:52:44 tipaul
# needs "editcatalogue" flag, not "catalogue"
#
# Revision 1.4 2004/11/19 16:41:49 tipaul
# improving behaviour when MARC=OFF
#
# Revision 1.3 2004/08/13 16:37:25 tipaul
# adding frameworkcode to API in some subs
#
# Revision 1.2 2003/05/11 06:59:11 rangi
# Mostly templated.
# Still needs some work
#
use CGI;
use strict;
use C4::Biblio;
use C4::Koha;
use C4::Output;
use C4::Branch; # GetBranches
use C4::Auth;
use C4::Interface::CGI::Output;
my $input = new CGI;
my $biblionumber = $input->param('biblionumber');
my $error = $input->param('error');
my $maxbarcode;
my $isbn;
my $bibliocount;
my @biblios;
my $biblioitemcount;
my @biblioitems;
# my @branches;
# my %branchnames;
my $itemcount;
my @items;
if ( !$biblionumber ) {
print $input->redirect('/cgi-bin/koha/cataloguing/addbooks.pl');
}
else {
my $input = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "cataloguing/additem-nomarc.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1 },
debug => 1,
}
);
( $bibliocount, @biblios ) = &GetBiblio($biblionumber);
if ( !$bibliocount ) {
print $input->redirect('addbooks.pl');
}
else {
@biblioitems = &GetBiblioItemByBiblioNumber($biblionumber);
$biblioitemcount = scalar @biblioitems;
my $branches = GetBranches;
my @branchloop;
foreach my $thisbranch (sort keys %$branches) {
my %row =(value => $thisbranch,
branchname => $branches->{$thisbranch}->{'branchname'},
);
push @branchloop, \%row;
}
my $itemtypes = &GetItemTypes;
my @itemtypeloop;
foreach my $thisitemtype (sort keys %$itemtypes) {
my %row =(value => $thisitemtype,
description => $itemtypes->{$thisitemtype}->{'description'},
);
push @itemtypeloop, \%row;
}
if ( $error eq "nobarcode" ) {
$template->param( NOBARCODE => 1 );
}
elsif ( $error eq "nobiblioitem" ) {
$template->param( NOBIBLIOITEM => 1 );
}
elsif ( $error eq "barcodeinuse" ) {
$template->param( BARCODEINUSE => 1 );
} # elsif
for ( my $i = 0 ; $i < $biblioitemcount ; $i++ ) {
if ( $biblioitems[$i]->{'itemtype'} eq "WEB" ) {
$biblioitems[$i]->{'WEB'} = 1;
}
$biblioitems[$i]->{'dewey'} =~ /(\d*\.\d\d)/;
$biblioitems[$i]->{'dewey'} = $1;
( $itemcount, @items ) = &getitemsbybiblioitem( $biblioitems[$i]->{'biblioitemnumber'} );
$biblioitems[$i]->{'items'} = \@items;
} # for
$template->param(
BIBNUM => $biblionumber,
AUTHOR => $biblios[0]->{'author'},
TITLE => $biblios[0]->{'title'},
COPYRIGHT => $biblios[0]->{'copyrightdate'},
SERIES => $biblios[0]->{'seriestitle'},
NOTES => $biblios[0]->{'notes'},
BIBITEMS => \@biblioitems,
branchloop => \@branchloop,
itemtypeloop => \@itemtypeloop,
( $bibliocount, @biblios ) = &GetBiblio($biblionumber);
if ( !$bibliocount ) {
print $input->redirect('addbooks.pl');
}
else {
@biblioitems =&GetBiblioItemByBiblioNumber($biblionumber);
$biblioitemcount = scalar @biblioitems;
@branches = &GetBranches;
( $itemtypecount, @itemtypes ) = &GetItemTypes;
for ( my $i = 0 ; $i < $itemtypecount ; $i++ ) {
$itemtypedescriptions{ $itemtypes[$i]->{'itemtype'} } =
$itemtypes[$i]->{'description'};
} # for
for ( my $i = 0 ; $i < $#branches ; $i++ ) {
$branchnames{ $branches[$i]->{'branchcode'} } =
$branches[$i]->{'branchname'};
} # for
# print $input->header;
# print startpage();
# print startmenu('acquisitions');
my $input = new CGI;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "cataloguing/additem-nomarc.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1 },
debug => 1,
}
);
if ( $error eq "nobarcode" ) {
$template->param( NOBARCODE => 1 );
}
elsif ( $error eq "nobiblioitem" ) {
$template->param( NOBIBLIOITEM => 1 );
}
elsif ( $error eq "barcodeinuse" ) {
$template->param( BARCODEINUSE => 1 );
} # elsif
for ( my $i = 0 ; $i < $biblioitemcount ; $i++ ) {
if ( $biblioitems[$i]->{'itemtype'} eq "WEB" ) {
$biblioitems[$i]->{'WEB'} = 1;
}
$biblioitems[$i]->{'dewey'} =~ /(\d*\.\d\d)/;
$biblioitems[$i]->{'dewey'} = $1;
( $itemcount, @items ) =
&getitemsbybiblioitem( $biblioitems[$i]->{'biblioitemnumber'} );
$biblioitems[$i]->{'items'} = \@items;
} # for
$template->param(
BIBNUM => $biblionumber,
AUTHOR => $biblios[0]->{'author'},
TITLE => $biblios[0]->{'title'},
COPYRIGHT => $biblios[0]->{'copyrightdate'},
SERIES => $biblios[0]->{'seriestitle'},
NOTES => $biblios[0]->{'notes'},
BIBITEMS => \@biblioitems,
BRANCHES => \@branches,
ITEMTYPES => \@itemtypes,
);
output_html_with_http_headers $input, $cookie, $template->output;
} # if
} # if

39
cataloguing/plugin_launcher.pl

@ -0,0 +1,39 @@
#!/usr/bin/perl
# $Id$
# 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;
my $input = new CGI;
my $plugin_name=$input->param("plugin_name");
my $plugin_name="cataloguing/value_builder/".$input->param("plugin_name");
# opening plugin. Just check wether we are on a developper computer on a production one
# (the cgidir differs)
my $cgidir = C4::Context->intranetdir ."/cgi-bin";
unless (opendir(DIR, "$cgidir/cataloguing/value_builder")) {
$cgidir = C4::Context->intranetdir;
}
do $cgidir."/".$plugin_name;
&plugin($input);

53
cataloguing/savebiblio.pl

@ -0,0 +1,53 @@
#!/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 CGI;
use strict;
use C4::Biblio;
my $input = new CGI;
my $biblio = {
title => $input->param('title'),
subtitle => $input->param('subtitle') ? $input->param('subtitle') : "",
author => $input->param('author') ? $input->param('author') : "",
seriestitle => $input->param('seriestitle') ? $input->param('seriestitle')
: "",
copyrightdate => $input->param('copyrightdate')
? $input->param('copyrightdate')
: "",
abstract => $input->param('abstract') ? $input->param('abstract') : "",
notes => $input->param('notes') ? $input->param('notes') : ""
}; # my $biblio
my $subjectheadings = $input->param('subjectheadings');
# Different O.S.es use different codes to end lines. This ensures that all cases
# are allowed for.
my @subjects = split ( /\n|\r|\n\r|\r\n/, $subjectheadings );
my $biblionumber;
my $aauthors = $input->param('additionalauthors');
my @authors = split ( /\n|\r|\n\r|\r\n/, $aauthors );
my $force = $input->param('force');
if ( !$biblio->{'title'} ) {
print $input->redirect('addbiblio-nomarc.pl?error=notitle');
}
else {
$biblionumber = &newbiblio($biblio);
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber");
} # else

95
cataloguing/saveitem.pl

@ -0,0 +1,95 @@
#!/usr/bin/perl
# $Id$
# 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 CGI;
use strict;
# use C4::Catalogue;
use C4::Biblio;
my $input = new CGI;
my $barcode = $input->param('barcode');
my $biblionumber = $input->param('biblionumber');
my $biblioitemnumber = $input->param('biblioitemnumber');
my $item = {
biblionumber => $biblionumber,
biblioitemnumber => $biblioitemnumber?$biblioitemnumber:"",
homebranch => $input->param('homebranch'),
holdingbranch => $input->param('homebranch'),
replacementprice => $input->param('replacementprice')?$input->param('replacementprice'):"",
itemnotes => $input->param('notes')?$input->param('notes'):""
}; # my $item
my $biblioitem = {
biblionumber => $biblionumber,
itemtype => $input->param('itemtype'),
isbn => $input->param('isbn')?$input->param('isbn'):"",
publishercode => $input->param('publishercode')?$input->param('publishercode'):"",
publicationyear => $input->param('publicationyear')?$input->param('publicationyear'):"",
place => $input->param('place')?$input->param('place'):"",
illus => $input->param('illus')?$input->param('illus'):"",
url => $input->param('url')?$input->param('url'):"",
dewey => $input->param('dewey')?$input->param('dewey'):"",
subclass => $input->param('subclass')?$input->param('subclass'):"",
issn => $input->param('issn')?$input->param('issn'):"",
lccn => $input->param('lccn')?$input->param('lccn'):"",
volume => $input->param('volume')?$input->param('volume'):"",
number => $input->param('number')?$input->param('number'):"",
volumeddesc => $input->param('volumeddesc')?$input->param('volumeddesc'):"",
pages => $input->param('pages')?$input->param('pages'):"",
size => $input->param('size')?$input->param('size'):"",
notes => $input->param('itemnotes')?$input->param('itemnotes'):""
}; # my biblioitem
my $newgroup = 0;
my $website = 0;
my $count;
my @results;
if ($input->param('newgroup')) {
$newgroup = 1;
if ($biblioitem->{'itemtype'} eq "WEB") {
$website = 1;
} # if
} # if
if (! $biblionumber) {
print $input->redirect('addbooks.pl');
} elsif ((! $barcode) && (! $website)) {
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber&error=nobarcode");
} elsif ((! $newgroup) && (! $biblioitemnumber)) {
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber&error=nobiblioitem");
} else {
if ($website) {
&newbiblioitem($biblioitem);
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber");
} elsif (&checkitems(1,$barcode)) {
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber&error=barcodeinuse");
} else {
if ($newgroup) {
$biblioitemnumber = &newbiblioitem($biblioitem);
$item->{'biblioitemnumber'} = $biblioitemnumber;
} # if
&newitems($item, ($barcode));
print $input->redirect("additem-nomarc.pl?biblionumber=$biblionumber");
} # else
} # else

125
cataloguing/thesaurus_popup.pl

@ -0,0 +1,125 @@
#!/usr/bin/perl
# written 10/5/2002 by Paul
# build result field using bibliothesaurus table
# 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::Auth;
use CGI;
use C4::Context;
use C4::Output;
use C4::Authorities;
use C4::Interface::CGI::Output;
# get all the data ....
my %env;
my $input = new CGI;
my $result = $input->param('result');
my $search_string= $input->param('search_string');
$search_string = $result unless ($search_string);
my $op = $input->param('op');
my $id = $input->param('id');
my $category = $input->param('category');
my $index= $input->param('index');
my $insert = $input->param('insert');
my $nohierarchy = $input->param('nohierarchy'); # if 1, just show the last part of entry (Marseille). If 0, show everything (Europe -- France --Marseille)
my $dbh = C4::Context->dbh;
# make the page ...
#print $input->header;
if ($op eq "select") {
my $sti = $dbh->prepare("select father,stdlib from bibliothesaurus where id=?");
$sti->execute($id);
my ($father,$freelib_text) = $sti->fetchrow_array;
if (length($result)>0) {
if ($nohierarchy) {
$result .= "|$freelib_text";
} else {
$result .= "|$father $freelib_text";
}
} else {
if ($nohierarchy) {
$result = "$freelib_text";
} else {
$result = "$father $freelib_text";
}
}
}
if ($op eq "add") {
newauthority($dbh,$category,$insert,$insert,'',1,'');
$search_string=$insert;
}
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/thesaurus_popup.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# /search thesaurus terms starting by search_string
my @freelib;
my %stdlib;
my $select_list;
if ($search_string) {
# my $sti=$dbh->prepare("select id,freelib from bibliothesaurus where freelib like '".$search_string."%' and category ='$category'");
my $sti=$dbh->prepare("select id,freelib,father from bibliothesaurus where match (category,freelib) AGAINST (?) and category =?");
$sti->execute($search_string,$category);
while (my $line=$sti->fetchrow_hashref) {
if ($nohierarchy) {
$stdlib{$line->{'id'}} = "$line->{'freelib'}";
} else {
$stdlib{$line->{'id'}} = "$line->{'father'} $line->{'freelib'}";
}
push(@freelib,$line->{'id'});
}
$select_list= CGI::scrolling_list( -name=>'id',
-values=> \@freelib,
-default=> "",
-size=>1,
-multiple=>0,
-labels=> \%stdlib
);
}
my @x = SearchDeeper('',$category,$search_string);
#my @son;
#foreach (my $value @$x) {
# warn \@$x[$value]->{'stdlib'};
#}
my $dig_list= CGI::scrolling_list( -name=>'search_string',
-values=> \@x,
-default=> "",
-size=>1,
-multiple=>0,
);
$template->param(select_list => $select_list,
search_string => $search_string,
dig_list => $dig_list,
result => $result,
category => $category,
index => $index,
nohierarchy => $nohierarchy,
);
output_html_with_http_headers $input, $cookie, $template->output;

186
cataloguing/value_builder/labs_theses.pl

@ -0,0 +1,186 @@
#!/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;
require Exporter;
use CGI;
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Auth;
use C4::Output;
use C4::Koha;
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "328".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.f.field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=labs_theses.pl&cat_auth=LABTHE&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 328\",'width=700,height=700,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
my $dbh=C4::Context->dbh;
my $query = new CGI;
my $op = $query->param('op');
my $cat_auth=$query->param('cat_auth');
my $startfrom=$query->param('startfrom');
$startfrom=0 if(!defined $startfrom);
my ($template, $loggedinuser, $cookie);
my $resultsperpage;
my $search = $query->param('search');
if ($op eq "do_search") {
$resultsperpage= $query->param('resultsperpage');
$resultsperpage = 19 if(!defined $resultsperpage);
# my $upperlimit=$startfrom+$resultsperpage;
# builds tag and subfield arrays
my $strquery = "SELECT authorised_value, lib from authorised_values where category = ? and lib like ?";
# $strquery .= " LIMIT $startfrom,$upperlimit";
warn 'category : '.$cat_auth.' recherche :'.$search;
warn "$strquery";
$search=~s/\*/%/g;
my $sth = $dbh->prepare($strquery);
$sth->execute($cat_auth,$search);
$search=~s/%/\*/g;
my @results;
my $total;
while (my $data = $sth->fetchrow_hashref){
my $libjs=$data->{'lib'};
$libjs=~s#\'#\\\'#g;
my $authjs=$data->{'authorised_value'};
$authjs=~s#\'#\\\'#g;
push @results, {'libjs'=>$libjs,
'lib'=>$data->{'lib'},
'authjs'=>$authjs,
'auth_value'=>$data->{'authorised_value'}}
unless (($total<$startfrom) or ($total>$startfrom+$resultsperpage));
$total++;
}
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/labs_theses.tmpl",
query => $query,
type => 'intranet',
authnotrequired => 1,
debug => 1,
});
# multi page display gestion
my $displaynext=0;
my $displayprev=$startfrom;
if(($total - (($startfrom+1)*($resultsperpage))) > 0 ){
$displaynext = 1;
}
my @numbers = ();
if ($total>$resultsperpage)
{
for (my $i=1; (($i<$total/$resultsperpage+1) && ($i<16)); $i++)
{
my $highlight=0;
($startfrom==($i-1)) && ($highlight=1);
push @numbers, { number => $i,
highlight => $highlight ,
search=> $search,
startfrom => $resultsperpage*($i-1)};
}
}
my $from = $startfrom+1;
my $to;
if($total < (($startfrom+1)*$resultsperpage))
{
$to = $total;
} else {
$to = (($startfrom+1)*$resultsperpage);
}
$template->param(catresult => \@results,
cat_auth=>$cat_auth,
index => $query->param('index')."",
startfrom=> $startfrom,
displaynext=> $displaynext,
displayprev=> $displayprev,
resultsperpage => $resultsperpage,
startfromnext => $startfrom+$resultsperpage,
startfromprev => $startfrom-$resultsperpage,
search=>$search,
total=>$total,
from=>$from,
to=>$to,
numbers=>\@numbers,
resultlist=>1
);
} else {
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/labs_theses.tmpl",
query => $query,
type => "intranet",
authnotrequired => 1,
});
$template->param(
'search'=>$query->param('search'),
);
$template->param(
'index'=>''.$query->param('index')
) if ($query->param('index'));
warn 'index : '.$query->param('index');
$template->param(
'cat_auth'=>$cat_auth
) if ($cat_auth);
}
output_html_with_http_headers $query, $cookie, $template->output ;
}
1;

97
cataloguing/value_builder/marc21_field_003.pl

@ -0,0 +1,97 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "003".(int(rand(100000))+1);
# find today's date
my $org = C4::Context->preference('MARCOrgCode');
my $res = "
<script>
function Blur$function_name(index) {
//need this?
}
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '003') {
document.f.field_value[i].value = '$org';
}
}
return 0;
}
function Clic$function_name(subfield_managed) {
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
return "";
}
1;

119
cataloguing/value_builder/marc21_field_005.pl

@ -0,0 +1,119 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "210c".(int(rand(100000))+1);
# find today's date
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$year +=1900;
$mon +=1;
if (length($mon)==1) {
$mon = "0".$mon;
}
if (length($mday)==1) {
$mday = "0".$mday;
}
if (length($hour)==1) {
$hour = "0".$hour;
}
if (length($min)==1) {
$min = "0".$min;
}
if (length($sec)==1) {
$hour = "0".$sec;
}
my $date = "$year$mon$mday$hour$min$sec".".0";
my $res = "
<script>
function Blur$function_name(index) {
//need this?
}
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '005') {
document.f.field_value[i].value = '$date';
}
}
return 0;
}
function Clic$function_name(subfield_managed) {
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
return "";
}
1;

126
cataloguing/value_builder/marc21_field_006.pl

@ -0,0 +1,126 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_field_006.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_field_006.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = "a|||||r|||| 00| 0 " unless $result;
# $result = "a r 00 0 " unless $result;
my $f0 = substr($result,0,1);
my $f014 = substr($result,1,4);
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f710 = substr($result,7,4);
my $f11 = substr($result,11,1);
my $f12 = substr($result,12,1);
my $f13 = substr($result,13,1);
my $f14 = substr($result,14,1);
my $f15 = substr($result,15,1);
my $f16 = substr($result,16,1);
my $f17 = substr($result,17,1);
$template->param( index => $index,
f0 => $f0,
"f0$f0" => $f0,
f014 => $f014,
"f014$f014" => $f014,
f5 => $f5,
"f5$f5" => $f5,
f6 => $f6,
"f6$f6" => $f6,
f710 => $f710,
"f710$f710" => $f710,
f11 => $f11,
"f11$f11" => $f11,
f12 => $f12,
"f12$f12" => $f12,
f13 => $f13,
"f13$f13" => $f13,
f14 => $f14,
"f14$f14" => $f14,
f15 => $f15,
"f15$f15" => $f15,
f16 => $f16,
"f16$f16" => $f16,
f17 => $f17,
"f17$f17" => $f17,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

96
cataloguing/value_builder/marc21_field_007.pl

@ -0,0 +1,96 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_field_007.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_field_007.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = "ta" unless $result;
my $f0 = substr($result,0,1);
my $f1 = substr($result,1,4);
$template->param( index => $index,
f0 => $f0,
"f0$f0" => $f0,
f1 => $f1,
"f1$f1" => $f1,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

155
cataloguing/value_builder/marc21_field_008.pl

@ -0,0 +1,155 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
# find today's date
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year +=1900; $mon +=1;
my $dateentered = substr($year,2,2).sprintf ("%0.2d", $mon).sprintf ("%0.2d",$mday);
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '008') {
if (!document.f.field_value[i].value) {
document.f.field_value[i].value = '$dateentered' + 't xxu||||| |||| 00| 0 eng d';
}
}
}
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_field_008.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_field_008.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# $result = " t xxu 00 0 eng d" unless $result;
$result = "$dateentered"."t xxu||||| |||| 00| 0 eng d" unless $result;
my $f1 = substr($result,0,6);
my $f6 = substr($result,6,1);
my $f710 = substr($result,7,4);
my $f1114 = substr($result,11,4);
my $f1517 = substr($result,15,3);
my $f1821 = substr($result,18,4);
my $f22 = substr($result,22,1);
my $f23 = substr($result,23,1);
my $f2427 = substr($result,24,4);
my $f28 = substr($result,28,1);
my $f29 = substr($result,29,1);
my $f30 = substr($result,30,1);
my $f31 = substr($result,31,1);
my $f33 = substr($result,33,1);
my $f34 = substr($result,34,1);
my $f3537 = substr($result,35,3);
my $f38 = substr($result,38,1);
my $f39 = substr($result,39,1);
if ((!$f1) ||($f1 =~ m/ /)){
$f1=$dateentered;
}
$template->param( index => $index,
f1 => $f1,
f6 => $f6,
"f6$f6" => $f6,
f710 => $f710,
f1114 => $f1114,
f1517 => $f1517,
f1821 => $f1821,
f22 => $f22,
"f22$f22" => $f22,
f23 => $f23,
"f23$f23" => $f23,
f2427 => $f2427,
"f24$f2427" => $f2427,
f28 => $f28,
"f28$f28" => $f28,
f29 => $f29,
"f29$f29" => $f29,
f30 => $f30,
"f230$f30" => $f30,
f31 => $f31,
"f31$f31" => $f31,
f33 => $f33,
"f33$f33" => $f33,
f34 => $f34,
"f34$f34" => $f34,
f3537 => $f3537,
f38 => $f38,
"f38$f38" => $f38,
f39 => $f39,
"f39$f39" => $f39,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

151
cataloguing/value_builder/marc21_field_008_authorities.pl

@ -0,0 +1,151 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
# find today's date
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$year = substr($year,1,2);
$mon +=1;
my $date = "$year-$mon-$mday";
my $res = "";
if (length($mon)==1) {
$mon='0'.$mon;
}
if (length($mday)==1) {
$mday='0'.$mday;
}
my $dateentered = "$year$mon$mday";
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_field_008_authorities.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_field_008_authorities.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# $result = " t xxu 00 0 eng d" unless $result;
$result = " t xxu||||| |||| 00| 0 eng d" unless $result;
my $f6 = substr($result,6,1);
my $f710 = substr($result,7,4);
my $f1114 = substr($result,11,4);
my $f1517 = substr($result,15,3);
my $f1821 = substr($result,18,4);
my $f22 = substr($result,22,1);
my $f23 = substr($result,23,1);
my $f2427 = substr($result,24,4);
my $f28 = substr($result,28,1);
my $f29 = substr($result,29,1);
my $f30 = substr($result,30,1);
my $f31 = substr($result,31,1);
my $f33 = substr($result,33,1);
my $f34 = substr($result,34,1);
my $f3537 = substr($result,35,3);
my $f38 = substr($result,38,1);
my $f39 = substr($result,39,1);
$template->param( index => $index,
dateentered => $dateentered,
f6 => $f6,
"f6$f6" => $f6,
f710 => $f710,
f1114 => $f1114,
f1517 => $f1517,
f1821 => $f1821,
f22 => $f22,
"f22$f22" => $f22,
f23 => $f23,
"f23$f23" => $f23,
f2427 => $f2427,
"f24$f2427" => $f2427,
f28 => $f28,
"f28$f28" => $f28,
f29 => $f29,
"f29$f29" => $f29,
f30 => $f30,
"f230$f30" => $f30,
f31 => $f31,
"f31$f31" => $f31,
f33 => $f33,
"f33$f33" => $f33,
f34 => $f34,
"f34$f34" => $f34,
f3537 => $f3537,
f38 => $f38,
"f38$f38" => $f38,
f39 => $f39,
"f39$f39" => $f39,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

97
cataloguing/value_builder/marc21_field_040c.pl

@ -0,0 +1,97 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "003".(int(rand(100000))+1);
# find today's date
my $org = C4::Context->preference('MARCOrgCode');
my $res = "
<script>
function Blur$function_name(index) {
//need this?
}
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '040' && document.f.subfield[i].value == 'c') {
document.f.field_value[i].value = '$org';
}
}
return 0;
}
function Clic$function_name(subfield_managed) {
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
return "";
}
1;

97
cataloguing/value_builder/marc21_field_040d.pl

@ -0,0 +1,97 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "003".(int(rand(100000))+1);
# find today's date
my $org = C4::Context->preference('MARCOrgCode');
my $res = "
<script>
function Blur$function_name(index) {
//need this?
}
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '040' && document.f.subfield[i].value == 'd') {
document.f.field_value[i].value = '$org';
}
}
return 0;
}
function Clic$function_name(subfield_managed) {
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
return "";
}
1;

114
cataloguing/value_builder/marc21_leader.pl

@ -0,0 +1,114 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '000') {
if (!document.f.field_value[i].value) {
document.f.field_value[i].value = ' nam a22 7a 4500';
}
}
}
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_leader.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_leader.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " nam a22 7a 4500" unless $result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
my $f2023 = substr($result,20,4);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
"f2023" => $f2023,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

106
cataloguing/value_builder/marc21_leader_authorities.pl

@ -0,0 +1,106 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_leader_authorities.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_leader_authorities.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " nam 22 7a 4500" unless $result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
my $f2023 = substr($result,20,4);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
"f2023" => $f2023,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

107
cataloguing/value_builder/marc21_leader_book.pl

@ -0,0 +1,107 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_leader.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_leader.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " nam 7a " unless $result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
warn "F6".$f6;
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

108
cataloguing/value_builder/marc21_leader_computerfile.pl

@ -0,0 +1,108 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_leader.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_leader_computerfile.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " nmm 7a " unless $result;
warn "RESULT:".$result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
warn "F6".$f6;
my $f7 = substr($result,7,1);
warn "F7:".$f7;
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

106
cataloguing/value_builder/marc21_leader_video.pl

@ -0,0 +1,106 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=marc21_leader.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "value_builder/marc21_leader.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " ngm 7a " unless $result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
warn "F6".$f6;
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

130
cataloguing/value_builder/unimarc_field_100.pl

@ -0,0 +1,130 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ( $dbh, $record, $tagslib, $i, $tabloop ) = @_;
return "";
}
sub plugin_javascript {
my ( $dbh, $record, $tagslib, $field_number, $tabloop ) = @_;
my $function_name = "100" . ( int( rand(100000) ) + 1 );
my $res = "
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_100.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ( $function_name, $res );
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index = $input->param('index');
my $result = $input->param('result');
my $dbh = C4::Context->dbh;
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "cataloguing/value_builder/unimarc_field_100.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1 },
debug => 1,
}
);
$result = ' d u y0frey50 ba' unless $result;
my $f1 = substr( $result, 0, 8 );
if ( $f1 eq ' ' ) {
my @today = Date::Calc::Today();
$f1 = $today[0] . sprintf('%02s',$today[1]) . sprintf('%02s',$today[2]);
}
my $f2 = substr( $result, 8, 1 );
my $f3 = substr( $result, 9, 4 );
$f3='' if $f3 eq ' '; # empty publication year if only spaces, otherwise it's hard to fill the field
my $f4 = substr( $result, 13, 4 );
$f4='' if $f4 eq ' ';
my $f5 = substr( $result, 17, 1 );
my $f6 = substr( $result, 18, 1 );
my $f7 = substr( $result, 19, 1 );
my $f8 = substr( $result, 20, 1 );
my $f9 = substr( $result, 21, 1 );
my $f10 = substr( $result, 22, 3 );
my $f11 = substr( $result, 25, 1 );
my $f12 = substr( $result, 26, 2 );
my $f13 = substr( $result, 28, 2 );
my $f14 = substr( $result, 30, 4 );
my $f15 = substr( $result, 34, 2 );
$template->param(
index => $index,
f1 => $f1,
f3 => $f3,
"f2$f2" => 1,
f4 => $f4,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10" => $f10,
"f11$f11" => 1,
"f12$f12" => 1,
"f13$f13" => 1,
"f14" => $f14,
"f15$f15" => 1
);
print $input->header( -cookie => $cookie ), $template->output;
}
1;

114
cataloguing/value_builder/unimarc_field_105.pl

@ -0,0 +1,114 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "105".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_105.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 105\",'width=1200,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_105.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,1);
my $f9 = substr($result,8,1);
my $f10 = substr($result,9,1);
my $f11 = substr($result,10,1);
my $f12 = substr($result,11,1);
my $f13 = substr($result,12,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1,
"f11$f11" => 1,
"f12$f12" => 1,
"f13$f13" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_106.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "106".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_106.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 106\",'width=500,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
warn ("Je suis quand meme ici\n");
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_106.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => $f1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

104
cataloguing/value_builder/unimarc_field_110.pl

@ -0,0 +1,104 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "110".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_110.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 110\",'width=700,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_110.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,3);
my $f6 = substr($result,7,1);
my $f7 = substr($result,8,1);
my $f8 = substr($result,9,1);
my $f9 = substr($result,10,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
f5 => $f5,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

122
cataloguing/value_builder/unimarc_field_115a.pl

@ -0,0 +1,122 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "115a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_115a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 115a\",'width=1200,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_115a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,1);
my $f4 = substr($result,5,1);
my $f5 = substr($result,6,1);
my $f6 = substr($result,7,1);
my $f7 = substr($result,8,1);
my $f8 = substr($result,9,1);
my $f9 = substr($result,10,1);
my $f10 = substr($result,11,1);
my $f11 = substr($result,12,1);
my $f12 = substr($result,13,1);
my $f13 = substr($result,14,1);
my $f14 = substr($result,15,1);
my $f15 = substr($result,16,1);
my $f16 = substr($result,17,1);
my $f17 = substr($result,18,1);
my $f18 = substr($result,19,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2" => $f2,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1,
"f11$f11" => 1,
"f12$f12" => 1,
"f13$f13" => 1,
"f14$f14" => 1,
"f15$f15" => 1,
"f16$f16" => 1,
"f17$f17" => 1,
"f18$f18" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

108
cataloguing/value_builder/unimarc_field_115b.pl

@ -0,0 +1,108 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "115b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_115b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 115b\",'width=1200,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_115b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,1);
my $f9 = substr($result,8,1);
my $f10 = substr($result,9,4);
my $f11 = substr($result,13,2);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10" => $f10,
"f11" => $f11
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

111
cataloguing/value_builder/unimarc_field_116.pl

@ -0,0 +1,111 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "116".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_116.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 116\",'width=1200,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_116.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,2);
my $f6 = substr($result,6,2);
my $f7 = substr($result,8,2);
my $f8 = substr($result,10,2);
my $f9 = substr($result,12,2);
my $f10 = substr($result,14,2);
my $f11 = substr($result,16,2);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1,
"f11$f11" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

97
cataloguing/value_builder/unimarc_field_117.pl

@ -0,0 +1,97 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "117".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_117.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 117\",'width=600,height=225,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_117.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
my $f2 = substr($result,2,2);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
my $f5 = substr($result,8,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

106
cataloguing/value_builder/unimarc_field_120.pl

@ -0,0 +1,106 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "120".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_120.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 120\",'width=1200,height=750,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_120.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,2);
my $f9 = substr($result,9,2);
my $f10 = substr($result,11,2);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

102
cataloguing/value_builder/unimarc_field_121a.pl

@ -0,0 +1,102 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "121a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_121a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 121a\",'width=1210,height=750,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_121a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,2);
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => $f8);
print $input->header(-cookie => $cookie),$template->output;
}
1;

100
cataloguing/value_builder/unimarc_field_121b.pl

@ -0,0 +1,100 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "121b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_121b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 121b\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_121b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,2);
my $f4 = substr($result,4,1);
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f7 = substr($result,7,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
f3 => $f3,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

96
cataloguing/value_builder/unimarc_field_122.pl

@ -0,0 +1,96 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "122".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_122.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 122\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_122.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,4);
my $f3 = substr($result,5,2);
my $f4 = substr($result,7,2);
my $f5 = substr($result,9,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4,
f5 => $f5);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_123a.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123a\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => $f1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123d.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123g".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123g.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123g\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123g.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123e.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123g".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123g.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123g\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123g.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123f.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123g".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123g.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123g\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123g.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123g.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123g".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123g.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123g\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123g.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123i.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123i".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123i.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123i\",'width=800,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123i.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_123j.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "123j".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_123j.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 123j\",'width=800,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_123j.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,3);
my $f3 = substr($result,4,2);
my $f4 = substr($result,6,2);
$template->param(index => $index,
"f1$f1" => 1,
f2 => $f2,
f3 => $f3,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_124.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_100.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=500,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_100.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,8);
my $f2 = substr($result,8,1);
my $f3 = substr($result,9,4);
my $f4 = substr($result,13,4);
$template->param(index => $index,
f1 => $f1,
f3 => $f3,
"f2$f2" => 1,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124a.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124a\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124b.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124b\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124c.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124c".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124c.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124c\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124c.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124d.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124d".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124d.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124d\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124d.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124e.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124e".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124e.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124e\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124e.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124f.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124f".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124f.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124f\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124f.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_124g.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "124g".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_124g.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 124g\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_124g.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_125.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_100.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=500,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_100.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,8);
my $f2 = substr($result,8,1);
my $f3 = substr($result,9,4);
my $f4 = substr($result,13,4);
$template->param(index => $index,
f1 => $f1,
f3 => $f3,
"f2$f2" => 1,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

89
cataloguing/value_builder/unimarc_field_125a.pl

@ -0,0 +1,89 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "125a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_125a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 125a\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_125a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
$template->param(index => $index,
"f1$f1" => 1,"f2$f2" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_125b.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "125b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_125b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 125b\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_125b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

94
cataloguing/value_builder/unimarc_field_126.pl

@ -0,0 +1,94 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms[0].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_100.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=500,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_100.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,8);
my $f2 = substr($result,8,1);
my $f3 = substr($result,9,4);
my $f4 = substr($result,13,4);
$template->param(index => $index,
f1 => $f1,
f3 => $f3,
"f2$f2" => 1,
f4 => $f4);
print $input->header(-cookie => $cookie),$template->output;
}
1;

117
cataloguing/value_builder/unimarc_field_126a.pl

@ -0,0 +1,117 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "126a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_126a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 126a\",'width=1000,height=575,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_126a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,1);
my $f9 = substr($result,8,1);
my $f10 = substr($result,9,1);
my $f11 = substr($result,10,1);
my $f12 = substr($result,11,1);
my $f13 = substr($result,12,1);
my $f14 = substr($result,13,1);
my $f15 = substr($result,14,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1,
"f11$f11" => 1,
"f12$f12" => 1,
"f13$f13" => 1,
"f14$f14" => 1,
"f15$f15" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

93
cataloguing/value_builder/unimarc_field_126b.pl

@ -0,0 +1,93 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "126b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_126b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 126b\",'width=1000,height=575,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_126b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

92
cataloguing/value_builder/unimarc_field_127.pl

@ -0,0 +1,92 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "127".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_127.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 127\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_127.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
my $f2 = substr($result,2,2);
my $f3 = substr($result,4,2);
$template->param(index => $index,
"f1" => $f1,
f2 => $f2,
f3 => $f3);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_128a.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "128a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_128a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 128a\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_128a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_128b.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "128b".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_128b.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 128b\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_128b.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

88
cataloguing/value_builder/unimarc_field_128c.pl

@ -0,0 +1,88 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "128c".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_128c.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 128c\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_128c.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,2);
$template->param(index => $index,
"f1$f1" => 1);
print $input->header(-cookie => $cookie),$template->output;
}
1;

107
cataloguing/value_builder/unimarc_field_130.pl

@ -0,0 +1,107 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "130".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_130.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 130\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_130.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,3);
my $f6 = substr($result,7,1);
my $f7 = substr($result,8,1);
my $f8 = substr($result,9,1);
my $f9 = substr($result,10,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5" => $f5,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

107
cataloguing/value_builder/unimarc_field_135a.pl

@ -0,0 +1,107 @@
#!/usr/bin/perl
# $Id$
# 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-135a7 USA
use strict;
use C4::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "135a".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_135a.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 135a\",'width=1000,height=375,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_135a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,3);
my $f6 = substr($result,7,1);
my $f7 = substr($result,8,1);
my $f8 = substr($result,9,1);
my $f9 = substr($result,10,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5" => $f5,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

132
cataloguing/value_builder/unimarc_field_140.pl

@ -0,0 +1,132 @@
#!/usr/bin/perl
# $Id$
# 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-1407 USA
use strict;
use C4::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "140".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_140.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 140\",'width=1000,height=575,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_140.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,1);
my $f9 = substr($result,8,1);
my $f10 = substr($result,9,2);
my $f11 = substr($result,11,2);
my $f12 = substr($result,13,2);
my $f13 = substr($result,15,2);
my $f14 = substr($result,17,2);
my $f15 = substr($result,19,1);
my $f16 = substr($result,20,1);
my $f17 = substr($result,21,1);
my $f18 = substr($result,22,1);
my $f19 = substr($result,23,1);
my $f20 = substr($result,24,1);
my $f21 = substr($result,25 ,1);
warn "Dans ce cas clea nous fait un f17 => $f17\n";
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f10$f10" => 1,
"f11$f11" => 1,
"f12$f12" => 1,
"f13$f13" => 1,
"f14$f14" => 1,
"f15$f15" => 1,
"f16$f16" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
"f20$f20" => 1,
"f21$f21" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

104
cataloguing/value_builder/unimarc_field_141.pl

@ -0,0 +1,104 @@
#!/usr/bin/perl
# $Id$
# 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-1417 USA
use strict;
use C4::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "141".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_141.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 141\",'width=1000,height=575,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_141.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
my $f1 = substr($result,0,1);
my $f2 = substr($result,1,1);
my $f3 = substr($result,2,1);
my $f4 = substr($result,3,1);
my $f5 = substr($result,4,1);
my $f6 = substr($result,5,1);
my $f7 = substr($result,6,1);
my $f8 = substr($result,7,1);
$template->param(index => $index,
"f1$f1" => 1,
"f2$f2" => 1,
"f3$f3" => 1,
"f4$f4" => 1,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

254
cataloguing/value_builder/unimarc_field_210c.pl

@ -0,0 +1,254 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "210c".(int(rand(100000))+1);
#---- build editors list.
#---- the editor list is built from the "EDITORS" thesaurus
#---- this thesaurus category must be filled as follow :
#---- 200$a for isbn
#---- 200$b for editor
#---- 200$c (repeated) for collections
my $sth = $dbh->prepare("select auth_subfield_table.authid,subfieldvalue from auth_subfield_table
left join auth_header on auth_subfield_table.authid=auth_header.authid
where authtypecode='EDITORS' and tag='200' and subfieldcode='a'");
my $sth2 = $dbh->prepare("select subfieldvalue from auth_subfield_table where tag='200' and subfieldcode='b' and authid=?");
$sth->execute;
my @editors;
my $authoritysep = C4::Context->preference("authoritysep");
while (my ($authid,$isbn) = $sth->fetchrow) {
$sth2->execute($authid);
my ($editor) = $sth2->fetchrow;
push(@editors,"$isbn $authoritysep $editor");
}
my $res = "
<script type=\"text/javascript\">
function Focus$function_name(index) {
var isbn_array = [ ";
foreach my $editor (@editors) {
my @arr = split (/ $authoritysep /,$editor);
$res .='["'.$arr[0].'","'.$arr[1].'","'.$arr[2].'"],';
}
chop $res;
$res .= "
];
// search isbn subfield. it''s 010a
var isbn_found;
var nb_fields = document.f.field_value.length;
for (i=0 ; i< nb_fields; i++) {
if (document.f.tag[i].value == '010' && document.f.subfield[i].value == 'a') {
isbn_found=document.f.field_value[i].value;
break;
}
}
try{
isbn_found.getAttribute('value'); // throw an exception if doesn't (if no 010a)
}
catch(e){
return;
}
for (i=0;i<=isbn_array.length;i++) {
if (isbn_found.substr(0,isbn_array[i][0].length) == isbn_array[i][0]) {
document.f.field_value[index].value =isbn_array[i][1];
}
}
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(subfield_managed) {
defaultvalue=escape(document.forms['f'].field_value[subfield_managed].value);
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_210c.pl&index=\"+subfield_managed,\"unimarc 225a\",'width=500,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
my $index = $input->param("index");
my $result = $input->param("result");
my $query=new CGI;
my $op = $query->param('op');
my $authtypecode = $query->param('authtypecode');
my $index = $query->param('index');
my $category = $query->param('category');
my $resultstring = $query->param('result');
my $dbh = C4::Context->dbh;
my $startfrom=$query->param('startfrom');
$startfrom=0 if(!defined $startfrom);
my ($template, $loggedinuser, $cookie);
my $resultsperpage;
my $authtypes = getauthtypes;
my @authtypesloop;
foreach my $thisauthtype (keys %$authtypes) {
my $selected = 1 if $thisauthtype eq $authtypecode;
my %row =(value => $thisauthtype,
selected => $selected,
authtypetext => $authtypes->{$thisauthtype}{'authtypetext'},
index => $index,
);
push @authtypesloop, \%row;
}
if ($op eq "do_search") {
my @marclist = $query->param('marclist');
my @and_or = $query->param('and_or');
my @excluding = $query->param('excluding');
my @operator = $query->param('operator');
my @value = $query->param('value');
$resultsperpage= $query->param('resultsperpage');
$resultsperpage = 19 if(!defined $resultsperpage);
# builds tag and subfield arrays
my @tags;
my ($results,$total) = authoritysearch($dbh, \@tags,\@and_or,
\@excluding, \@operator, \@value,
$startfrom*$resultsperpage, $resultsperpage,$authtypecode);# $orderby);
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_210c.tmpl",
query => $query,
type => 'intranet',
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# multi page display gestion
my $displaynext=0;
my $displayprev=$startfrom;
if(($total - (($startfrom+1)*($resultsperpage))) > 0 ) {
$displaynext = 1;
}
my @numbers = ();
if ($total>$resultsperpage) {
for (my $i=1; $i<$total/$resultsperpage+1; $i++) {
if ($i<16) {
my $highlight=0;
($startfrom==($i-1)) && ($highlight=1);
push @numbers, { number => $i,
highlight => $highlight ,
startfrom => ($i-1)};
}
}
}
my $from = $startfrom*$resultsperpage+1;
my $to;
if($total < (($startfrom+1)*$resultsperpage)) {
$to = $total;
} else {
$to = (($startfrom+1)*$resultsperpage);
}
$template->param(result => $results) if $results;
$template->param(index => $query->param('index'));
$template->param(startfrom=> $startfrom,
displaynext=> $displaynext,
displayprev=> $displayprev,
resultsperpage => $resultsperpage,
startfromnext => $startfrom+1,
startfromprev => $startfrom-1,
index => $index,
total=>$total,
from=>$from,
to=>$to,
numbers=>\@numbers,
authtypecode =>$authtypecode,
resultstring =>$value[0],
);
} else {
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_210c.tmpl",
query => $query,
type => 'intranet',
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$template->param(index => $index,
resultstring => $resultstring
);
}
$template->param(authtypesloop => \@authtypesloop);
$template->param(category => $category);
# Print the page
output_html_with_http_headers $query, $cookie, $template->output;
}
1;

161
cataloguing/value_builder/unimarc_field_225a.pl

@ -0,0 +1,161 @@
#!/usr/bin/perl
# $Id$
# 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 SYNOPSIS
This plugin is used to map isbn/editor with collection.
It need :
in thesaurus, a category named EDITORS
in this category, datas must be entered like following :
isbn separator editor separator collection.
for example :
2204 -- Cerf -- Cogitatio fidei
2204 -- Cerf -- Le Magistère de l'Eglise
2204 -- Cerf -- Lectio divina
2204 -- Cerf -- Lire la Bible
2204 -- Cerf -- Pour lire
2204 -- Cerf -- Sources chrétiennes
when the user clic on ... on 225a line, the popup shows the list of collections from the selected editor
if the biblio has no isbn, then the search if done on editor only
If the biblio ha an isbn, the search is done on isbn and editor. It's faster.
=over 2
=cut
use strict;
use C4::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(index) {
// find the 010a value and the 210c. it will be used in the popup to find possibles collections
var isbn_found;
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '010' && document.f.subfield[i].value == 'a') {
isbn_found=document.f.field_value[i].value;
}
}
var editor_found;
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '210' && document.f.subfield[i].value == 'c') {
editor_found=document.f.field_value[i].value;
}
}
defaultvalue=document.f.field_value[index].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_225a.pl&index=\"+index+\"&result=\"+defaultvalue+\"&isbn_found=\"+isbn_found+\"&editor_found=\"+editor_found,\"unimarc 225a\",'width=500,height=200,toolbar=false,scrollbars=no');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $editor_found = $input->param('editor_found');
my $isbn_found = $input->param('isbn_found');
my $dbh = C4::Context->dbh;
my $authoritysep = C4::Context->preference("authoritysep");
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_225a.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# builds collection list : search isbn and editor, in parent, then load collections from bibliothesaurus table
# if there is an isbn, complete search
my @collections;
if ($isbn_found) {
my $sth = $dbh->prepare("select auth_subfield_table.authid,subfieldvalue from auth_subfield_table
left join auth_header on auth_subfield_table.authid=auth_header.authid
where authtypecode='EDITORS' and tag='200' and subfieldcode='a' and subfieldvalue=?");
my $sth2 = $dbh->prepare("select subfieldvalue from auth_subfield_table where tag='200' and subfieldcode='c' and authid=? order by subfieldvalue");
my @splited = split //, $isbn_found;
my $isbn_rebuild='';
foreach my $x (@splited) {
$isbn_rebuild.=$x;
$sth->execute($isbn_rebuild);
my ($authid) = $sth->fetchrow;
$sth2->execute($authid);
while (my ($line)= $sth2->fetchrow) {
push @collections,$line;
}
}
} else {
my $sth = $dbh->prepare("select auth_subfield_table.authid,subfieldvalue from auth_subfield_table
left join auth_header on auth_subfield_table.authid=auth_header.authid
where authtypecode='EDITORS' and tag='200' and subfieldcode='b' and subfieldvalue=?");
my $sth2 = $dbh->prepare("select subfieldvalue from auth_subfield_table where tag='200' and subfieldcode='c' and authid=? order by subfieldvalue");
$sth->execute($editor_found);
my ($authid) = $sth->fetchrow;
$sth2->execute($authid);
while (my ($line)= $sth2->fetchrow) {
push @collections,$line;
}
}
# my @collections = ["test"];
my $collection =CGI::scrolling_list(-name=>'f1',
-values=> \@collections,
-default=>"$result",
-size=>1,
-multiple=>0,
);
$template->param(index => $index,
collection => $collection);
print $input->header(-cookie => $cookie),$template->output;
}
1;

386
cataloguing/value_builder/unimarc_field_4XX.pl

@ -0,0 +1,386 @@
#!/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;
require Exporter;
use CGI;
use C4::Interface::CGI::Output;
use C4::Context;
use C4::Search;
use C4::Auth;
use C4::Output;
use C4::Biblio;
use C4::Koha;
use MARC::Record;
use C4::Branch; # GetBranches
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "4XX".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.f.field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_4XX.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 4\"+i+\"\",'width=700,height=700,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
my $dbh=C4::Context->dbh;
my $query = new CGI;
my $op = $query->param('op');
my $type=$query->param('type');
# warn "operation ".$op;
my $startfrom=$query->param('startfrom');
$startfrom=0 if(!defined $startfrom);
my ($template, $loggedinuser, $cookie);
my $resultsperpage;
my $searchdesc;
if ($op eq "fillinput"){
my $bibnum = $query->param('bibnum');
my $index = $query->param('index');
my $marcrecord;
# open template
($template, $loggedinuser, $cookie)= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_4XX.tmpl",
query => $query,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
#get marc record
$marcrecord = GetMarcBiblio($bibnum);
my $subfield_value_9=$bibnum;
my $subfield_value_0;
$subfield_value_0=$marcrecord->field('001')->data if $marcrecord->field('001');
my $subfield_value_a;
if ($marcrecord->field('700')){
$subfield_value_a=$marcrecord->field('700')->subfield("a");
$subfield_value_a.=", ".$marcrecord->subfield('700',"b") if $marcrecord->subfield('700','b');
$subfield_value_a.=" ".$marcrecord->subfield('700',"d") if $marcrecord->subfield('700','d');
$subfield_value_a.=" (".$marcrecord->subfield('700','c')." - " if $marcrecord->subfield('700','c');
$subfield_value_a.=" (" if ($marcrecord->subfield('700','f') and not( $marcrecord->subfield('700','c')));
$subfield_value_a.=$marcrecord->subfield('700','f') if ($marcrecord->subfield('700','f'));
$subfield_value_a.=")" if ($marcrecord->subfield('701','f') or $marcrecord->subfield('701','c'));
} elsif ($marcrecord->field('702')){
$subfield_value_a=$marcrecord->subfield('702','a');
$subfield_value_a.=", ".$marcrecord->subfield('702','b') if $marcrecord->subfield('702','b');
$subfield_value_a.=" ".$marcrecord->subfield('702','d') if $marcrecord->subfield('702','d');
$subfield_value_a.=" (".$marcrecord->subfield('702','c')."; " if $marcrecord->subfield('702','c');
$subfield_value_a.=" (" if $marcrecord->subfield('702','f') and not $marcrecord->subfield('702','c');
$subfield_value_a.=$marcrecord->subfield('702','f') if $marcrecord->subfield('702','f');
$subfield_value_a.=")" if $marcrecord->subfield('702','f') or $marcrecord->subfield('702','c');
} elsif ($marcrecord->field('710')){
$subfield_value_a=$marcrecord->subfield('710','d')." " if $marcrecord->subfield('710','d');
$subfield_value_a.=$marcrecord->subfield('710','a') if $marcrecord->subfield('710','a');
$subfield_value_a.=", ".$marcrecord->subfield('710','b') if $marcrecord->subfield('710');
$subfield_value_a.=" (".$marcrecord->subfield('710','f')." - " if $marcrecord->subfield('710','f');
$subfield_value_a.=" (" if $marcrecord->subfield('710','e') and not $marcrecord->subfield('710','f');
$subfield_value_a.=$marcrecord->subfield('710','e') if $marcrecord->subfield('710','e');
$subfield_value_a.=")" if $marcrecord->subfield('710','e') or $marcrecord->subfield('710','f');
} elsif ($marcrecord->field('701')){
$subfield_value_a=$marcrecord->subfield('701','a');
$subfield_value_a.=", ".$marcrecord->subfield('701','b') if $marcrecord->subfield('701','b');
$subfield_value_a.=" ".$marcrecord->subfield('701','d',) if $marcrecord->subfield('701','d');
$subfield_value_a.=" (".$marcrecord->subfield('701','c')." - " if $marcrecord->subfield('701','c');
$subfield_value_a.=" (" if $marcrecord->subfield('701','f') and not( $marcrecord->subfield('701','c'));
$subfield_value_a.=$marcrecord->subfield('701','f') if $marcrecord->subfield('701','f');
$subfield_value_a.=")" if $marcrecord->subfield('701','f') or $marcrecord->subfield('701','c');
} elsif ($marcrecord->field('712')){
$subfield_value_a=$marcrecord->subfield('712','d')." " if $marcrecord->subfield('712','d');
$subfield_value_a.=$marcrecord->subfield('712','a') if $marcrecord->subfield('712','a');
$subfield_value_a.=", ".$marcrecord->subfield('712','b') if $marcrecord->subfield('712','b');
$subfield_value_a.=" (".$marcrecord->subfield('712','f')." - " if $marcrecord->subfield('712','f');
$subfield_value_a.=" (" if $marcrecord->field('712',"e") and not $marcrecord->subfield('712','f');
$subfield_value_a.=$marcrecord->subfield('712','e') if $marcrecord->subfield('712','e');
$subfield_value_a.=")" if $marcrecord->subfield('712','e') or $marcrecord->subfield('712','f');
} elsif ($marcrecord->field('200')){
$subfield_value_a=$marcrecord->subfield('200','f');
}
my $subfield_value_c = $marcrecord->field('210')->subfield("a") if ($marcrecord->field('210'));
my $subfield_value_d = $marcrecord->field('210')->subfield("d") if ($marcrecord->field('210'));
my $subfield_value_e= $marcrecord->field('205')->subfield("a") if ($marcrecord->field('205'));
my $subfield_value_h;
if (($marcrecord->field('200')) && ($marcrecord->field('200')->subfield("h"))){
$subfield_value_h = $marcrecord->field('200')->subfield("h") ;
} elsif (($marcrecord->field('225')) && ($marcrecord->field('225')->subfield("h"))) {
$subfield_value_h = $marcrecord->field('225')->subfield("h") ;
} elsif (($marcrecord->field('500')) && ($marcrecord->field('500')->subfield("h"))) {
$subfield_value_h = $marcrecord->field('500')->subfield("h") ;
}
my $subfield_value_i;
if (($marcrecord->field('200')) && ($marcrecord->field('200')->subfield("i"))){
$subfield_value_i = $marcrecord->field('200')->subfield("i") ;
} elsif (($marcrecord->field('225')) && ($marcrecord->field('225')->subfield("i"))) {
$subfield_value_i = $marcrecord->field('225')->subfield("i") ;
} elsif (($marcrecord->field('500')) && ($marcrecord->field('500')->subfield("i"))) {
$subfield_value_i = $marcrecord->field('500')->subfield("i") ;
}
my $subfield_value_p = $marcrecord->field('215')->subfield("a") if ($marcrecord->field('215'));
my $subfield_value_t;
if (($marcrecord->field('200')) && ($marcrecord->field('200')->subfield("a"))){
$subfield_value_t = $marcrecord->field('200')->subfield("a") ;
} elsif (($marcrecord->field('225')) && ($marcrecord->field('225')->subfield("a"))) {
$subfield_value_t = $marcrecord->field('225')->subfield("a") ;
} elsif (($marcrecord->field('500')) && ($marcrecord->field('500')->subfield("a"))) {
$subfield_value_t = $marcrecord->field('500')->subfield("a") ;
}
my $subfield_value_u = $marcrecord->field('856')->subfield("u") if ($marcrecord->field('856'));
my $subfield_value_v;
if (($marcrecord->field('225')) && ($marcrecord->field('225')->subfield("v"))){
$subfield_value_v = $marcrecord->field('225')->subfield("v") ;
} elsif (($marcrecord->field('200')) && ($marcrecord->field('200')->subfield("h"))) {
$subfield_value_v = $marcrecord->field('200')->subfield("h") ;
}
my $subfield_value_x = $marcrecord->field('011')->subfield("a") if ($marcrecord->field('011') and not (($marcrecord->field('011')->subfield("y")) or ($marcrecord->field('011')->subfield("z"))));
my $subfield_value_y = $marcrecord->field('013')->subfield("a") if ($marcrecord->field('013'));
if ($marcrecord->field('010')){
$subfield_value_y = $marcrecord->field('010')->subfield("a");
}
$template->param(fillinput => 1,
index => $query->param('index')."",
biblionumber=>$bibnum?$bibnum:"",
subfield_value_9=>$subfield_value_9,
subfield_value_0=>$subfield_value_0,
subfield_value_a=>$subfield_value_a,
subfield_value_c=>$subfield_value_c,
subfield_value_d=>$subfield_value_d,
subfield_value_e=>$subfield_value_e,
subfield_value_h=>$subfield_value_h,
subfield_value_i=>$subfield_value_i,
subfield_value_p=>$subfield_value_p,
subfield_value_t=>$subfield_value_t,
subfield_value_u=>$subfield_value_u,
subfield_value_v=>$subfield_value_v,
subfield_value_x=>$subfield_value_x,
subfield_value_y=>$subfield_value_y,
);
###############################################################
}elsif ($op eq "do_search") {
my $search = $query->param('search');
my $startfrom = $query->param('startfrom');
my $resultsperpage = $query->param('resultsperpage');
my $orderby;
my ($errors,$results) = SimpleSearch($search);
my $total=scalar(@$results);
$resultsperpage=20 unless $resultsperpage;
# warn " biblio count : ".$total;
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_4XX.tmpl",
query => $query,
type => 'intranet',
authnotrequired => 1,
debug => 1,
});
# multi page display gestion
my $displaynext=0;
my $displayprev=$startfrom;
if(($total - (($startfrom+1)*($resultsperpage))) > 0 ){
$displaynext = 1;
}
my @arrayresults;
my @field_data = ($search);
for (my $i=$startfrom; $i<=(($startfrom+$resultsperpage)<scalar(@$results)?($startfrom+$resultsperpage):scalar(@$results));$i++){
my $record=MARC::Record::new_from_usmarc( $results->[$i] );
my $rechash=MARCmarc2koha($dbh,$record);
my $pos;
my $countitems=1 if ($rechash->{itemnumber});
while (index($rechash->{itemnumber},'|',$pos)>0){
$countitems+=1;
$pos=index($rechash->{itemnumber},'|',$pos)+1;
}
$rechash->{totitem}=$countitems;
my @holdingbranches=split /\|/,$rechash->{holdingbranch};
my @itemcallnumbers=split /\|/,$rechash->{itemcallnumber};
my $CN;
for (my $i=0;$i<@holdingbranches;$i++){
$CN.= $holdingbranches[$i]." ( ".$itemcallnumbers[$i]." ) |"
}
$CN=~s/ \|$//;
$rechash->{CN}=$CN;
push @arrayresults,$rechash;
}
# for(my $i = 0 ; $i <= $#marclist ; $i++)
# {
# push @field_data, { term => "marclist", val=>$marclist[$i] };
# push @field_data, { term => "and_or", val=>$and_or[$i] };
# push @field_data, { term => "excluding", val=>$excluding[$i] };
# push @field_data, { term => "operator", val=>$operator[$i] };
# push @field_data, { term => "value", val=>$value[$i] };
# }
my @numbers = ();
if ($total>$resultsperpage)
{
for (my $i=1; $i<$total/$resultsperpage+1; $i++)
{
if ($i<16)
{
my $highlight=0;
($startfrom==($i-1)) && ($highlight=1);
push @numbers, { number => $i,
highlight => $highlight ,
searchdata=> \@field_data,
startfrom => ($i-1)};
}
}
}
my $from = $startfrom*$resultsperpage+1;
my $to;
if($total < (($startfrom+1)*$resultsperpage))
{
$to = $total;
} else {
$to = (($startfrom+1)*$resultsperpage);
}
my $defaultview = 'BiblioDefaultView'.C4::Context->preference('BiblioDefaultView');
$template->param(result => \@arrayresults,
index => $query->param('index')."",
startfrom=> $startfrom,
displaynext=> $displaynext,
displayprev=> $displayprev,
resultsperpage => $resultsperpage,
orderby => $orderby,
startfromnext => $startfrom+1,
startfromprev => $startfrom-1,
searchdata=>\@field_data,
total=>$total,
from=>$from,
to=>$to,
numbers=>\@numbers,
searchdesc=> $searchdesc,
$defaultview => 1,
Search =>0
);
} else {
($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_4XX.tmpl",
query => $query,
type => "intranet",
authnotrequired => 1,
});
my $sth=$dbh->prepare("Select itemtype,description from itemtypes order by description");
$sth->execute;
my @itemtype;
my %itemtypes;
push @itemtype, "";
$itemtypes{''} = "";
while (my ($value,$lib) = $sth->fetchrow_array) {
push @itemtype, $value;
$itemtypes{$value}=$lib;
}
my $CGIitemtype=CGI::scrolling_list( -name => 'value',
-values => \@itemtype,
-labels => \%itemtypes,
-size => 1,
-multiple => 0 );
$sth->finish;
my @branchloop;
my @select_branch;
my %select_branches;
my $branches=GetBranches;
push @select_branch, "";
$select_branches{''} = "";
foreach my $thisbranch (keys %$branches){
push @select_branch, $branches->{$thisbranch}->{'branchcode'};
$select_branches{$branches->{$thisbranch}->{'branchcode'}} = $branches->{$thisbranch}->{'branchname'};
}
my $CGIbranch=CGI::scrolling_list( -name => 'value',
-values => \@select_branch,
-labels => \%select_branches,
-size => 1,
-multiple => 0 );
$sth->finish;
my $req = $dbh->prepare("select distinctrow left(publishercode,45) from biblioitems order by publishercode");
$req->execute;
my @select;
push @select,"";
while (my ($value) =$req->fetchrow) {
push @select, $value;
}
my $CGIpublisher=CGI::scrolling_list( -name => 'value',
-id => 'publisher',
-values => \@select,
-size => 1,
-multiple => 0 );
# my $sth=$dbh->prepare("select description,itemtype from itemtypes order by description");
# $sth->execute;
# while (my ($description,$itemtype) = $sth->fetchrow) {
# $classlist.="<option value=\"$itemtype\">$description</option>\n";
# }
# $sth->finish;
$template->param(#classlist => $classlist,
CGIitemtype => $CGIitemtype,
CGIbranch => $CGIbranch,
CGIPublisher => $CGIpublisher,
index=>$query->param('index'),
Search =>1,
);
}
output_html_with_http_headers $query, $cookie, $template->output ;
}
1;

118
cataloguing/value_builder/unimarc_field_60X.pl

@ -0,0 +1,118 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
use C4::Authorities;
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(index) {
defaultvalue=document.f.field_value[index].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_60X.pl&index=\"+index+\"&result=\"+defaultvalue,\"unimarc 700\",'width=700,height=300,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
my $dbh = C4::Context->dbh;
my $index= $input->param('index');
my $result= $input->param('result');
my $search_string= $input->param('search_string');
my $op = $input->param('op');
my $id = $input->param('id');
my $insert = $input->param('insert');
my %stdlib;
my $select_list;
if ($op eq "add") {
newauthority($dbh,'NC',$insert,$insert,'',1,'');
$search_string=$insert;
}
if ($op eq "select") {
my $sti = $dbh->prepare("select stdlib from bibliothesaurus where id=?");
$sti->execute($id);
my ($freelib_text) = $sti->fetchrow_array;
$result = $freelib_text;
}
my $Rsearch_string="$search_string%";
my $authoritysep = C4::Context->preference('authoritysep');
my @splitted = /$authoritysep/,$search_string;
my $level = $#splitted+1;
my $sti;
if ($search_string) { # if no search pattern, returns only the 50 1st top level values
$sti=$dbh->prepare("select distinct freelib,father,level from bibliothesaurus where category='NC' and freelib like ? order by father,freelib");
} else {
$sti=$dbh->prepare("select distinct freelib,father,level from bibliothesaurus where category='NC' and level=0 and freelib like ? order by father,freelib limit 0,50");
}
$sti->execute($Rsearch_string);
my @results;
while (my ($freelib,$father,$level)=$sti->fetchrow) {
my %line;
if ($father) {
$line{value} = "$father $freelib";
} else {
$line{value} = "$freelib";
}
$line{level} = $level+1;
$line{father} = $father;
push @results, \%line;
}
my @DeeperResults = SearchDeeper('NC',$search_string);
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_60X.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
# builds collection list : search isbn and editor, in parent, then load collections from bibliothesaurus table
$template->param(index => $index,
result =>$result,
search_string => $search_string?$search_string:$result,
results => \@results,
deeper => \@DeeperResults,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

98
cataloguing/value_builder/unimarc_field_700-4.pl

@ -0,0 +1,98 @@
#!/usr/bin/perl
# written 10/5/2002 by Paul
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1 NAME
plugin unimarc_field_700-4
=head1 SYNOPSIS
This plug-in deals with unimarc field 700-4 (
=head1 DESCRIPTION
=head1 FUNCTIONS
=over 2
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "7004".(int(rand(100000))+1);
my $res = "
<script>
function Focus$function_name(index) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(subfield_managed) {
defaultvalue=document.forms['f'].field_value[1].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_700-4.pl&result=\"+defaultvalue+\"&index=$field_number\",\"value builder\",'width=500,height=400,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $index2= $input->param('index2');
$index2=-1 unless($index2);
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_700-4.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$template->param(index => $index,
index2 => $index2,
"f1_$result" => "f1_".$result,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

158
cataloguing/value_builder/unimarc_field_700_701_702.pl

@ -0,0 +1,158 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
use C4::Authorities;
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(index) {
defaultvalue=document.f.field_value[index].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_field_700_701_702.pl&index=\"+index+\"&result=\"+defaultvalue,\"unimarc 700\",'width=700,height=300,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
my $dbh = C4::Context->dbh;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $search_string= $input->param('search_string');
my $op = $input->param('op');
my $id = $input->param('id');
my $insert = $input->param('insert');
my @freelib;
my %stdlib;
my $select_list;
my ($a,$b,$c,$f) ; # the 4 managed subfields.
if ($op eq "add") {
newauthority($dbh,'NP',$insert,$insert,'',1,'');
$search_string=$insert;
}
if ($op eq "select") {
my $sti = $dbh->prepare("select stdlib from bibliothesaurus where id=?");
$sti->execute($id);
my ($freelib_text) = $sti->fetchrow_array;
$result = $freelib_text;
# fill the 4 managed subfields
my @arr = split //,$result;
my $where = 1;
foreach my $x (@arr) {
next if ($x eq ')');
if ($x eq ',') {
$where=2;
next;
}
if ($x eq '(') {
if ($result =~ /.*;.*/) {
$where=3;
} else {
$where=4;
}
next;
}
if ($x eq ';') {
$where=4;
next;
}
if ($where eq 1) {
$a.=$x;
}
if ($where eq 2) {
$b.=$x;
}
if ($where eq 3) {
$c.=$x;
}
if ($where eq 4) {
$f.=$x;
}
}
# remove trailing blanks
$a=~ s/^\s+//g;
$b=~ s/^\s+//g;
$c=~ s/^\s+//g;
$f=~ s/^\s+//g;
$a=~ s/\s+$//g;
$b=~ s/\s+$//g;
$c=~ s/\s+$//g;
$f=~ s/^s+$//g;
}
if ($search_string) {
# my $sti=$dbh->prepare("select id,freelib from bibliothesaurus where freelib like '".$search_string."%' and category ='$category'");
my $sti=$dbh->prepare("select id,freelib from bibliothesaurus where match (category,freelib) AGAINST (?) and category ='NP'");
$sti->execute($search_string);
while (my $line=$sti->fetchrow_hashref) {
$stdlib{$line->{'id'}} = "$line->{'freelib'}";
push(@freelib,$line->{'id'});
}
$select_list= CGI::scrolling_list( -name=>'id',
-values=> \@freelib,
-default=> "",
-size=>1,
-multiple=>0,
-labels=> \%stdlib
);
}
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_field_700_701_702.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { editcatalogue => 1},
debug => 1,
});
# builds collection list : search isbn and editor, in parent, then load collections from bibliothesaurus table
$template->param(index => $index,
result =>$result,
select_list => $select_list,
search_string => $search_string?$search_string:$result,
a => $a,
b => $b,
c => $c,
f => $f,);
print $input->header(-cookie => $cookie),$template->output;
}
1;

105
cataloguing/value_builder/unimarc_leader.pl

@ -0,0 +1,105 @@
#!/usr/bin/perl
# $Id$
# 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::Auth;
use CGI;
use C4::Context;
use C4::Search;
use C4::Output;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "100".(int(rand(100000))+1);
my $res="
<script>
function Focus$function_name(subfield_managed) {
return 1;
}
function Blur$function_name(subfield_managed) {
return 1;
}
function Clic$function_name(i) {
defaultvalue=document.forms['f'].field_value[i].value;
newin=window.open(\"plugin_launcher.pl?plugin_name=unimarc_leader.pl&index=\"+i+\"&result=\"+defaultvalue,\"unimarc field 100\",'width=1000,height=600,toolbar=false,scrollbars=yes');
}
</script>
";
return ($function_name,$res);
}
sub plugin {
my ($input) = @_;
my %env;
# my $input = new CGI;
my $index= $input->param('index');
my $result= $input->param('result');
my $dbh = C4::Context->dbh;
my ($template, $loggedinuser, $cookie)
= get_template_and_user({template_name => "cataloguing/value_builder/unimarc_leader.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => {editcatalogue => 1},
debug => 1,
});
$result = " nam 3 " unless $result;
my $f5 = substr($result,5,1);
my $f6 = substr($result,6,1);
my $f7 = substr($result,7,1);
my $f8 = substr($result,8,1);
my $f9 = substr($result,9,1);
my $f17 = substr($result,17,1);
my $f18 = substr($result,18,1);
my $f19 = substr($result,19,1);
$template->param(index => $index,
"f5$f5" => 1,
"f6$f6" => 1,
"f7$f7" => 1,
"f8$f8" => 1,
"f9$f9" => 1,
"f17$f17" => 1,
"f18$f18" => 1,
"f19$f19" => 1,
);
print $input->header(-cookie => $cookie),$template->output;
}
1;

101
cataloguing/value_builder/usmarc_field_952v.pl

@ -0,0 +1,101 @@
#!/usr/bin/perl
# $Id$
# 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
require Exporter;
use C4::AuthoritiesMarc;
use C4::Auth;
use C4::Context;
use C4::Output;
use C4::Interface::CGI::Output;
use CGI;
use C4::Search;
use MARC::Record;
use C4::Koha;
=head1
plugin_parameters : other parameters added when the plugin is called by the dopop function
=cut
sub plugin_parameters {
my ($dbh,$record,$tagslib,$i,$tabloop) = @_;
return "";
}
=head1
plugin_javascript : the javascript function called when the user enters the subfield.
contain 3 javascript functions :
* one called when the field is entered (OnFocus). Named FocusXXX
* one called when the field is leaved (onBlur). Named BlurXXX
* one called when the ... link is clicked (<a href="javascript:function">) named ClicXXX
returns :
* XXX
* a variable containing the 3 scripts.
the 3 scripts are inserted after the <input> in the html code
=cut
sub plugin_javascript {
my ($dbh,$record,$tagslib,$field_number,$tabloop) = @_;
my $function_name= "210c".(int(rand(100000))+1);
# find today's date
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime(time);
$year +=1900;
$mon +=1;
my $date = "$year-$mon-$mday";
my $res = "
<script>
function Blur$function_name(index) {
//need this?
}
function Focus$function_name(subfield_managed) {
for (i=0 ; i<document.f.field_value.length ; i++) {
if (document.f.tag[i].value == '952' && document.f.subfield[i].value == 'v') {
document.f.field_value[i].value = '$date';
}
}
return 0;
}
function Clic$function_name(subfield_managed) {
}
</script>
";
return ($function_name,$res);
}
=head1
plugin : the true value_builded. The screen that is open in the popup window.
=cut
sub plugin {
my ($input) = @_;
return "";
}
1;

216
cataloguing/z3950_search.pl

@ -0,0 +1,216 @@
#!/usr/bin/perl
# This is a completely new Z3950 clients search using async ZOOM -TG 02/11/06
# 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::Output;
use C4::Interface::CGI::Output;
use C4::Biblio;
use C4::Context;
use C4::Breeding;
use C4::Koha;
use ZOOM;
my $input = new CGI;
my $dbh = C4::Context->dbh;
my $error = $input->param('error');
my $biblionumber=$input->param('biblionumber');
$biblionumber=0 unless $biblionumber;
my $frameworkcode=$input->param('frameworkcode');
my $title = $input->param('title');
my $author = $input->param('author');
my $isbn = $input->param('isbn');
my $issn = $input->param('issn');
my $random = $input->param('random');
my $op=$input->param('op');
my $noconnection;
my $numberpending;
my $attr='';
my $term;
my $host;
my $server;
my $database;
my $port;
my $marcdata;
my @encoding;
my @results;
my $count;
my $toggle;
my $record;
my $oldbiblio;
my $dbh = C4::Context->dbh;
my $errmsg;
my @serverloop=();
my @serverhost;
my @breeding_loop = ();
my $DEBUG = 1; # if set to 1, many debug message are send on syslog.
unless ($random) { # this var is not useful anymore just kept to keep rel2_2 compatibility
$random =rand(1000000000);
}
my ($template, $loggedinuser, $cookie)= get_template_and_user({
template_name => "cataloguing/z3950_search.tmpl",
query => $input,
type => "intranet",
authnotrequired => 1,
flagsrequired => {catalogue => 1},
debug => 1,
});
$template->param(
intranetcolorstylesheet => C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
frameworkcode => $frameworkcode,
);
if ($op ne "do_search"){
my $sth=$dbh->prepare("select id,host,checked from z3950servers order by host");
$sth->execute();
my $serverloop=$sth->fetchall_arrayref({});
$template->param(isbn=>$isbn, issn=>$issn,title=>$title,author=>$author,
serverloop => $serverloop,
opsearch => "search",
biblionumber => $biblionumber,
);
output_html_with_http_headers $input, $cookie, $template->output;
}else{
my @id=$input->param('id');
my @oConnection;
my @oResult;
my $s=0;
if ($isbn || $issn) {
$attr='1=7';
# warn "isbn : $isbn";
$term=$isbn if ($isbn);
$term=$issn if ($issn);
} elsif ($title) {
$attr='1=4 ';
utf8::decode($title);
$title=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/;
$term=$title;
} elsif ($author) {
$attr='1=1003';
utf8::decode($author);
$author=~tr/àâäéèêëîïôöùû/aaaeeeeiioouu/;
$term=$author;
}
my $query="\@attr $attr \"$term\"";
warn "query ".$query if $DEBUG;
foreach my $servid (@id){
my $sth=$dbh->prepare("select * from z3950servers where id=?");
$sth->execute($servid);
while ($server=$sth->fetchrow_hashref) {
my $noconnection=0;
my $option1=new ZOOM::Options();
$option1->option('async'=>1);
$option1->option('elementSetName', 'F');
$option1->option('databaseName',$server->{db}) ;
$option1->option('user',$server->{userid}) if $server->{userid};
$option1->option('password',$server->{password}) if $server->{password};
$option1->option('preferredRecordSyntax', $server->{syntax});
$oConnection[$s]=create ZOOM::Connection($option1) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
warn ("server data",$server->{name}, $server->{port}) if $DEBUG;
$oConnection[$s]->connect($server->{host}, $server->{port}) || $DEBUG && warn ("something went wrong: ".$oConnection[$s]->errmsg());
$serverhost[$s]=$server->{host};
$encoding[$s]=$server->{syntax};
$s++;
}## while fetch
}# foreach
my $nremaining = $s;
my $firstresult=1;
for (my $z=0 ;$z<$s;$z++){
warn "doing the search" if $DEBUG;
$oResult[$z] = $oConnection[$z]->search_pqf($query) || $DEBUG && warn ("somthing went wrong: " . $oConnection[$s]->errmsg());
#$oResult[$z] = $oConnection[$z]->search_pqf($query);
}
AGAIN:
my $k;
my $event;
while (($k = ZOOM::event(\@oConnection)) != 0) {
$event = $oConnection[$k-1]->last_event();
warn ("connection ", $k-1, ": event $event (", ZOOM::event_str($event), ")\n") if $DEBUG;
last if $event == ZOOM::Event::ZEND;
}
if ($k != 0) {
$k--;
warn $serverhost[$k] if $DEBUG;
my($error, $errmsg, $addinfo, $diagset) = $oConnection[$k]->error_x();
if ($error) {
warn "$k $serverhost[$k] error $query: $errmsg ($error) $addinfo\n" if $DEBUG;
} else {
my $numresults=$oResult[$k]->size() ;
my $i;
my $result='';
if ($numresults>0){
for ($i=0; $i<(($numresults<20) ? ($numresults) : (20)) ; $i++) {
my $rec=$oResult[$k]->record($i);
my $marcrecord;
$marcdata = $rec->raw();
$marcrecord= FixEncoding($marcdata);
####WARNING records coming from Z3950 clients are in various character sets MARC8,UTF8,UNIMARC etc
## In HEAD i change everything to UTF-8
# In rel2_2 i am not sure what encoding is so no character conversion is done here
##Add necessary encoding changes to here -TG
my $oldbiblio = MARCmarc2koha($dbh,$marcrecord,"");
$oldbiblio->{isbn} =~ s/ |-|\.//g,
$oldbiblio->{issn} =~ s/ |-|\.//g,
my ($notmarcrecord,$alreadyindb,$alreadyinfarm,$imported,$breedingid)=ImportBreeding($marcdata,1,$serverhost[$k],$encoding[$k],$random);
my %row_data;
if ($i % 2) {
$toggle="#ffffcc";
} else {
$toggle="white";
}
$row_data{toggle} = $toggle;
$row_data{server} = $serverhost[$k];
$row_data{isbn} = $oldbiblio->{isbn};
$row_data{title} =$oldbiblio->{title};
$row_data{author} = $oldbiblio->{author};
$row_data{breedingid} = $breedingid;
$row_data{biblionumber}=$biblionumber;
push (@breeding_loop, \%row_data);
}# upto 5 results
}#$numresults
}
}# if $k !=0
$numberpending=$nremaining-1;
$template->param(breeding_loop => \@breeding_loop, server=>$serverhost[$k],
numberpending => $numberpending,
);
output_html_with_http_headers $input, $cookie, $template->output if $numberpending==0;
# print $template->output if $firstresult !=1;
$firstresult++;
MAYBE_AGAIN:
if (--$nremaining > 0) {
goto AGAIN;
}
} ## if op=search

208
circ/bookcount.pl

@ -0,0 +1,208 @@
#!/usr/bin/perl
# $Id$
#written 7/3/2002 by Finlay
#script to display reports
# 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::Circulation::Circ2;
use C4::Output;
use C4::Koha;
use C4::Auth;
use C4::Branch; # GetBranches
use C4::Biblio; # GetBiblioItemData
use C4::Date;
my $input = new CGI;
my $itm = $input->param('itm');
my $bi = $input->param('bi');
my $biblionumber = $input->param('biblioitemnumber');
my $branches = GetBranches;
my $idata = itemdatanum($itm);
my $data = GetBiblioItemData($bi);
my $homebranch = $branches->{ $idata->{'homebranch'} }->{'branchname'};
my $holdingbranch = $branches->{ $idata->{'holdingbranch'} }->{'branchname'};
my ( $lastmove, $message ) = lastmove($itm);
my $lastdate;
my $count;
if ( not $lastmove ) {
$lastdate = $message;
$count = issuessince( $itm, 0 );
}
else {
$lastdate = $lastmove->{'datearrived'};
$count = issuessince( $itm, $lastdate );
}
# make the page ...
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "circ/bookcount.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { circulate => 1 },
debug => 1,
}
);
my @branchloop;
foreach my $branchcode ( keys %$branches ) {
my %linebranch;
$linebranch{issues} = issuesat( $itm, $branchcode );
my $date = lastseenat( $itm, $branchcode );
$linebranch{seen} = slashdate($date);
$linebranch{branchname} = $branches->{$branchcode}->{'branchname'};
push( @branchloop, \%linebranch );
}
$template->param(
biblionumber => $biblionumber,
title => $data->{'title'},
author => $data->{'author'},
barcode => $idata->{'barcode'},
biblioitemnumber => $bi,
homebranch => $homebranch,
holdingbranch => $holdingbranch,
lastdate => format_date($lastdate),
count => $count,
branchloop => \@branchloop,
intranetcolorstylesheet =>
C4::Context->preference("intranetcolorstylesheet"),
intranetstylesheet => C4::Context->preference("intranetstylesheet"),
IntranetNav => C4::Context->preference("IntranetNav"),
);
output_html_with_http_headers $input, $cookie, $template->output;
sub itemdatanum {
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $sth = $dbh->prepare("select * from items where itemnumber=?");
$sth->execute($itemnumber);
my $data = $sth->fetchrow_hashref;
$sth->finish;
return ($data);
}
sub lastmove {
my ($itemnumber) = @_;
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
"select max(branchtransfers.datearrived) from branchtransfers where branchtransfers.itemnumber=?"
);
$sth->execute($itemnumber);
my ($date) = $sth->fetchrow_array;
return ( 0, "Item has no branch transfers record" ) if not $date;
$sth =
$dbh->prepare(
"Select * from branchtransfers where branchtransfers.itemnumber=? and branchtransfers.datearrived=?"
);
$sth->execute( $itemnumber, $date );
my ($data) = $sth->fetchrow_hashref;
return ( 0, "Item has no branch transfers record" ) if not $data;
$sth->finish;
return ( $data, "" );
}
sub issuessince {
my ( $itemnumber, $date ) = @_;
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
"Select count(*) from issues where issues.itemnumber=? and issues.timestamp > ?"
);
$sth->execute( $itemnumber, $date );
my $count = $sth->fetchrow_hashref;
$sth->finish;
return ( $count->{'count(*)'} );
}
sub issuesat {
my ( $itemnumber, $brcd ) = @_;
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
"Select count(*) from issues where itemnumber=? and branchcode = ?");
$sth->execute( $itemnumber, $brcd );
my ($count) = $sth->fetchrow_array;
$sth->finish;
return ($count);
}
sub lastseenat {
my ( $itm, $brc ) = @_;
my $dbh = C4::Context->dbh;
my $sth =
$dbh->prepare(
"Select max(timestamp) from issues where itemnumber=? and branchcode = ?"
);
$sth->execute( $itm, $brc );
my ($date1) = $sth->fetchrow_array;
$sth->finish;
$sth =
$dbh->prepare(
"Select max(datearrived) from branchtransfers where itemnumber=? and tobranch = ?"
);
$sth->execute( $itm, $brc );
my ($date2) = $sth->fetchrow_array;
$sth->finish;
#FIXME: MJR thinks unsafe
$date2 =~ s/-//g;
$date2 =~ s/://g;
$date2 =~ s/ //g;
my $date;
if ( $date1 < $date2 ) {
$date = $date2;
}
else {
$date = $date1;
}
return ($date);
}
#####################################################
# write date....
sub slashdate {
my ($date) = @_;
if ( not $date ) {
return "never";
}
my ( $yr, $mo, $da, $hr, $mi ) = (
substr( $date, 0, 4 ),
substr( $date, 4, 2 ),
substr( $date, 6, 2 ),
substr( $date, 8, 2 ),
substr( $date, 10, 2 )
);
return "$hr:$mi " . format_date("$yr-$mo-$da");
}

170
circ/branchoverdues.pl

@ -0,0 +1,170 @@
#!/usr/bin/perl
# $Id$
#
# 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::Context;
use CGI;
use C4::Interface::CGI::Output;
use C4::Auth;
use C4::Date;
use C4::Circulation::Circ2; # AddNotifyLine
use C4::Koha; # GetDepartement...
use Mail::Sendmail;
use Getopt::Long;
use Date::Calc qw/Today Today_and_Now Now/;
=head1 branchoverdues.pl
this module is a new interface, allow to the librarian to check all items on overdues (based on the acountlines type 'FU' )
this interface is filtered by branches (automaticly), and by departement (optional) ....
all informations are stocked in the notifys BDD
FIXME for this time, we have only four methods to notify :
- mail : work with a batch programm
- letter : for us, the letters are generated by an open-office program
- phone : Simple method, when the method 'phone' is selected, we consider, that the borrower as been notified, and the notify send date is implemented
- considered lost : for us if the document is on the third overduelevel,
FIXME the methods are actually hardcoded for the levels : (maybe can be improved by a new possibility in overduerule)
level 1 : three methods are possible : - mail, letter, phone
level 2 : only one method is possible : - letter
level 3 : only methode is possible : - Considered Lost
the documents displayed on this interface, are checked on three points
- 1) the document must be on accountlines (Type 'FU')
- 2) item issues is not returned
- 3) this item as not been already notify
=cut
my $input = new CGI;
my $theme = $input->param('theme'); # only used if allowthemeoverride is set
my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
{
template_name => "circ/branchoverdues.tmpl",
query => $input,
type => "intranet",
authnotrequired => 0,
flagsrequired => { circulate => 1 },
debug => 1,
}
);
my $default = C4::Context->userenv->{'branch'};
# Initate localtime
my ( $year, $month, $day ) = &Today;
my $todaysdate = join "-", ( $year, $month, $day );
# Deal with the vars recept from the template
my $borrowernumber = $input->param('borrowernumber');
my $itemnumber = $input->param('itemnumber');
my $method = $input->param('method');
my $overduelevel = $input->param('overduelevel');
my $notifyId = $input->param('notifyId');
my $departement = $input->param('departement');
# now create the line in bdd (notifys)
if ( $input->param('action') eq 'add' ) {
my $addnotify =
AddNotifyLine( $borrowernumber, $itemnumber, $overduelevel, $method,
$notifyId );
}
# possibility to remove notify line
if ( $input->param('action') eq 'remove' ) {
my $notify_date = $input->param('notify_date');
my $removenotify =
RemoveNotifyLine( $borrowernumber, $itemnumber, $notify_date );
}
my @overduesloop;
my @todayoverduesloop;
my $counter = 0;
my @getoverdues = GetOverduesForBranch( $default, $departement );
# filter by departement
if ($departement) {
my ( $departementlib, $departementValue ) = GetDepartementLib($departement);
$template->param(
departement => $departementlib,
departementValue => $departementValue,
);
}
else {
# initiate the selector of departements .....
my @getdepartements = GetDepartements();
my @departementsloop;
foreach my $dpt (@getdepartements) {
my %departement;
$departement{'authorised_value'} = $dpt->{'authorised_value'};
$departement{'lib'} = $dpt->{'lib'};
push( @departementsloop, \%departement );
}
$template->param( departementsloop => \@departementsloop, );
}
# now display infos
foreach my $num (@getoverdues) {
my %overdueforbranch;
$overdueforbranch{'date_due'} = format_date( $num->{'date_due'} );
$overdueforbranch{'title'} = $num->{'title'};
$overdueforbranch{'description'} = $num->{'description'};
$overdueforbranch{'barcode'} = $num->{'barcode'};
$overdueforbranch{'biblionumber'} = $num->{'biblionumber'};
$overdueforbranch{'borrowersurname'} = $num->{'surname'};
$overdueforbranch{'borrowerfirstname'} = $num->{'firstname'};
$overdueforbranch{'borrowerphone'} = $num->{'phone'};
$overdueforbranch{'borroweremail'} = $num->{'email'};
$overdueforbranch{'itemcallnumber'} = $num->{'itemcallnumber'};
$overdueforbranch{'borrowernumber'} = $num->{'borrowernumber'};
$overdueforbranch{'itemnumber'} = $num->{'itemnumber'};
# now we add on the template, the differents values of notify_level
if ( $num->{'notify_level'} eq '1' ) {
$overdueforbranch{'overdue1'} = 1;
$overdueforbranch{'overdueLevel'} = 1;
}
if ( $num->{'notify_level'} eq '2' ) {
$overdueforbranch{'overdue2'} = 1;
$overdueforbranch{'overdueLevel'} = 2;
}
if ( $num->{'notify_level'} eq '3' ) {
$overdueforbranch{'overdue3'} = 1;
$overdueforbranch{'overdueLevel'} = 3;
}
$overdueforbranch{'notify_id'} = $num->{'notify_id'};
push( @overduesloop, \%overdueforbranch );
}
# initiate the templates for the overdueloop
$template->param(
overduesloop => \@overduesloop,
show_date => format_date($todaysdate),
);
output_html_with_http_headers $input, $cookie, $template->output;

Some files were not shown because too many files changed in this diff

Loading…
Cancel
Save