Fix FSF address in directory tools/
[koha.git] / tools / letter.pl
blob0f5113d77b4336559b340c986298db00fd4f2cab
1 #!/usr/bin/perl
3 # Copyright 2000-2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
20 =head1 tools/letter.pl
22 ALGO :
23 this script use an $op to know what to do.
24 if $op is empty or none of the values listed below,
25 - the default screen is built (with all or filtered (if search string is set) records).
26 - the user can click on add, modify or delete record.
27 - filtering is done on the code field
28 if $op=add_form
29 - if primary key (module + code) exists, this is a modification,so we read the required record
30 - builds the add/modify form
31 if $op=add_validate
32 - the user has just send data, so we create/modify the record
33 if $op=delete_form
34 - we show the record selected and ask for confirmation
35 if $op=delete_confirm
36 - we delete the designated record
38 =cut
39 # TODO This script drives the CRUD operations on the letter table
40 # The DB interaction should be handled by calls to C4/Letters.pm
42 use strict;
43 use warnings;
44 use CGI;
45 use C4::Auth;
46 use C4::Context;
47 use C4::Output;
49 sub StringSearch {
50 my ($searchstring) = @_;
51 my $dbh = C4::Context->dbh;
52 $searchstring =~ s/\'/\\\'/g;
53 my @data = split( ' ', $searchstring );
54 $data[0] = '' unless @data;
55 my $sth = $dbh->prepare("SELECT * FROM letter WHERE (code LIKE ?) ORDER BY module, code");
56 $sth->execute("$data[0]%"); # slightly bogus, only searching on first string.
57 return $sth->fetchall_arrayref({});
60 # FIXME untranslateable
61 our %column_map = (
62 aqbooksellers => 'BOOKSELLERS',
63 aqorders => 'ORDERS',
64 serial => 'SERIALS',
65 reserves => 'HOLDS',
66 suggestions => 'SUGGESTIONS',
69 sub column_picks ($) {
70 # returns @array of values
71 my $table = shift or return ();
72 my $sth = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
73 $sth->execute;
74 my @SQLfieldname = ();
75 push @SQLfieldname, {'value' => "", 'text' => '---' . uc($column_map{$table} || $table) . '---'};
76 while (my ($field) = $sth->fetchrow_array) {
77 push @SQLfieldname, {
78 value => $table . ".$field",
79 text => $table . ".$field"
82 return @SQLfieldname;
85 # letter_exists($module, $code)
86 # - return true if a letter with the given $module and $code exists
87 sub letter_exists {
88 my ($module, $code) = @_;
89 my $dbh = C4::Context->dbh;
90 my $letters = $dbh->selectall_arrayref(q{SELECT name FROM letter WHERE module = ? AND code = ?}, undef, $module, $code);
91 return @{$letters};
94 # $protected_letters = protected_letters()
95 # - return a hashref of letter_codes representing letters that should never be deleted
96 sub protected_letters {
97 my $dbh = C4::Context->dbh;
98 my $codes = $dbh->selectall_arrayref(q{SELECT DISTINCT letter_code FROM message_transports});
99 return { map { $_->[0] => 1 } @{$codes} };
102 my $input = new CGI;
103 my $searchfield = $input->param('searchfield');
104 my $script_name = '/cgi-bin/koha/tools/letter.pl';
105 my $code = $input->param('code');
106 my $module = $input->param('module');
107 my $content = $input->param('content');
108 my $op = $input->param('op');
109 my $dbh = C4::Context->dbh;
110 if (!defined $module ) {
111 $module = q{};
114 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
116 template_name => 'tools/letter.tmpl',
117 query => $input,
118 type => 'intranet',
119 authnotrequired => 0,
120 flagsrequired => { tools => 'edit_notices' },
121 debug => 1,
125 if (!defined $op) {
126 $op = q{}; # silence errors from eq
128 # we show only the TMPL_VAR names $op
130 $template->param(
131 script_name => $script_name,
132 action => $script_name
135 if ($op eq 'add_form') {
136 add_form($module, $code);
138 elsif ( $op eq 'add_validate' ) {
139 add_validate();
140 $op = q{}; # next operation is to return to default screen
142 elsif ( $op eq 'delete_confirm' ) {
143 delete_confirm($module, $code);
145 elsif ( $op eq 'delete_confirmed' ) {
146 delete_confirmed($module, $code);
147 $op = q{}; # next operation is to return to default screen
149 else {
150 default_display($searchfield);
153 # Do this last as delete_confirmed resets
154 if ($op) {
155 $template->param($op => 1);
156 } else {
157 $template->param(no_op_set => 1);
160 output_html_with_http_headers $input, $cookie, $template->output;
162 sub add_form {
163 my ($module, $code ) = @_;
165 my $letter;
166 # if code has been passed we can identify letter and its an update action
167 if ($code) {
168 $letter = $dbh->selectrow_hashref(q{SELECT module, code, name, title, content FROM letter WHERE module=? AND code=?},
169 undef, $module, $code);
170 $template->param( modify => 1 );
171 $template->param( code => $letter->{code} );
173 else { # initialize the new fields
174 $letter = {
175 module => $module,
176 code => q{},
177 name => q{},
178 title => q{},
179 content => q{},
181 $template->param( adding => 1 );
184 # add acquisition specific tables
185 my @SQLfieldname;
186 my $field_selection;
187 if ( $module eq "suggestions" ) {
188 push @SQLfieldname, column_picks('borrowers'),
189 column_picks('suggestions'),
190 column_picks('aqbooksellers'),
191 column_picks('biblio'),
192 column_picks('items');
194 elsif ( $module eq "reserves" ) {
195 push @SQLfieldname, column_picks('borrowers'),
196 column_picks('reserves'),
197 column_picks('biblio'),
198 column_picks('items');
200 elsif ( index( $module, "acquisition" ) > 0 ) { # FIXME: imprecise comparison
201 push @SQLfieldname, column_picks('aqbooksellers'), column_picks('aqorders');
202 # add issues specific tables
204 push @{$field_selection}, add_fields('branches');
205 if ($module eq 'reserves') {
206 push @{$field_selection}, add_fields('borrowers', 'reserves', 'biblio', 'items');
208 elsif ($module eq 'claimacquisition') {
209 push @{$field_selection}, add_fields('aqbooksellers', 'aqorders');
211 elsif ($module eq 'claimissues') {
212 push @{$field_selection}, add_fields('aqbooksellers', 'serial', 'subscription');
213 push @{$field_selection},
215 value => q{},
216 text => '---BIBLIO---'
218 foreach(qw(title author serial)) {
219 push @{$field_selection}, {value => "biblio.$_", text => ucfirst $_ };
222 else {
223 push @{$field_selection}, add_fields('biblio','biblioitems'),
224 {value => q{}, text => '---ITEMS---' },
225 {value => 'items.content', text => 'items.content'},
226 add_fields('borrowers');
229 $template->param(
230 name => $letter->{name},
231 title => $letter->{title},
232 content => $letter->{content},
233 $module => 1,
234 SQLfieldname => $field_selection,
236 return;
239 sub add_validate {
240 my $dbh = C4::Context->dbh;
241 my $module = $input->param('module');
242 my $code = $input->param('code');
243 my $name = $input->param('name');
244 my $title = $input->param('title');
245 my $content = $input->param('content');
246 if (letter_exists($module, $code)) {
247 $dbh->do(
248 q{UPDATE letter SET module = ?, code = ?, name = ?, title = ?, content = ? WHERE module = ? AND code = ?},
249 undef,
250 $module, $code, $name, $title, $content,
251 $module, $code
253 } else {
254 $dbh->do(
255 q{INSERT INTO letter (module,code,name,title,content) VALUES (?,?,?,?,?)},
256 undef,
257 $module, $code, $name, $title, $content
260 # set up default display
261 default_display();
262 return;
265 sub delete_confirm {
266 my ($module, $code) = @_;
267 my $dbh = C4::Context->dbh;
268 my $letter = $dbh->selectrow_hashref(q|SELECT name FROM letter WHERE module = ? AND code = ?|,
269 { Slice => {} },
270 $module, $code);
271 $template->param( code => $code );
272 $template->param( module => $module);
273 $template->param( name => $letter->{name});
274 return;
277 sub delete_confirmed {
278 my ($module, $code) = @_;
279 my $dbh = C4::Context->dbh;
280 $dbh->do('DELETE FROM letter WHERE module=? AND code=?',{},$module,$code);
281 # setup default display for screen
282 default_display();
283 return;
286 sub retrieve_letters {
287 my $searchstring = shift;
288 my $dbh = C4::Context->dbh;
289 if ($searchstring) {
290 if ($searchstring=~m/(\S+)/) {
291 $searchstring = $1 . q{%};
292 return $dbh->selectall_arrayref('SELECT module, code, name FROM letter WHERE code LIKE ? ORDER BY module, code',
293 { Slice => {} }, $searchstring);
296 else {
297 return $dbh->selectall_arrayref('SELECT module, code, name FROM letter ORDER BY module, code', { Slice => {} });
299 return;
302 sub default_display {
303 my $searchfield = shift;
304 my $results;
305 if ( $searchfield ) {
306 $template->param( search => 1 );
307 $template->param( searchfield => $searchfield );
308 $results = retrieve_letters($searchfield);
309 } else {
310 $results = retrieve_letters();
312 my $loop_data = [];
313 my $protected_letters = protected_letters();
314 foreach my $row (@{$results}) {
315 $row->{protected} = $protected_letters->{ $row->{code}};
316 push @{$loop_data}, $row;
319 $template->param( letter => $loop_data );
320 return;
323 sub add_fields {
324 my @tables = @_;
325 my @fields = ();
327 for my $table (@tables) {
328 push @fields, get_columns_for($table);
331 return @fields;
334 sub get_columns_for {
335 my $table = shift;
336 # FIXME untranslateable
337 my %column_map = (
338 aqbooksellers => '---BOOKSELLERS---',
339 aqorders => '---ORDERS---',
340 serial => '---SERIALS---',
341 reserves => '---HOLDS---',
343 my @fields = ();
344 if (exists $column_map{$table} ) {
345 push @fields, {
346 value => q{},
347 text => $column_map{$table} ,
350 else {
351 my $tlabel = '---' . uc $table;
352 $tlabel.= '---';
353 push @fields, {
354 value => q{},
355 text => $tlabel,
358 my $sql = "SHOW COLUMNS FROM $table";# TODO not db agnostic
359 my $table_prefix = $table . q|.|;
360 my $rows = C4::Context->dbh->selectall_arrayref($sql, { Slice => {} });
361 for my $row (@{$rows}) {
362 push @fields, {
363 value => $table_prefix . $row->{Field},
364 text => $table_prefix . $row->{Field},
367 return @fields;