Bug 12461 - Add patron clubs feature
[koha.git] / C4 / Serials / Numberpattern.pm
blob210b8dd48785b282b9a82f639801b90ff97ca1a2
1 package C4::Serials::Numberpattern;
3 # Copyright 2011-2013 Biblibre SARL
5 # This file is part of Koha.
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.
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.
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>.
20 use strict;
21 use warnings;
23 use C4::Context;
25 use vars qw(@ISA @EXPORT);
27 BEGIN {
29 require Exporter;
30 @ISA = qw(Exporter);
31 @EXPORT = qw(
32 &GetSubscriptionNumberpatterns
33 &GetSubscriptionNumberpattern
34 &GetSubscriptionNumberpatternByName
35 &AddSubscriptionNumberpattern
36 &ModSubscriptionNumberpattern
37 &DelSubscriptionNumberpattern
39 &GetSubscriptionsWithNumberpattern
44 =head1 NAME
46 C4::Serials::Numberpattern - Serials numbering pattern module
48 =head1 FUNCTIONS
50 =head2 GetSubscriptionNumberpatterns
52 @results = GetSubscriptionNumberpatterns;
53 this function get all subscription number patterns entered in table
55 =cut
57 sub GetSubscriptionNumberpatterns {
58 my $dbh = C4::Context->dbh;
59 my $query = qq{
60 SELECT *
61 FROM subscription_numberpatterns
62 ORDER by displayorder
64 my $sth = $dbh->prepare($query);
65 $sth->execute;
66 my $results = $sth->fetchall_arrayref({});
68 return @$results;
71 =head2 GetSubscriptionNumberpattern
73 $result = GetSubscriptionNumberpattern($numberpatternid);
74 this function get the data of the subscription numberpatterns which id is $numberpatternid
76 =cut
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 = ?
86 my $sth = $dbh->prepare($query);
87 $sth->execute($numberpatternid);
89 return $sth->fetchrow_hashref;
92 =head2 GetSubscriptionNumberpatternByName
94 $result = GetSubscriptionNumberpatternByName($name);
95 this function get the data of the subscription numberpatterns which name is $name
97 =cut
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 = ?
107 my $sth = $dbh->prepare($query);
108 my $rv = $sth->execute($name);
110 return $sth->fetchrow_hashref;
113 =head2 AddSubscriptionNumberpattern
115 =over 4
117 =item C<$numberpatternid> = &AddSubscriptionNumberpattern($numberpattern)
119 Add a new numberpattern
121 =item C<$frequency> is a hashref that contains values of the number pattern
123 =item Only label and numberingmethod are mandatory
125 =back
127 =cut
129 sub AddSubscriptionNumberpattern {
130 my $numberpattern = shift;
132 unless(
133 ref($numberpattern) eq 'HASH'
134 && defined $numberpattern->{'label'}
135 && $numberpattern->{'label'} ne ''
136 && defined $numberpattern->{'numberingmethod'}
137 && $numberpattern->{'numberingmethod'} ne ''
139 return;
142 my @keys;
143 my @values;
144 foreach (qw/ label description numberingmethod displayorder
145 label1 label2 label3 add1 add2 add3 every1 every2 every3
146 setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
147 numbering1 numbering2 numbering3 /) {
148 if(exists $numberpattern->{$_}) {
149 push @keys, $_;
150 push @values, $numberpattern->{$_};
154 my $dbh = C4::Context->dbh;
155 my $query = "INSERT INTO subscription_numberpatterns";
156 $query .= '(' . join(',', @keys) . ')';
157 $query .= ' VALUES (' . ('?,' x (scalar(@keys)-1)) . '?)';
158 my $sth = $dbh->prepare($query);
159 my $rv = $sth->execute(@values);
161 if(defined $rv) {
162 return $dbh->last_insert_id(undef, undef, "subscription_numberpatterns", undef);
165 return $rv;
168 =head2 ModSubscriptionNumberpattern
170 =over 4
172 =item &ModSubscriptionNumberpattern($numberpattern)
174 Modifies a numberpattern
176 =item C<$frequency> is a hashref that contains values of the number pattern
178 =item Only id is mandatory
180 =back
182 =cut
184 sub ModSubscriptionNumberpattern {
185 my $numberpattern = shift;
187 unless(
188 ref($numberpattern) eq 'HASH'
189 && defined $numberpattern->{'id'}
190 && $numberpattern->{'id'} > 0
191 && (
192 (defined $numberpattern->{'label'}
193 && $numberpattern->{'label'} ne '')
194 || !defined $numberpattern->{'label'}
196 && (
197 (defined $numberpattern->{'numberingmethod'}
198 && $numberpattern->{'numberingmethod'} ne '')
199 || !defined $numberpattern->{'numberingmethod'}
202 return;
205 my @keys;
206 my @values;
207 foreach (qw/ label description numberingmethod displayorder
208 label1 label2 label3 add1 add2 add3 every1 every2 every3
209 setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
210 numbering1 numbering2 numbering3 /) {
211 if(exists $numberpattern->{$_}) {
212 push @keys, $_;
213 push @values, $numberpattern->{$_};
217 my $dbh = C4::Context->dbh;
218 my $query = "UPDATE subscription_numberpatterns";
219 $query .= ' SET ' . join(' = ?,', @keys) . ' = ?';
220 $query .= ' WHERE id = ?';
221 my $sth = $dbh->prepare($query);
223 return $sth->execute(@values, $numberpattern->{'id'});
226 =head2 DelSubscriptionNumberpattern
228 =over 4
230 =item &DelSubscriptionNumberpattern($numberpatternid)
232 Delete a number pattern
234 =back
236 =cut
238 sub DelSubscriptionNumberpattern {
239 my $numberpatternid = shift;
241 my $dbh = C4::Context->dbh;
242 my $query = qq{
243 DELETE FROM subscription_numberpatterns
244 WHERE id = ?
246 my $sth = $dbh->prepare($query);
247 $sth->execute($numberpatternid);
250 =head2 GetSubscriptionsWithNumberpattern
252 my @subs = GetSubscriptionsWithNumberpattern($numberpatternid);
254 Returns all subscriptions that are using a particular numbering pattern
256 =cut
258 sub GetSubscriptionsWithNumberpattern {
259 my ($numberpatternid) = @_;
261 return unless $numberpatternid;
263 my $dbh = C4::Context->dbh;
264 my $query = qq{
265 SELECT *
266 FROM subscription
267 LEFT JOIN biblio ON subscription.biblionumber = biblio.biblionumber
268 WHERE numberpattern = ?
270 my $sth = $dbh->prepare($query);
271 my @results;
272 if ($sth->execute($numberpatternid)) {
273 @results = @{ $sth->fetchall_arrayref({}) };
275 return @results;
281 __END__
283 =head1 AUTHOR
285 Koha Development team <info@koha.org>
287 =cut