tools/letter.pl

   1 #!/usr/bin/perl
   2
   3 # Copyright 2000-2002 Katipo Communications
   4 #
   5 # This file is part of Koha.
   6 #
   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.
  11 #
  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.
  15 #
  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.
  19
  20 =head1 tools/letter.pl
  21
  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
  37
  38 =cut
  39
  40 # TODO This script drives the CRUD operations on the letter table
  41 # The DB interaction should be handled by calls to C4/Letters.pm
  42
  43 use strict;
  44 use warnings;
  45 use CGI;
  46 use C4::Auth;
  47 use C4::Context;
  48 use C4::Output;
  49
  50 sub StringSearch {
  51     my ($searchstring) = @_;
  52     my $dbh = C4::Context->dbh;
  53     $searchstring =~ s/\'/\\\'/g;
  54     my @data = split( ' ', $searchstring );
  55     $data[0] = '' unless @data;
  56     my $sth = $dbh->prepare("SELECT * FROM letter WHERE (code LIKE ?) ORDER BY module, code");
  57     $sth->execute("$data[0]%");     # slightly bogus, only searching on first string.
  58     return $sth->fetchall_arrayref({});
  59 }
  60
  61 # FIXME untranslateable
  62 our %column_map = (
  63     aqbooksellers => 'BOOKSELLERS',
  64     aqorders => 'ORDERS',
  65     serial => 'SERIALS',
  66     reserves => 'HOLDS',
  67     suggestions => 'SUGGESTIONS',
  68 );
  69
  70 sub column_picks ($) {
  71     # returns @array of values
  72     my $table = shift or return ();
  73     my $sth = C4::Context->dbh->prepare("SHOW COLUMNS FROM $table");
  74     $sth->execute;
  75     my @SQLfieldname = ();
  76     push @SQLfieldname, {'value' => "", 'text' => '---' . uc($column_map{$table} || $table) . '---'};
  77     while (my ($field) = $sth->fetchrow_array) {
  78         push @SQLfieldname, {
  79             value => $table . ".$field",
  80              text => $table . ".$field"
  81         };
  82     }
  83     return @SQLfieldname;
  84 }
  85
  86 # letter_exists($module, $code)
  87 # - return true if a letter with the given $module and $code exists
  88 sub letter_exists {
  89     my ($module, $code) = @_;
  90     my $dbh = C4::Context->dbh;
  91     my $letters = $dbh->selectall_arrayref(q{SELECT name FROM letter WHERE module = ? AND code = ?}, undef, $module, $code);
  92     return @{$letters};
  93 }
  94
  95 # $protected_letters = protected_letters()
  96 # - return a hashref of letter_codes representing letters that should never be deleted
  97 sub protected_letters {
  98     my $dbh = C4::Context->dbh;
  99     my $codes = $dbh->selectall_arrayref(q{SELECT DISTINCT letter_code FROM message_transports});
 100     return { map { $_->[0] => 1 } @{$codes} };
 101 }
 102
 103 my $input       = new CGI;
 104 my $searchfield = $input->param('searchfield');
 105 my $script_name = '/cgi-bin/koha/tools/letter.pl';
 106 my $code        = $input->param('code');
 107 my $module      = $input->param('module');
 108 my $content     = $input->param('content');
 109 my $op          = $input->param('op');
 110 my $dbh = C4::Context->dbh;
 111 if (!defined $module ) {
 112     $module = q{};
 113 }
 114
 115 my ( $template, $borrowernumber, $cookie ) = get_template_and_user(
 116     {
 117         template_name   => 'tools/letter.tmpl',
 118         query           => $input,
 119         type            => 'intranet',
 120         authnotrequired => 0,
 121         flagsrequired   => { tools => 'edit_notices' },
 122         debug           => 1,
 123     }
 124 );
 125
 126 if (!defined $op) {
 127     $op = q{}; # silence errors from eq
 128 }
 129 # we show only the TMPL_VAR names $op
 130
 131 $template->param(
 132         script_name => $script_name,
 133         action => $script_name
 134 );
 135
 136 if ($op eq 'add_form') {
 137     add_form($module, $code);
 138 }
 139 elsif ( $op eq 'add_validate' ) {
 140     add_validate();
 141     $op = q{}; # next operation is to return to default screen
 142 }
 143 elsif ( $op eq 'delete_confirm' ) {
 144     delete_confirm($module, $code);
 145 }
 146 elsif ( $op eq 'delete_confirmed' ) {
 147     delete_confirmed($module, $code);
 148     $op = q{}; # next operation is to return to default screen
 149 }
 150 else {
 151     default_display($searchfield);
 152 }
 153
 154 # Do this last as delete_confirmed resets
 155 if ($op) {
 156     $template->param($op  => 1);
 157 } else {
 158     $template->param(no_op_set => 1);
 159 }
 160
 161 output_html_with_http_headers $input, $cookie, $template->output;
 162
 163 sub add_form {
 164     my ($module, $code ) = @_;
 165
 166     my $letter;
 167     # if code has been passed we can identify letter and its an update action
 168     if ($code) {
 169         $letter = $dbh->selectrow_hashref(q{SELECT module, code, name, title, content FROM letter WHERE module=? AND code=?},
 170             undef, $module, $code);
 171         $template->param( modify => 1 );
 172         $template->param( code   => $letter->{code} );
 173     }
 174     else { # initialize the new fields
 175         $letter = {
 176             module  => $module,
 177             code    => q{},
 178             name    => q{},
 179             title   => q{},
 180             content => q{},
 181         };
 182         $template->param( adding => 1 );
 183     }
 184
 185     # add acquisition specific tables
 186     my @SQLfieldname;
 187     my $field_selection;
 188     if ( $module eq "suggestions" ) {
 189         push @SQLfieldname, column_picks('borrowers'),
 190                             column_picks('suggestions'),
 191                             column_picks('aqbooksellers'),
 192                             column_picks('biblio'),
 193                             column_picks('items');
 194         }
 195     elsif ( $module eq "reserves" ) {
 196         push @SQLfieldname, column_picks('borrowers'),
 197                             column_picks('reserves'),
 198                             column_picks('biblio'),
 199                             column_picks('items');
 200     }
 201     elsif ( index( $module, "acquisition" ) > 0 ) {     # FIXME: imprecise comparison
 202         push @SQLfieldname, column_picks('aqbooksellers'), column_picks('aqorders');
 203         # add issues specific tables
 204     }
 205     push @{$field_selection}, add_fields('branches');
 206     if ($module eq 'reserves') {
 207         push @{$field_selection}, add_fields('borrowers', 'reserves', 'biblio', 'items');
 208     }
 209     elsif ($module eq 'claimacquisition') {
 210         push @{$field_selection}, add_fields('aqbooksellers', 'aqorders');
 211     }
 212     elsif ($module eq 'claimissues') {
 213         push @{$field_selection}, add_fields('aqbooksellers', 'serial', 'subscription');
 214         push @{$field_selection},
 215         {
 216             value => q{},
 217             text => '---BIBLIO---'
 218         };
 219         foreach(qw(title author serial)) {
 220             push @{$field_selection}, {value => "biblio.$_", text => ucfirst $_ };
 221         }
 222     }
 223     else {
 224         push @{$field_selection}, add_fields('biblio','biblioitems'),
 225             {value => q{},             text => '---ITEMS---'  },
 226             {value => 'items.content', text => 'items.content'},
 227             add_fields('borrowers');
 228     }
 229
 230     $template->param(
 231         name    => $letter->{name},
 232         title   => $letter->{title},
 233         content => $letter->{content},
 234         $module => 1,
 235         SQLfieldname => $field_selection,
 236     );
 237     return;
 238 }
 239
 240 sub add_validate {
 241     my $dbh     = C4::Context->dbh;
 242     my $module  = $input->param('module');
 243     my $code    = $input->param('code');
 244     my $name    = $input->param('name');
 245     my $title   = $input->param('title');
 246     my $content = $input->param('content');
 247     if (letter_exists($module, $code)) {
 248         $dbh->do(
 249             q{UPDATE letter SET module = ?, code = ?, name = ?, title = ?, content = ? WHERE module = ? AND code = ?},
 250             undef,
 251             $module, $code, $name, $title, $content,
 252             $module, $code
 253         );
 254     } else {
 255         $dbh->do(
 256             q{INSERT INTO letter (module,code,name,title,content) VALUES (?,?,?,?,?)},
 257             undef,
 258             $module, $code, $name, $title, $content
 259         );
 260     }
 261     # set up default display
 262     default_display();
 263     return;
 264 }
 265
 266 sub delete_confirm {
 267     my ($module, $code) = @_;
 268     my $dbh = C4::Context->dbh;
 269     my $letter = $dbh->selectrow_hashref(q|SELECT  name FROM letter WHERE module = ? AND code = ?|,
 270         { Slice => {} },
 271         $module, $code);
 272     $template->param( code => $code );
 273     $template->param( module => $module);
 274     $template->param( name => $letter->{name});
 275     return;
 276 }
 277
 278 sub delete_confirmed {
 279     my ($module, $code) = @_;
 280     my $dbh    = C4::Context->dbh;
 281     $dbh->do('DELETE FROM letter WHERE module=? AND code=?',{},$module,$code);
 282     # setup default display for screen
 283     default_display();
 284     return;
 285 }
 286
 287 sub retrieve_letters {
 288     my $searchstring = shift;
 289     my $dbh = C4::Context->dbh;
 290     if ($searchstring) {
 291         if ($searchstring=~m/(\S+)/) {
 292             $searchstring = $1 . q{%};
 293             return $dbh->selectall_arrayref('SELECT module, code, name FROM letter WHERE code LIKE ? ORDER BY module, code',
 294                 { Slice => {} }, $searchstring);
 295         }
 296     }
 297     else {
 298         return $dbh->selectall_arrayref('SELECT module, code, name FROM letter ORDER BY module, code', { Slice => {} });
 299     }
 300     return;
 301 }
 302
 303 sub default_display {
 304     my $searchfield = shift;
 305     my $results;
 306     if ( $searchfield  ) {
 307         $template->param( search      => 1 );
 308         $template->param( searchfield => $searchfield );
 309         $results = retrieve_letters($searchfield);
 310     } else {
 311         $results = retrieve_letters();
 312     }
 313     my $loop_data = [];
 314     my $protected_letters = protected_letters();
 315     foreach my $row (@{$results}) {
 316         $row->{protected} = $protected_letters->{ $row->{code}};
 317         push @{$loop_data}, $row;
 318
 319     }
 320     $template->param( letter => $loop_data );
 321     return;
 322 }
 323
 324 sub add_fields {
 325     my @tables = @_;
 326     my @fields = ();
 327
 328     for my $table (@tables) {
 329         push @fields, get_columns_for($table);
 330
 331     }
 332     return @fields;
 333 }
 334
 335 sub get_columns_for {
 336     my $table = shift;
 337 # FIXME untranslateable
 338     my %column_map = (
 339         aqbooksellers => '---BOOKSELLERS---',
 340         aqorders      => '---ORDERS---',
 341         serial        => '---SERIALS---',
 342         reserves      => '---HOLDS---',
 343     );
 344     my @fields = ();
 345     if (exists $column_map{$table} ) {
 346         push @fields, {
 347             value => q{},
 348             text  => $column_map{$table} ,
 349         };
 350     }
 351     else {
 352         my $tlabel = '---' . uc $table;
 353         $tlabel.= '---';
 354         push @fields, {
 355             value => q{},
 356             text  => $tlabel,
 357         };
 358     }
 359     my $sql = "SHOW COLUMNS FROM $table";# TODO not db agnostic
 360     my $table_prefix = $table . q|.|;
 361     my $rows = C4::Context->dbh->selectall_arrayref($sql, { Slice => {} });
 362     for my $row (@{$rows}) {
 363         push @fields, {
 364             value => $table_prefix . $row->{Field},
 365             text  => $table_prefix . $row->{Field},
 366         }
 367     }
 368     return @fields;
 369 }