Bug 15416: Warns on guided_reports.pl
[koha.git] / C4 / Serials / Numberpattern.pm
blobc7de69a5c12f55ae1ae3d35885984801ec8579ee
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($VERSION @ISA @EXPORT);
27 BEGIN {
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
41 &GetSubscriptionsWithNumberpattern
46 =head1 NAME
48 C4::Serials::Numberpattern - Serials numbering pattern module
50 =head1 FUNCTIONS
52 =head2 GetSubscriptionNumberpatterns
54 @results = GetSubscriptionNumberpatterns;
55 this function get all subscription number patterns entered in table
57 =cut
59 sub GetSubscriptionNumberpatterns {
60 my $dbh = C4::Context->dbh;
61 my $query = qq{
62 SELECT *
63 FROM subscription_numberpatterns
64 ORDER by displayorder
66 my $sth = $dbh->prepare($query);
67 $sth->execute;
68 my $results = $sth->fetchall_arrayref({});
70 return @$results;
73 =head2 GetSubscriptionNumberpattern
75 $result = GetSubscriptionNumberpattern($numberpatternid);
76 this function get the data of the subscription numberpatterns which id is $numberpatternid
78 =cut
80 sub GetSubscriptionNumberpattern {
81 my $numberpatternid = shift;
82 my $dbh = C4::Context->dbh;
83 my $query = qq(
84 SELECT *
85 FROM subscription_numberpatterns
86 WHERE id = ?
88 my $sth = $dbh->prepare($query);
89 $sth->execute($numberpatternid);
91 return $sth->fetchrow_hashref;
94 =head2 GetSubscriptionNumberpatternByName
96 $result = GetSubscriptionNumberpatternByName($name);
97 this function get the data of the subscription numberpatterns which name is $name
99 =cut
101 sub GetSubscriptionNumberpatternByName {
102 my $name = shift;
103 my $dbh = C4::Context->dbh;
104 my $query = qq(
105 SELECT *
106 FROM subscription_numberpatterns
107 WHERE label = ?
109 my $sth = $dbh->prepare($query);
110 my $rv = $sth->execute($name);
112 return $sth->fetchrow_hashref;
115 =head2 AddSubscriptionNumberpattern
117 =over 4
119 =item C<$numberpatternid> = &AddSubscriptionNumberpattern($numberpattern)
121 Add a new numberpattern
123 =item C<$frequency> is a hashref that contains values of the number pattern
125 =item Only label and numberingmethod are mandatory
127 =back
129 =cut
131 sub AddSubscriptionNumberpattern {
132 my $numberpattern = shift;
134 unless(
135 ref($numberpattern) eq 'HASH'
136 && defined $numberpattern->{'label'}
137 && $numberpattern->{'label'} ne ''
138 && defined $numberpattern->{'numberingmethod'}
139 && $numberpattern->{'numberingmethod'} ne ''
141 return;
144 my @keys;
145 my @values;
146 foreach (qw/ label description numberingmethod displayorder
147 label1 label2 label3 add1 add2 add3 every1 every2 every3
148 setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
149 numbering1 numbering2 numbering3 /) {
150 if(exists $numberpattern->{$_}) {
151 push @keys, $_;
152 push @values, $numberpattern->{$_};
156 my $dbh = C4::Context->dbh;
157 my $query = "INSERT INTO subscription_numberpatterns";
158 $query .= '(' . join(',', @keys) . ')';
159 $query .= ' VALUES (' . ('?,' x (scalar(@keys)-1)) . '?)';
160 my $sth = $dbh->prepare($query);
161 my $rv = $sth->execute(@values);
163 if(defined $rv) {
164 return $dbh->last_insert_id(undef, undef, "subscription_numberpatterns", undef);
167 return $rv;
170 =head2 ModSubscriptionNumberpattern
172 =over 4
174 =item &ModSubscriptionNumberpattern($numberpattern)
176 Modifies a numberpattern
178 =item C<$frequency> is a hashref that contains values of the number pattern
180 =item Only id is mandatory
182 =back
184 =cut
186 sub ModSubscriptionNumberpattern {
187 my $numberpattern = shift;
189 unless(
190 ref($numberpattern) eq 'HASH'
191 && defined $numberpattern->{'id'}
192 && $numberpattern->{'id'} > 0
193 && (
194 (defined $numberpattern->{'label'}
195 && $numberpattern->{'label'} ne '')
196 || !defined $numberpattern->{'label'}
198 && (
199 (defined $numberpattern->{'numberingmethod'}
200 && $numberpattern->{'numberingmethod'} ne '')
201 || !defined $numberpattern->{'numberingmethod'}
204 return;
207 my @keys;
208 my @values;
209 foreach (qw/ label description numberingmethod displayorder
210 label1 label2 label3 add1 add2 add3 every1 every2 every3
211 setto1 setto2 setto3 whenmorethan1 whenmorethan2 whenmorethan3
212 numbering1 numbering2 numbering3 /) {
213 if(exists $numberpattern->{$_}) {
214 push @keys, $_;
215 push @values, $numberpattern->{$_};
219 my $dbh = C4::Context->dbh;
220 my $query = "UPDATE subscription_numberpatterns";
221 $query .= ' SET ' . join(' = ?,', @keys) . ' = ?';
222 $query .= ' WHERE id = ?';
223 my $sth = $dbh->prepare($query);
225 return $sth->execute(@values, $numberpattern->{'id'});
228 =head2 DelSubscriptionNumberpattern
230 =over 4
232 =item &DelSubscriptionNumberpattern($numberpatternid)
234 Delete a number pattern
236 =back
238 =cut
240 sub DelSubscriptionNumberpattern {
241 my $numberpatternid = shift;
243 my $dbh = C4::Context->dbh;
244 my $query = qq{
245 DELETE FROM subscription_numberpatterns
246 WHERE id = ?
248 my $sth = $dbh->prepare($query);
249 $sth->execute($numberpatternid);
252 =head2 GetSubscriptionsWithNumberpattern
254 my @subs = GetSubscriptionsWithNumberpattern($numberpatternid);
256 Returns all subscriptions that are using a particular numbering pattern
258 =cut
260 sub GetSubscriptionsWithNumberpattern {
261 my ($numberpatternid) = @_;
263 return unless $numberpatternid;
265 my $dbh = C4::Context->dbh;
266 my $query = qq{
267 SELECT *
268 FROM subscription
269 LEFT JOIN biblio ON subscription.biblionumber = biblio.biblionumber
270 WHERE numberpattern = ?
272 my $sth = $dbh->prepare($query);
273 my @results;
274 if ($sth->execute($numberpatternid)) {
275 @results = @{ $sth->fetchall_arrayref({}) };
277 return @results;
283 __END__
285 =head1 AUTHOR
287 Koha Development team <info@koha.org>
289 =cut