C4/Serials/Numberpattern.pm

   1 package C4::Serials::Numberpattern;
   2
   3 # Copyright 2011-2013 Biblibre SARL
   4 #
   5 # This file is part of Koha.
   6 #
   7 # Koha is free software; you can redistribute it and/or modify it
   8 # under the terms of the GNU General Public License as published by
   9 # the Free Software Foundation; either version 3 of the License, or
  10 # (at your option) any later version.
  11 #
  12 # Koha is distributed in the hope that it will be useful, but
  13 # WITHOUT ANY WARRANTY; without even the implied warranty of
  14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15 # GNU General Public License for more details.
  16 #
  17 # You should have received a copy of the GNU General Public License
  18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
  19
  20 use strict;
  21 use warnings;
  22
  23 use C4::Context;
  24
  25 use vars qw(@ISA @EXPORT);
  26
  27 BEGIN {
  28
  29     require Exporter;
  30     @ISA    = qw(Exporter);
  31     @EXPORT = qw(
  32         &GetSubscriptionNumberpatterns
  33         &GetSubscriptionNumberpattern
  34         &GetSubscriptionNumberpatternByName
  35         &AddSubscriptionNumberpattern
  36         &ModSubscriptionNumberpattern
  37         &DelSubscriptionNumberpattern
  38
  39         &GetSubscriptionsWithNumberpattern
  40     );
  41 }
  42
  43
  44 =head1 NAME
  45
  46 C4::Serials::Numberpattern - Serials numbering pattern module
  47
  48 =head1 FUNCTIONS
  49
  50 =head2 GetSubscriptionNumberpatterns
  51
  52 @results = GetSubscriptionNumberpatterns;
  53 this function get all subscription number patterns entered in table
  54
  55 =cut
  56
  57 sub GetSubscriptionNumberpatterns {
  58     my $dbh = C4::Context->dbh;
  59     my $query = qq{
  60         SELECT *
  61         FROM subscription_numberpatterns
  62         ORDER by displayorder
  63     };
  64     my $sth = $dbh->prepare($query);
  65     $sth->execute;
  66     my $results = $sth->fetchall_arrayref({});
  67
  68     return @$results;
  69 }
  70
  71 =head2 GetSubscriptionNumberpattern
  72
  73 $result = GetSubscriptionNumberpattern($numberpatternid);
  74 this function get the data of the subscription numberpatterns which id is $numberpatternid
  75
  76 =cut
  77
  78 sub GetSubscriptionNumberpattern {
  79     my $numberpatternid = shift;
  80     my $dbh = C4::Context->dbh;
  81     my $query = qq(
  82         SELECT *
  83         FROM subscription_numberpatterns
  84         WHERE id = ?
  85     );
  86     my $sth = $dbh->prepare($query);
  87     $sth->execute($numberpatternid);
  88
  89     return $sth->fetchrow_hashref;
  90 }
  91
  92 =head2 GetSubscriptionNumberpatternByName
  93
  94 $result = GetSubscriptionNumberpatternByName($name);
  95 this function get the data of the subscription numberpatterns which name is $name
  96
  97 =cut
  98
  99 sub GetSubscriptionNumberpatternByName {
 100     my $name = shift;
 101     my $dbh = C4::Context->dbh;
 102     my $query = qq(
 103         SELECT *
 104         FROM subscription_numberpatterns
 105         WHERE label = ?
 106     );
 107     my $sth = $dbh->prepare($query);
 108     my $rv = $sth->execute($name);
 109
 110     return $sth->fetchrow_hashref;
 111 }
 112
 113 =head2 AddSubscriptionNumberpattern
 114
 115 =over 4
 116
 117 =item C<$numberpatternid> = &AddSubscriptionNumberpattern($numberpattern)
 118
 119 Add a new numberpattern
 120
 121 =item C<$frequency> is a hashref that contains values of the number pattern
 122
 123 =item Only label and numberingmethod are mandatory
 124
 125 =back
 126
 127 =cut
 128
 129 sub AddSubscriptionNumberpattern {
 130     my $numberpattern = shift;
 131
 132     unless(
 133       ref($numberpattern) eq 'HASH'
 134       && defined $numberpattern->{'label'}
 135       && $numberpattern->{'label'} ne ''
 136       && defined $numberpattern->{'numberingmethod'}
 137       && $numberpattern->{'numberingmethod'} ne ''
 138     ) {
 139         return;
 140     }
 141
 142     # FIXME label, description and numberingmethod must be mandatory
 143     my @keys;
 144     my @values;
 145     foreach (qw/ label description numberingmethod displayorder
 146       label1 label2 label3 add1 add2 add3 every1 every2 every3
 147       setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
 148       numbering1 numbering2 numbering3 /) {
 149         if(exists $numberpattern->{$_}) {
 150             push @keys, $_;
 151             push @values, $numberpattern->{$_};
 152         }
 153     }
 154
 155     my $dbh = C4::Context->dbh;
 156     my $query = "INSERT INTO subscription_numberpatterns";
 157     $query .= '(' . join(',', @keys) . ')';
 158     $query .= ' VALUES (' . ('?,' x (scalar(@keys)-1)) . '?)';
 159     my $sth = $dbh->prepare($query);
 160     my $rv = $sth->execute(@values);
 161
 162     if(defined $rv) {
 163         return $dbh->last_insert_id(undef, undef, "subscription_numberpatterns", undef);
 164     }
 165
 166     return $rv;
 167 }
 168
 169 =head2 ModSubscriptionNumberpattern
 170
 171 =over 4
 172
 173 =item &ModSubscriptionNumberpattern($numberpattern)
 174
 175 Modifies a numberpattern
 176
 177 =item C<$frequency> is a hashref that contains values of the number pattern
 178
 179 =item Only id is mandatory
 180
 181 =back
 182
 183 =cut
 184
 185 sub ModSubscriptionNumberpattern {
 186     my $numberpattern = shift;
 187
 188     unless(
 189       ref($numberpattern) eq 'HASH'
 190       && defined $numberpattern->{'id'}
 191       && $numberpattern->{'id'} > 0
 192       && (
 193         (defined $numberpattern->{'label'}
 194         && $numberpattern->{'label'} ne '')
 195         || !defined $numberpattern->{'label'}
 196       )
 197       && (
 198         (defined $numberpattern->{'numberingmethod'}
 199         && $numberpattern->{'numberingmethod'} ne '')
 200         || !defined $numberpattern->{'numberingmethod'}
 201       )
 202     ) {
 203         return;
 204     }
 205
 206     my @keys;
 207     my @values;
 208     foreach (qw/ label description numberingmethod displayorder
 209       label1 label2 label3 add1 add2 add3 every1 every2 every3
 210       setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
 211       numbering1 numbering2 numbering3 /) {
 212         if(exists $numberpattern->{$_}) {
 213             push @keys, $_;
 214             push @values, $numberpattern->{$_};
 215         }
 216     }
 217
 218     my $dbh = C4::Context->dbh;
 219     my $query = "UPDATE subscription_numberpatterns";
 220     $query .= ' SET ' . join(' = ?,', @keys) . ' = ?';
 221     $query .= ' WHERE id = ?';
 222     my $sth = $dbh->prepare($query);
 223
 224     return $sth->execute(@values, $numberpattern->{'id'});
 225 }
 226
 227 =head2 DelSubscriptionNumberpattern
 228
 229 =over 4
 230
 231 =item &DelSubscriptionNumberpattern($numberpatternid)
 232
 233 Delete a number pattern
 234
 235 =back
 236
 237 =cut
 238
 239 sub DelSubscriptionNumberpattern {
 240     my $numberpatternid = shift;
 241
 242     my $dbh = C4::Context->dbh;
 243     my $query = qq{
 244         DELETE FROM subscription_numberpatterns
 245         WHERE id = ?
 246     };
 247     my $sth = $dbh->prepare($query);
 248     $sth->execute($numberpatternid);
 249 }
 250
 251 =head2 GetSubscriptionsWithNumberpattern
 252
 253     my @subs = GetSubscriptionsWithNumberpattern($numberpatternid);
 254
 255 Returns all subscriptions that are using a particular numbering pattern
 256
 257 =cut
 258
 259 sub GetSubscriptionsWithNumberpattern {
 260     my ($numberpatternid) = @_;
 261
 262     return unless $numberpatternid;
 263
 264     my $dbh = C4::Context->dbh;
 265     my $query = qq{
 266         SELECT *
 267         FROM subscription
 268           LEFT JOIN biblio ON subscription.biblionumber = biblio.biblionumber
 269         WHERE numberpattern = ?
 270     };
 271     my $sth = $dbh->prepare($query);
 272     my @results;
 273     if ($sth->execute($numberpatternid)) {
 274         @results = @{ $sth->fetchall_arrayref({}) };
 275     }
 276     return @results;
 277 }
 278
 279
 280 1;
 281
 282 __END__
 283
 284 =head1 AUTHOR
 285
 286 Koha Development team <info@koha.org>
 287
 288 =cut