- Koha-devel - lists.koha-community.org

Re: [Koha] primera vez
by eduardo vargas 14 Nov '08

14 Nov '08

hola mucho gusto, soy eduardo y estoy entrando en el tema de koha , empece hace un mes y medio . quiesiera hacerles unas preguntas si no es mucha molestio y si me puden enviar algun documento o indicar donde descargarlo. yo estoy trabajando en la parte de programacion . mis preguntas son ¿porque se usa perl en koha es decir que ventajas o beneficios trae? ¿ si los scripts de perl que trae koha se dividen en categorias? ¿porque instalar koha sobre linux? como ve es informacion sobre la programacion de koha. desde ya muchas gracias . eduardo

1 0

CPLANPLUS
by Rick Welykochy 14 Nov '08

14 Nov '08

Anyone have experience with the impending CPAN replacement called CPLANPLUS? http://cpanplus.dwim.org/ "CPAN++ (also referred to and pronounced as CPANPLUS) is a new and flexible method of perl module management and installation using the Comprehensive Perl Archive Network (CPAN). It aims to be a rewrite, and in time a replacement to the current CPAN.pm. In addition to fixing some long-standing problems, CPAN++ includes new features, such as module uninstall. ... Note: CPANPLUS will not become a full drop-in replacement for CPAN.pm. Instead, it will become part of the core in 5.10 under a new (as yet undetermined) name and CPAN.pm will be deprecated. " I raise this in light of addressing the issue of problems many seem to be having installing the perl module requirements for Koha. cheers rickw -- _________________________________ Rick Welykochy || Praxis Services Tis the dream of each programmer before his life is done, To write three lines of APL and make the damn thing run.

2 1

[PATCH] C4::Table - A simple OO database abstraction layer.
by Joe Atzberger 13 Nov '08

13 Nov '08

The purpose of Table is to provide all the basic functionality that is reimplemented multiple times throughout Koha for each DB table. This code is considered experimental and does not yet supplant any production code. Please examine and test, like: use C4::Table; my $table = C4::Table->new("borrowers"); my $set = $table->select({surname=>"Smith", sort=>"branchcode,firstname"}); The argument style to select is similar to functions in C4::Tags using a hashref. The return from select is a reference to array of hashrefs, like fetchall_arrayref({}). The full database row is represented, like "SELECT(*)". --- C4/Table.pm | 216 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ t/other/README | 5 ++ t/other/Table.t | 103 ++++++++++++++++++++++++++ 3 files changed, 324 insertions(+), 0 deletions(-) create mode 100644 C4/Table.pm create mode 100644 t/other/README create mode 100644 t/other/Table.t diff --git a/C4/Table.pm b/C4/Table.pm new file mode 100644 index 0000000..0b7737b --- /dev/null +++ b/C4/Table.pm @@ -0,0 +1,216 @@ +package C4::Table; +# Copyright 2008 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 + +use strict; +use warnings; +use Carp; + +use C4::Context; +use C4::Debug; +use Data::Dumper; + +use vars qw($VERSION); +use vars qw(@tables $default); + +BEGIN { + $VERSION = 0.02; # experimental! + if ($debug) { + require Data::Dumper; + import Data::Dumper qw(:DEFAULT); + } +} + +$default = { + tablename => undef, + columns => undef, # = fetchall_arrayref({}) from SHOW COLUMNS + fields => undef, # = ref to array of ALL field names + key_fields => undef, # = hashref of just the keys (field_name => keytype) +}; +### Don't confuse the data structure here with the return values of similarly named functions + +sub new { + my ($class) = shift or croak "Bad call to " . __PACKAGE__ . " constructor new"; + my $type = ref($class) || $class; + my $self = {}; + foreach (keys %$default) { + $self->{$_} = $default->{$_}; + } + $debug and warn "new " . __PACKAGE__ ; + bless $self, $type; + return $self->_init(@_); +} + +sub fields { # returns array + my $self = shift or return undef; + defined ($self->{fields}) and return @{$self->{fields}}; + my @fields = map {$_->{Field}} @{$self->columns}; + $self->{fields} = \@fields; + return @fields; +} +sub key_fields { # returns hash + my $self = shift or return undef; + defined ($self->{key_fields}) and return %{$self->{key_fields}}; + my @keys = grep {$_->{Key}} @{$self->columns}; + my %map = (); + foreach (@keys) { + $map{$_->{Field}} = $_->{Key}; + } + $self->{key_fields} =\%map; + return %map; +} + +sub _columns_init { + my $self = shift or return undef; + $self->{tablename} or croak "No tablename set for " . __PACKAGE__ . " object"; + my $sth = C4::Context->dbh->prepare("SHOW COLUMNS FROM " . $self->{tablename}); + $sth->execute; + $self->{columns} = $sth->fetchall_arrayref({}); + return $self; +} +sub columns { # returns reference to array of hashref, i.e. [{},{},{}...] + my $self = shift or return undef; + defined ($self->{columns}) or $self->_columns_init; + return $self->{columns}; +} + +sub _init { + my $self = shift or return undef; + unless ($self->{tablename} = shift) { + croak "Missing tablename argument in _init for " . __PACKAGE__ ; + return undef; + } + $self->_columns_init; + ($debug > 1) and print STDERR __PACKAGE__ . " : " . Dumper($self); + return $self; +} + +sub delete ($$;$) { + die "delete not implemented yet"; + my $self = shift or return undef; + my $hash = shift || {}; +} + +sub parse_args ($$$) { # returns $sql_fragment, @args + my $self = shift or croak "Bad call to method parse_args"; + my $op = shift or croak "Bad call to method parse_args"; + my $hash = shift || {}; + my @ok_fields = $self->fields; + my $wheres; + my $limit = ""; + my $order = ""; + my @exe_args = (); + push @ok_fields, 'limit', 'sort'; # push the limit! :) + foreach my $key (keys %$hash) { + $debug and print STDERR "$op arg. '$key' = ", $hash->{$key}, "\n"; + unless (length $key) { + carp "Empty argument key to $op: ignoring!"; + next; + } + unless (1 == scalar grep {/^ $key $/x} @ok_fields) { + carp "$op received unreconized argument key '$key'."; + next; + } + if ($key eq 'limit') { + my $val = $hash->{$key}; + unless ($val =~ /^(\d+,)?\d+$/) { + carp "Non-nuerical limit value '$val' ignored!"; + next; + } + $limit = " LIMIT $val\n"; + } elsif ($key eq 'sort') { + unless ($op eq 'select') { + carp 'Unexpected "sort" in arguments to non-SELECT parse_args: ignoring'; + next; + } + foreach my $by (split /\s*\,\s*/, $hash->{$key}) { + my $sign; + $by =~ s/^([-+])// and $sign = $1; + unless (grep /^($by)$/, $self->fields) { + carp "Illegal sort order '$by'"; + next; + } + if ($order) { + $order .= ", "; + } else { + $order = " ORDER BY "; + } + $order .= $by . " " . ((!$sign) ? '' : $sign eq '-' ? 'DESC' : $sign eq '+' ? 'ASC' : '') . "\n"; + } + } else { + my $whereval = $hash->{$key}; + my $op = ($whereval =~ s/^(>=|<=)// or + $whereval =~ s/^(>|=|<)// ) ? $1 : '='; + $wheres .= ($wheres) ? " AND $key $op ?\n" : " WHERE $key $op ?\n"; + push @exe_args, $whereval; + } + } + ($order) and $wheres .= " $order"; + ($limit) and $wheres .= " $limit"; + $debug and print STDERR "$op WHERE(_LIMIT): $wheres\n"; + return $wheres, @exe_args; +} + +sub insert ($$) { + my $self = shift or croak "Bad call to method insert"; + my ($sql_tail,@exe_args) = $self->parse_args('insert', shift); + my $query = "SELECT * FROM $self->{tablename} " . ($sql_tail||''); + $debug and print STDERR "insert query:\n $query\n", + "insert query args: ", join(',', @exe_args), "\n"; + my $sth = C4::Context->dbh->prepare($query) or carp "dbh->prepare failed"; + if (@exe_args) { + $sth->execute(@exe_args); + } else { + $sth->execute; + } + return $sth->fetchall_arrayref({}); +} + +sub select { + my $self = shift or croak "Bad call to method select"; + my ($sql_tail,@exe_args) = $self->parse_args('select', shift); + my $query = "SELECT * FROM $self->{tablename} " . ($sql_tail||''); + $debug and print STDERR "select query:\n $query\n", + "select query args: ", join(',', @exe_args), "\n"; + my $sth = C4::Context->dbh->prepare($query); + if (@exe_args) { + $sth->execute(@exe_args); + } else { + $sth->execute; + } + return $sth->fetchall_arrayref({}); +} + +1; +__END__ + +=head1 C4::Table - A DBI for any and all tables. + +This class is intended to stand in for all the basic methods (select, insert, update, delete) that are re-implemented +everywhere. + +=head1 SYNOPSIS + +my $table = C4::Table->new('borrowers'); +my $set = $table->select({surname=>'Smith', sort=>'branchcode,firstname'}); + +my $all_branches = C4::Table->new('branches')->select({sort=>'branchname'}); + +=head1 TODO More documentation + +=head1 AUTHOR + +Joe Atzberger - atz AT liblime.com diff --git a/t/other/README b/t/other/README new file mode 100644 index 0000000..9e44dab --- /dev/null +++ b/t/other/README @@ -0,0 +1,5 @@ +This directory is for optional and experimental tests that do not get run by +"make test" from the t/ directory. + +Some of these tests may have additional module dependencies to demonstrate the +difference between alternative implementations. diff --git a/t/other/Table.t b/t/other/Table.t new file mode 100644 index 0000000..670c13e --- /dev/null +++ b/t/other/Table.t @@ -0,0 +1,103 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use Data::Dumper; + +use Test::More tests => 11; + +BEGIN { + use FindBin; + use lib $FindBin::Bin; + use_ok('C4::Table'); +} + +sub print_results ($;$) { + my $rows = shift; + my $max = (@_ ? shift : undef); + my $i = 0; + foreach my $row (@$rows) { + my @keys = sort keys %$row; + unless ($i++) { + diag(join "\t", @keys); + diag(join "\t", map {'-' x $_} map {length} @keys); + } + if ($max and $i > $max) { + diag(" ... ERROR: TOO MANY ROWS ... "); + return 0; + } + print "# " . (join "\t", map {$row->{$_}||''} @keys), "\n"; + # NOT + # diag (join "\t", map {$row->{$_}||''} @keys); + # because Test::Builder cannot handle Unicode/utf8 strings + # like "Žukauskaitė" + } +} +sub field_we_want ($) { + my $x = shift; + return ($x eq 'surname' or $x eq 'borrowernumber' or $x eq 'cardnumber' or $x eq 'firstname' or + $x eq 'branchcode' or $x eq 'userid' or $x eq 'categorycode') ? 1 : 0; +} + +binmode STDOUT, ':utf8'; +binmode STDERR, ':utf8'; +diag("843 LCC 1000001149 PT Simona Žukauskaitė szukaus06"); +my %tables; +my @tablenames = (qw(branches borrowers)); + +my $columns; +foreach my $tname (@tablenames) { + ok($tables{$tname} = C4::Table->new($tname), "C4::Table->new('$tname')"); +} +# construct all up front to test object independence from CLASS + +foreach my $tname (@tablenames) { + ok($columns = $tables{$tname}->columns, "\$$tname" . '->columns'); + diag(sprintf "$tname table has %2d columns:", scalar(@$columns)); + my $maxwidth = 0; + foreach(map {length($_->{Field})} @$columns) { + ($_ > $maxwidth) and $maxwidth = $_; + } + # diag("widest field name is $maxwidth characters"); + foreach(@$columns) { + my $padding = $maxwidth-length($_->{Field}); + diag(sprintf "\t$tname.%s %" . $padding . "s %s", $_->{Field}, '', $_->{Type}); + } + diag(sprintf "END $tname table (%2d columns)", scalar(@$columns)); + print "#\n"; +} + +foreach my $tname (qw(branches)) { + my $select; + ok($select = $tables{$tname}->select({sort=>"+branchcode"}), "\$$tname" . '->select({sort=>"+branchcode"})'); + diag(scalar(@$select) . " $tname retrieved, sorted by branchcode ASCENDING:"); + print_results($select); + ok($select = $tables{$tname}->select({sort=>"-branchcode"}), "\$$tname" . '->select({sort=>"-branchcode"})'); + diag(scalar(@$select) . " $tname retrieved, sorted by branchcode DESCENDING:"); + print_results($select); +} +foreach my $tname (qw(borrowers)) { + my ($select, $count); + ok($select = $tables{$tname}->select({sort=>"+surname", limit=>5}), "\$$tname" . '->select({sort=>"+surname", limit=>5})'); + diag(scalar(@$select) . " $tname retrieved, sorted by surname ASCENDING, limit 5:"); + ok($count = scalar(@$select) <= 5, "limit=>5 returned " . scalar(@$select) . " items"); + foreach my $row (@$select) { + foreach (keys %$row) {field_we_want($_) or delete $row->{$_};} + # make the display more managable. note: you wouldn't want to do this (select * then purge) in production code + } + print_results($select, 5); + ok($select = $tables{$tname}->select({sort=>"-surname", limit=>5}), "\$$tname" . '->select({sort=>"-surname", limit=>5})'); + diag(scalar(@$select) . " $tname retrieved, sorted by surname DESCENDING, limit 5:"); + ok($count = scalar(@$select) <= 5, "limit=>5 returned " . scalar(@$select) . " items"); + foreach my $row (@$select) { + foreach (keys %$row) {field_we_want($_) or delete $row->{$_};} + # make the display more managable. note: you wouldn't want to do this (select * then purge) in production code + } + print_results($select, 5); +} + +############################# +diag "done.\n"; +exit; +############################# + -- 1.5.5.GIT

4 6

Re: [Koha-devel] [Koha] sound cues
by Paul POULAIN 13 Nov '08

13 Nov '08

Owen Leonard a écrit : >> here is the catch, i suspect even a wav file needs a plug-in to play >> correctly > > This is the case in my tests on Windows. The sound will have to be played only on circ-desk (not on OPAC or on all library computers) So I think it's acceptable to have something needing to be installed on those computers. Anyway, there's no other possibilities in HTML if I'm not mistaken. a syspref with html of the "play sound" would be perfect I think : it could either be <embeed> or <playflash> or whatever you want. We would just need 2 : - one "beep OK" - one "beep problem" -- Paul POULAIN http://www.biblibre.com Expert en Logiciels Libres pour l'info-doc NOUVEAU TELEPHONE : 04 91 81 35 08

2 1

Tab stops in source code
by Rick Welykochy 13 Nov '08

13 Nov '08

Hi all In the file abort.pl in Koha 3 I see the follow cryptic comment: # Please use 8-character tabs for this file (indents are every 4 characters) Does this mean that tabs should not be used for indentation, since a tab would indent 8 character positions in the source? Does this imply that we should be using FOUR SPACES for each indent level? If the answer to the latter is yes, I must register my protest. Might I suggest that we adopt a an indentation standard that makes use of the TAB character, and that the tab stop be set to 4 character positions? As it stands, much of the Koha source code is difficult to read and suffers from a variety of inconsistent indentation styles. Comments from developers most welcome. cheers rickw -- ________________________________________________________________ Rick Welykochy || Praxis Services || Internet Driving Instructor When the power of love overcomes the love of power, the world will know peace. -- Jimi Hendrix

8 14

"New Thing" or "New thing"
by Paul POULAIN 13 Nov '08

13 Nov '08

In most parts of Koha strings have a lot of ucfirt on each word : New Item Type, Modify Branch, Edit Permissions some times, it's written in a most classic syntax : New item type, Modify branch, Edit permissions Do we (mainly owen ?) have a rule for uppercase & lower case ? something like : - in button, each word has ucfirst - otherwise, only the 1st word has ucfirst thanks for clarification -- Paul POULAIN http://www.biblibre.com Expert en Logiciels Libres pour l'info-doc NOUVEAU TELEPHONE : 04 91 81 35 08

3 3

creating MARC records
by Rick Welykochy 10 Nov '08

10 Nov '08

HI all Perhaps there are some MARC21 or USMARC gurus on the list who can save me some time. I am creating MARC records on the fly from CSV records. ISSUE #1: The code I have adapted to create a MARC field looks like this: MARC::Field->new($tag,'','',$subfields) The second and third args were provided as empty strings by the original scripts I am adapting. The marclint program complains that the field indicators #1 and #2 are blank. What should they be? How does one find out? ISSUE #2: bulkmarcimport.pl in Koha 2.2.9 seems to ignore the incorrect field indicators and handles the records as created above just fine. But in K3, the imported does not work. Here is something suspect: print $marcrec->as_usmarc; Is that the correct way to output the MARC record in binary format? Is there really that much difference between USMARC and MARC21? My brief research on the web indicates that the answer to this last question is: "No, not really." Any insight most appreciated. TIA rickw -- ________________________________________________________________ Rick Welykochy || Praxis Services || Internet Driving Instructor When the power of love overcomes the love of power, the world will know peace. -- Jimi Hendrix

2 1

DBIX::Class example of code
by Antoine Farnault 10 Nov '08

10 Nov '08

Hi all, I just want to notify you that here [1] is a a code which is organised exactly like the koha's code and using DBIX::Class. Hope that's help ! [1] http://code.google.com/p/noplagia/source/browse/ -- Antoine FARNAULT

1 0

DBIX::Class example of code
by Antoine Farnault 09 Nov '08

09 Nov '08

Hi all, I just want to notify you that here [1] is a a code which is organised exactly like the koha's code and using DBIX::Class. Hope that's help ! [1] http://code.google.com/p/noplagia/source/browse/ -- Antoine FARNAULT

1 0

Class::DBI vs DBIx::Class
by Rick Welykochy 07 Nov '08

07 Nov '08

First off, a note to Galen. I reported to you that I had experience with DBIx::Class. Make that Class::DBI instead. I am reading up on DBIx::Class now. It seems that DBIx::Class grew out of Class::DBI and might be more sophisticated for our purposes. There is a perl monks comparison of these two here: http://www.perlmonks.org/?node_id=700283 with some pros and cons for each. What I like about Class::DBI is that it created a data model object for each table, i.e. something like Ourspace::Itemtype for the itemtype table. Instances of that object are loaded and initialised from the database. In the examples I have been reading kindly posted by Andrew Moore I am seeing field (attribute) accesses like the following using DBIx::Class ... $row->get_column('cn_source') This is not much different than the following: $hash->{cn_source} IMHO. Part of the advantage in an OR mapper is having first class data model objects, i.e. the above would become: $obj->cn_source and changing the value of the cn_source attribute is accomplished quite simply by $obj->cn_source('new_value') There might be some concern of the extra overhead involved in creating data objects for each database fetch. cheers rick -- ________________________________________________________________ Rick Welykochy || Praxis Services || Internet Driving Instructor When the power of love overcomes the love of power, the world will know peace. -- Jimi Hendrix

4 4