C4/Serials/Numberpattern.pm

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