C4/Budgets.pm

   1 package C4::Budgets;
   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 use strict;
  21 #use warnings; FIXME - Bug 2505
  22 use C4::Context;
  23 use Koha::Database;
  24 use C4::Debug;
  25 use vars qw($VERSION @ISA @EXPORT);
  26
  27 BEGIN {
  28         # set the version for version checking
  29     $VERSION = 3.07.00.049;
  30         require Exporter;
  31         @ISA    = qw(Exporter);
  32         @EXPORT = qw(
  33
  34         &GetBudget
  35         &GetBudgetByOrderNumber
  36         &GetBudgetByCode
  37         &GetBudgets
  38         &GetBudgetHierarchy
  39             &AddBudget
  40         &ModBudget
  41         &DelBudget
  42         &GetBudgetSpent
  43         &GetBudgetOrdered
  44         &GetBudgetName
  45         &GetPeriodsCount
  46         GetBudgetHierarchySpent
  47         GetBudgetHierarchyOrdered
  48
  49         &GetBudgetUsers
  50         &ModBudgetUsers
  51         &CanUserUseBudget
  52         &CanUserModifyBudget
  53
  54             &GetBudgetPeriod
  55         &GetBudgetPeriods
  56         &ModBudgetPeriod
  57         &AddBudgetPeriod
  58             &DelBudgetPeriod
  59
  60         &ModBudgetPlan
  61
  62         &GetCurrency
  63         &GetCurrencies
  64         &ModCurrencies
  65         &ConvertCurrency
  66
  67                 &GetBudgetsPlanCell
  68         &AddBudgetPlanValue
  69         &GetBudgetAuthCats
  70         &BudgetHasChildren
  71         &CheckBudgetParent
  72         &CheckBudgetParentPerm
  73
  74         &HideCols
  75         &GetCols
  76         );
  77 }
  78
  79 # ----------------------------BUDGETS.PM-----------------------------";
  80
  81
  82 =head1 FUNCTIONS ABOUT BUDGETS
  83
  84 =cut
  85
  86 sub HideCols {
  87     my ( $authcat, @hide_cols ) = @_;
  88     my $dbh = C4::Context->dbh;
  89
  90     my $sth1 = $dbh->prepare(
  91         qq|
  92         UPDATE aqbudgets_planning SET display = 0
  93         WHERE authcat = ?
  94         AND  authvalue = ? |
  95     );
  96     foreach my $authvalue (@hide_cols) {
  97 #        $sth1->{TraceLevel} = 3;
  98         $sth1->execute(  $authcat, $authvalue );
  99     }
 100 }
 101
 102 sub GetCols {
 103     my ( $authcat, $authvalue ) = @_;
 104
 105     my $dbh = C4::Context->dbh;
 106     my $sth = $dbh->prepare(
 107         qq|
 108         SELECT count(display) as cnt from aqbudgets_planning
 109         WHERE  authcat = ?
 110         AND authvalue = ? and display  = 0   |
 111     );
 112
 113 #    $sth->{TraceLevel} = 3;
 114     $sth->execute( $authcat, $authvalue );
 115     my $res  = $sth->fetchrow_hashref;
 116
 117     return  $res->{cnt} > 0 ? 0: 1
 118
 119 }
 120
 121 sub CheckBudgetParentPerm {
 122     my ( $budget, $borrower_id ) = @_;
 123     my $depth = $budget->{depth};
 124     my $parent_id = $budget->{budget_parent_id};
 125     while ($depth) {
 126         my $parent = GetBudget($parent_id);
 127         $parent_id = $parent->{budget_parent_id};
 128         if ( $parent->{budget_owner_id} == $borrower_id ) {
 129             return 1;
 130         }
 131         $depth--
 132     }
 133     return 0;
 134 }
 135
 136 sub AddBudgetPeriod {
 137     my ($budgetperiod) = @_;
 138     return unless($budgetperiod->{budget_period_startdate} && $budgetperiod->{budget_period_enddate});
 139
 140     my $resultset = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
 141     return $resultset->create($budgetperiod)->id;
 142 }
 143 # -------------------------------------------------------------------
 144 sub GetPeriodsCount {
 145     my $dbh = C4::Context->dbh;
 146     my $sth = $dbh->prepare("
 147         SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
 148     $sth->execute();
 149     my $res = $sth->fetchrow_hashref;
 150     return $res->{'sum'};
 151 }
 152
 153 # -------------------------------------------------------------------
 154 sub CheckBudgetParent {
 155     my ( $new_parent, $budget ) = @_;
 156     my $new_parent_id = $new_parent->{'budget_id'};
 157     my $budget_id     = $budget->{'budget_id'};
 158     my $dbh           = C4::Context->dbh;
 159     my $parent_id_tmp = $new_parent_id;
 160
 161     # check new-parent is not a child (or a child's child ;)
 162     my $sth = $dbh->prepare(qq|
 163         SELECT budget_parent_id FROM
 164             aqbudgets where budget_id = ? | );
 165     while (1) {
 166         $sth->execute($parent_id_tmp);
 167         my $res = $sth->fetchrow_hashref;
 168         if ( $res->{'budget_parent_id'} == $budget_id ) {
 169             return 1;
 170         }
 171         if ( not defined $res->{'budget_parent_id'} ) {
 172             return 0;
 173         }
 174         $parent_id_tmp = $res->{'budget_parent_id'};
 175     }
 176 }
 177
 178 # -------------------------------------------------------------------
 179 sub BudgetHasChildren {
 180     my ( $budget_id  ) = @_;
 181     my $dbh = C4::Context->dbh;
 182     my $sth = $dbh->prepare(qq|
 183        SELECT count(*) as sum FROM  aqbudgets
 184         WHERE budget_parent_id = ?   | );
 185     $sth->execute( $budget_id );
 186     my $sum = $sth->fetchrow_hashref;
 187     return $sum->{'sum'};
 188 }
 189
 190 # -------------------------------------------------------------------
 191 sub GetBudgetsPlanCell {
 192     my ( $cell, $period, $budget ) = @_;
 193     my ($actual, $sth);
 194     my $dbh = C4::Context->dbh;
 195     if ( $cell->{'authcat'} eq 'MONTHS' ) {
 196         # get the actual amount
 197         $sth = $dbh->prepare( qq|
 198
 199             SELECT SUM(ecost) AS actual FROM aqorders
 200                 WHERE    budget_id = ? AND
 201                 entrydate like "$cell->{'authvalue'}%"  |
 202         );
 203         $sth->execute( $cell->{'budget_id'} );
 204     } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
 205         # get the actual amount
 206         $sth = $dbh->prepare( qq|
 207
 208             SELECT SUM(ecost) FROM aqorders
 209                 LEFT JOIN aqorders_items
 210                 ON (aqorders.ordernumber = aqorders_items.ordernumber)
 211                 LEFT JOIN items
 212                 ON (aqorders_items.itemnumber = items.itemnumber)
 213                 WHERE budget_id = ? AND homebranch = ? |          );
 214
 215         $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
 216     } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
 217         # get the actual amount
 218         $sth = $dbh->prepare(  qq|
 219
 220             SELECT SUM( ecost *  quantity) AS actual
 221                 FROM aqorders JOIN biblioitems
 222                 ON (biblioitems.biblionumber = aqorders.biblionumber )
 223                 WHERE aqorders.budget_id = ? and itemtype  = ? |
 224         );
 225         $sth->execute(  $cell->{'budget_id'},
 226                         $cell->{'authvalue'} );
 227     }
 228     # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
 229     else {
 230         # get the actual amount
 231         $sth = $dbh->prepare( qq|
 232
 233         SELECT  SUM(ecost * quantity) AS actual
 234             FROM aqorders
 235             JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
 236             WHERE  aqorders.budget_id = ? AND
 237                 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
 238                 (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
 239         );
 240         $sth->execute(  $cell->{'budget_id'},
 241                         $budget->{'sort1_authcat'},
 242                         $cell->{'authvalue'},
 243                         $budget->{'sort2_authcat'},
 244                         $cell->{'authvalue'}
 245         );
 246     }
 247     $actual = $sth->fetchrow_array;
 248
 249     # get the estimated amount
 250     $sth = $dbh->prepare( qq|
 251
 252         SELECT estimated_amount AS estimated, display FROM aqbudgets_planning
 253             WHERE budget_period_id = ? AND
 254                 budget_id = ? AND
 255                 authvalue = ? AND
 256                 authcat = ?         |
 257     );
 258     $sth->execute(  $cell->{'budget_period_id'},
 259                     $cell->{'budget_id'},
 260                     $cell->{'authvalue'},
 261                     $cell->{'authcat'},
 262     );
 263
 264
 265     my $res  = $sth->fetchrow_hashref;
 266   #  my $display = $res->{'display'};
 267     my $estimated = $res->{'estimated'};
 268
 269
 270     return $actual, $estimated;
 271 }
 272
 273 # -------------------------------------------------------------------
 274 sub ModBudgetPlan {
 275     my ( $budget_plan, $budget_period_id, $authcat ) = @_;
 276     my $dbh = C4::Context->dbh;
 277     foreach my $buds (@$budget_plan) {
 278         my $lines = $buds->{lines};
 279         my $sth = $dbh->prepare( qq|
 280                 DELETE FROM aqbudgets_planning
 281                     WHERE   budget_period_id   = ? AND
 282                             budget_id   = ? AND
 283                             authcat            = ? |
 284         );
 285     #delete a aqplan line of cells, then insert new cells,
 286     # these could be UPDATES rather than DEL/INSERTS...
 287         $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );
 288
 289         foreach my $cell (@$lines) {
 290             my $sth = $dbh->prepare( qq|
 291
 292                 INSERT INTO aqbudgets_planning
 293                      SET   budget_id     = ?,
 294                      budget_period_id  = ?,
 295                      authcat          = ?,
 296                      estimated_amount  = ?,
 297                      authvalue       = ?  |
 298             );
 299             $sth->execute(
 300                             $cell->{'budget_id'},
 301                             $cell->{'budget_period_id'},
 302                             $cell->{'authcat'},
 303                             $cell->{'estimated_amount'},
 304                             $cell->{'authvalue'},
 305             );
 306         }
 307     }
 308 }
 309
 310 # -------------------------------------------------------------------
 311 sub GetBudgetSpent {
 312         my ($budget_id) = @_;
 313         my $dbh = C4::Context->dbh;
 314         my $sth = $dbh->prepare(qq|
 315         SELECT SUM( COALESCE(unitprice, ecost) * quantity ) AS sum FROM aqorders
 316             WHERE budget_id = ? AND
 317             quantityreceived > 0 AND
 318             datecancellationprinted IS NULL
 319     |);
 320         $sth->execute($budget_id);
 321         my $sum =  $sth->fetchrow_array;
 322
 323     $sth = $dbh->prepare(qq|
 324         SELECT SUM(shipmentcost) AS sum
 325         FROM aqinvoices
 326         WHERE shipmentcost_budgetid = ?
 327           AND closedate IS NOT NULL
 328     |);
 329     $sth->execute($budget_id);
 330     my ($shipmentcost_sum) = $sth->fetchrow_array;
 331     $sum += $shipmentcost_sum;
 332
 333         return $sum;
 334 }
 335
 336 # -------------------------------------------------------------------
 337 sub GetBudgetOrdered {
 338         my ($budget_id) = @_;
 339         my $dbh = C4::Context->dbh;
 340         my $sth = $dbh->prepare(qq|
 341         SELECT SUM(ecost *  quantity) AS sum FROM aqorders
 342             WHERE budget_id = ? AND
 343             quantityreceived = 0 AND
 344             datecancellationprinted IS NULL
 345     |);
 346         $sth->execute($budget_id);
 347         my $sum =  $sth->fetchrow_array;
 348
 349     $sth = $dbh->prepare(qq|
 350         SELECT SUM(shipmentcost) AS sum
 351         FROM aqinvoices
 352         WHERE shipmentcost_budgetid = ?
 353           AND closedate IS NULL
 354     |);
 355     $sth->execute($budget_id);
 356     my ($shipmentcost_sum) = $sth->fetchrow_array;
 357     $sum += $shipmentcost_sum;
 358
 359         return $sum;
 360 }
 361
 362 =head2 GetBudgetName
 363
 364   my $budget_name = &GetBudgetName($budget_id);
 365
 366 get the budget_name for a given budget_id
 367
 368 =cut
 369
 370 sub GetBudgetName {
 371     my ( $budget_id ) = @_;
 372     my $dbh         = C4::Context->dbh;
 373     my $sth         = $dbh->prepare(
 374         qq|
 375         SELECT budget_name
 376         FROM aqbudgets
 377         WHERE budget_id = ?
 378     |);
 379
 380     $sth->execute($budget_id);
 381     return $sth->fetchrow_array;
 382 }
 383
 384 # -------------------------------------------------------------------
 385 sub GetBudgetAuthCats  {
 386     my ($budget_period_id) = shift;
 387     # now, populate the auth_cats_loop used in the budget planning button
 388     # we must retrieve all auth values used by at least one budget
 389     my $dbh = C4::Context->dbh;
 390     my $sth=$dbh->prepare("SELECT sort1_authcat,sort2_authcat FROM aqbudgets WHERE budget_period_id=?");
 391     $sth->execute($budget_period_id);
 392     my %authcats;
 393     while (my ($sort1_authcat,$sort2_authcat) = $sth->fetchrow) {
 394         $authcats{$sort1_authcat}=1;
 395         $authcats{$sort2_authcat}=1;
 396     }
 397     my @auth_cats_loop;
 398     foreach (sort keys %authcats) {
 399         push @auth_cats_loop,{ authcat => $_ };
 400     }
 401     return \@auth_cats_loop;
 402 }
 403
 404 # -------------------------------------------------------------------
 405 sub GetBudgetPeriods {
 406         my ($filters,$orderby) = @_;
 407
 408     my $rs = Koha::Database->new()->schema->resultset('Aqbudgetperiod');
 409     $rs = $rs->search( $filters, { order_by => $orderby } );
 410     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 411     return [ $rs->all ];
 412 }
 413 # -------------------------------------------------------------------
 414 sub GetBudgetPeriod {
 415         my ($budget_period_id) = @_;
 416         my $dbh = C4::Context->dbh;
 417         ## $total = number of records linked to the record that must be deleted
 418         my $total = 0;
 419         ## get information about the record that will be deleted
 420         my $sth;
 421         if ($budget_period_id) {
 422                 $sth = $dbh->prepare( qq|
 423               SELECT      *
 424                 FROM aqbudgetperiods
 425                 WHERE budget_period_id=? |
 426                 );
 427                 $sth->execute($budget_period_id);
 428         } else {         # ACTIVE BUDGET
 429                 $sth = $dbh->prepare(qq|
 430                           SELECT      *
 431                 FROM aqbudgetperiods
 432                 WHERE budget_period_active=1 |
 433                 );
 434                 $sth->execute();
 435         }
 436         my $data = $sth->fetchrow_hashref;
 437         return $data;
 438 }
 439
 440 # -------------------------------------------------------------------
 441 sub DelBudgetPeriod{
 442         my ($budget_period_id) = @_;
 443         my $dbh = C4::Context->dbh;
 444           ; ## $total = number of records linked to the record that must be deleted
 445     my $total = 0;
 446
 447         ## get information about the record that will be deleted
 448         my $sth = $dbh->prepare(qq|
 449                 DELETE
 450          FROM aqbudgetperiods
 451          WHERE budget_period_id=? |
 452         );
 453         return $sth->execute($budget_period_id);
 454 }
 455
 456 # -------------------------------------------------------------------
 457 sub ModBudgetPeriod {
 458     my ($budget_period) = @_;
 459     my $result = Koha::Database->new()->schema->resultset('Aqbudgetperiod')->find($budget_period);
 460     return unless($result);
 461
 462     $result = $result->update($budget_period);
 463     return $result->in_storage;
 464 }
 465
 466 # -------------------------------------------------------------------
 467 sub GetBudgetHierarchy {
 468     my ( $budget_period_id, $branchcode, $owner ) = @_;
 469     my @bind_params;
 470     my $dbh   = C4::Context->dbh;
 471     my $query = qq|
 472                     SELECT aqbudgets.*, aqbudgetperiods.budget_period_active, aqbudgetperiods.budget_period_description
 473                     FROM aqbudgets
 474                     JOIN aqbudgetperiods USING (budget_period_id)|;
 475
 476         my @where_strings;
 477     # show only period X if requested
 478     if ($budget_period_id) {
 479         push @where_strings," aqbudgets.budget_period_id = ?";
 480         push @bind_params, $budget_period_id;
 481     }
 482         # show only budgets owned by me, my branch or everyone
 483     if ($owner) {
 484         if ($branchcode) {
 485             push @where_strings,
 486             qq{ (budget_owner_id = ? OR budget_branchcode = ? OR ((budget_branchcode IS NULL or budget_branchcode="") AND (budget_owner_id IS NULL OR budget_owner_id="")))};
 487             push @bind_params, ( $owner, $branchcode );
 488         } else {
 489             push @where_strings, ' (budget_owner_id = ? OR budget_owner_id IS NULL or budget_owner_id ="") ';
 490             push @bind_params, $owner;
 491         }
 492     } else {
 493         if ($branchcode) {
 494             push @where_strings," (budget_branchcode =? or budget_branchcode is NULL)";
 495             push @bind_params, $branchcode;
 496         }
 497     }
 498         $query.=" WHERE ".join(' AND ', @where_strings) if @where_strings;
 499         $debug && warn $query,join(",",@bind_params);
 500         my $sth = $dbh->prepare($query);
 501         $sth->execute(@bind_params);
 502         my $results = $sth->fetchall_arrayref({});
 503         my @res     = @$results;
 504         my $i = 0;
 505         while (1) {
 506                 my $depth_cnt = 0;
 507                 foreach my $r (@res) {
 508                         my @child;
 509                         # look for children
 510                         $r->{depth} = '0' if !defined $r->{budget_parent_id};
 511                         foreach my $r2 (@res) {
 512                                 if (defined $r2->{budget_parent_id}
 513                                         && $r2->{budget_parent_id} == $r->{budget_id}) {
 514                                         push @child, $r2->{budget_id};
 515                                         $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
 516                                 }
 517                         }
 518                         $r->{child} = \@child if scalar @child > 0;    # add the child
 519                         $depth_cnt++ if !defined $r->{'depth'};
 520                 }
 521                 last if ($depth_cnt == 0 || $i == 100);
 522                 $i++;
 523         }
 524
 525         # look for top parents 1st
 526         my (@sort, $depth_count);
 527         ($i, $depth_count) = 0;
 528         while (1) {
 529                 my $children = 0;
 530                 foreach my $r (@res) {
 531                         if ($r->{depth} == $depth_count) {
 532                                 $children++ if (ref $r->{child} eq 'ARRAY');
 533
 534                                 # find the parent id element_id and insert it after
 535                                 my $i2 = 0;
 536                                 my $parent;
 537                                 if ($depth_count > 0) {
 538
 539                                         # add indent
 540                                         my $depth = $r->{depth} * 2;
 541                                         $r->{budget_code_indent} = $r->{budget_code};
 542                                         $r->{budget_name_indent} = $r->{budget_name};
 543                                         foreach my $r3 (@sort) {
 544                                                 if ($r3->{budget_id} == $r->{budget_parent_id}) {
 545                                                         $parent = $i2;
 546                                                         last;
 547                                                 }
 548                                                 $i2++;
 549                                         }
 550                                 } else {
 551                                         $r->{budget_code_indent} = $r->{budget_code};
 552                                         $r->{budget_name_indent} = $r->{budget_name};
 553                                 }
 554
 555                                 if (defined $parent) {
 556                                         splice @sort, ($parent + 1), 0, $r;
 557                                 } else {
 558                                         push @sort, $r;
 559                                 }
 560                         }
 561
 562                         $i++;
 563                 }    # --------------foreach
 564                 $depth_count++;
 565                 last if $children == 0;
 566         }
 567
 568
 569     foreach my $budget (@sort) {
 570         $budget->{budget_spent}   = GetBudgetSpent( $budget->{budget_id} );
 571         $budget->{budget_ordered} = GetBudgetOrdered( $budget->{budget_id} );
 572         $budget->{total_spent} = GetBudgetHierarchySpent( $budget->{budget_id} );
 573         $budget->{total_ordered} = GetBudgetHierarchyOrdered( $budget->{budget_id} );
 574     }
 575     return \@sort;
 576 }
 577
 578 # -------------------------------------------------------------------
 579
 580 sub AddBudget {
 581     my ($budget) = @_;
 582     return unless ($budget);
 583
 584     my $resultset = Koha::Database->new()->schema->resultset('Aqbudget');
 585     return $resultset->create($budget)->id;
 586 }
 587
 588 # -------------------------------------------------------------------
 589 sub ModBudget {
 590     my ($budget) = @_;
 591     my $result = Koha::Database->new()->schema->resultset('Aqbudget')->find($budget);
 592     return unless($result);
 593
 594     $result = $result->update($budget);
 595     return $result->in_storage;
 596 }
 597
 598 # -------------------------------------------------------------------
 599 sub DelBudget {
 600         my ($budget_id) = @_;
 601         my $dbh         = C4::Context->dbh;
 602         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
 603         my $rc          = $sth->execute($budget_id);
 604         return $rc;
 605 }
 606
 607
 608 =head2 GetBudget
 609
 610   &GetBudget($budget_id);
 611
 612 get a specific budget
 613
 614 =cut
 615
 616 # -------------------------------------------------------------------
 617 sub GetBudget {
 618     my ( $budget_id ) = @_;
 619     my $dbh = C4::Context->dbh;
 620     my $query = "
 621         SELECT *
 622         FROM   aqbudgets
 623         WHERE  budget_id=?
 624         ";
 625     my $sth = $dbh->prepare($query);
 626     $sth->execute( $budget_id );
 627     my $result = $sth->fetchrow_hashref;
 628     return $result;
 629 }
 630
 631 =head2 GetBudgetByOrderNumber
 632
 633   &GetBudgetByOrderNumber($ordernumber);
 634
 635 get a specific budget by order number
 636
 637 =cut
 638
 639 # -------------------------------------------------------------------
 640 sub GetBudgetByOrderNumber {
 641     my ( $ordernumber ) = @_;
 642     my $dbh = C4::Context->dbh;
 643     my $query = "
 644         SELECT aqbudgets.*
 645         FROM   aqbudgets, aqorders
 646         WHERE  ordernumber=?
 647         AND    aqorders.budget_id = aqbudgets.budget_id
 648         ";
 649     my $sth = $dbh->prepare($query);
 650     $sth->execute( $ordernumber );
 651     my $result = $sth->fetchrow_hashref;
 652     return $result;
 653 }
 654
 655 =head2 GetBudgetByCode
 656
 657     my $budget = &GetBudgetByCode($budget_code);
 658
 659 Retrieve all aqbudgets fields as a hashref for the budget that has
 660 given budget_code
 661
 662 =cut
 663
 664 sub GetBudgetByCode {
 665     my ( $budget_code ) = @_;
 666
 667     my $dbh = C4::Context->dbh;
 668     my $query = qq{
 669         SELECT *
 670         FROM aqbudgets
 671         WHERE budget_code = ?
 672         ORDER BY budget_id DESC
 673         LIMIT 1
 674     };
 675     my $sth = $dbh->prepare( $query );
 676     $sth->execute( $budget_code );
 677     return $sth->fetchrow_hashref;
 678 }
 679
 680 =head2 GetBudgetHierarchySpent
 681
 682   my $spent = GetBudgetHierarchySpent( $budget_id );
 683
 684 Gets the total spent of the level and sublevels of $budget_id
 685
 686 =cut
 687
 688 sub GetBudgetHierarchySpent {
 689     my ( $budget_id ) = @_;
 690     my $dbh = C4::Context->dbh;
 691     my $children_ids = $dbh->selectcol_arrayref(q|
 692         SELECT budget_id
 693         FROM   aqbudgets
 694         WHERE  budget_parent_id = ?
 695     |, {}, $budget_id );
 696
 697     my $total_spent = GetBudgetSpent( $budget_id );
 698     for my $child_id ( @$children_ids ) {
 699         $total_spent += GetBudgetHierarchySpent( $child_id );
 700     }
 701     return $total_spent;
 702 }
 703
 704 =head2 GetBudgetHierarchyOrdered
 705
 706   my $ordered = GetBudgetHierarchyOrdered( $budget_id );
 707
 708 Gets the total ordered of the level and sublevels of $budget_id
 709
 710 =cut
 711
 712 sub GetBudgetHierarchyOrdered {
 713     my ( $budget_id ) = @_;
 714     my $dbh = C4::Context->dbh;
 715     my $children_ids = $dbh->selectcol_arrayref(q|
 716         SELECT budget_id
 717         FROM   aqbudgets
 718         WHERE  budget_parent_id = ?
 719     |, {}, $budget_id );
 720
 721     my $total_ordered = GetBudgetOrdered( $budget_id );
 722     for my $child_id ( @$children_ids ) {
 723         $total_ordered += GetBudgetHierarchyOrdered( $child_id );
 724     }
 725     return $total_ordered;
 726 }
 727
 728 =head2 GetBudgets
 729
 730   &GetBudgets($filter, $order_by);
 731
 732 gets all budgets
 733
 734 =cut
 735
 736 # -------------------------------------------------------------------
 737 sub GetBudgets {
 738     my ($filters, $orderby) = @_;
 739     $orderby = 'budget_name' unless($orderby);
 740
 741     my $rs = Koha::Database->new()->schema->resultset('Aqbudget');
 742     $rs = $rs->search( $filters, { order_by => $orderby } );
 743     $rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
 744     return [ $rs->all  ];
 745 }
 746
 747 =head2 GetBudgetUsers
 748
 749     my @borrowernumbers = &GetBudgetUsers($budget_id);
 750
 751 Return the list of borrowernumbers linked to a budget
 752
 753 =cut
 754
 755 sub GetBudgetUsers {
 756     my ($budget_id) = @_;
 757
 758     my $dbh = C4::Context->dbh;
 759     my $query = qq{
 760         SELECT borrowernumber
 761         FROM aqbudgetborrowers
 762         WHERE budget_id = ?
 763     };
 764     my $sth = $dbh->prepare($query);
 765     $sth->execute($budget_id);
 766
 767     my @borrowernumbers;
 768     while (my ($borrowernumber) = $sth->fetchrow_array) {
 769         push @borrowernumbers, $borrowernumber
 770     }
 771
 772     return @borrowernumbers;
 773 }
 774
 775 =head2 ModBudgetUsers
 776
 777     &ModBudgetUsers($budget_id, @borrowernumbers);
 778
 779 Modify the list of borrowernumbers linked to a budget
 780
 781 =cut
 782
 783 sub ModBudgetUsers {
 784     my ($budget_id, @budget_users_id) = @_;
 785
 786     return unless $budget_id;
 787
 788     my $dbh = C4::Context->dbh;
 789     my $query = "DELETE FROM aqbudgetborrowers WHERE budget_id = ?";
 790     my $sth = $dbh->prepare($query);
 791     $sth->execute($budget_id);
 792
 793     $query = qq{
 794         INSERT INTO aqbudgetborrowers (budget_id, borrowernumber)
 795         VALUES (?,?)
 796     };
 797     $sth = $dbh->prepare($query);
 798     foreach my $borrowernumber (@budget_users_id) {
 799         next unless $borrowernumber;
 800         $sth->execute($budget_id, $borrowernumber);
 801     }
 802 }
 803
 804 sub CanUserUseBudget {
 805     my ($borrower, $budget, $userflags) = @_;
 806
 807     if (not ref $borrower) {
 808         $borrower = C4::Members::GetMember(borrowernumber => $borrower);
 809     }
 810     if (not ref $budget) {
 811         $budget = GetBudget($budget);
 812     }
 813
 814     return 0 unless ($borrower and $budget);
 815
 816     if (not defined $userflags) {
 817         $userflags = C4::Auth::getuserflags($borrower->{flags},
 818             $borrower->{userid});
 819     }
 820
 821     unless ($userflags->{superlibrarian}
 822     || (ref $userflags->{acquisition}
 823         && $userflags->{acquisition}->{budget_manage_all})
 824     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
 825     {
 826         if (not exists $userflags->{acquisition}) {
 827             return 0;
 828         }
 829
 830         if (!ref $userflags->{acquisition} && !$userflags->{acquisition}) {
 831             return 0;
 832         }
 833
 834         # Budget restricted to owner
 835         if ( $budget->{budget_permission} == 1 ) {
 836             if (    $budget->{budget_owner_id}
 837                 and $budget->{budget_owner_id} != $borrower->{borrowernumber} )
 838             {
 839                 return 0;
 840             }
 841         }
 842
 843         # Budget restricted to owner, users and library
 844         elsif ( $budget->{budget_permission} == 2 ) {
 845             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
 846
 847             if (
 848                 (
 849                         $budget->{budget_owner_id}
 850                     and $budget->{budget_owner_id} !=
 851                     $borrower->{borrowernumber}
 852                     or not $budget->{budget_owner_id}
 853                 )
 854                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
 855                     @budget_users )
 856                 and defined $budget->{budget_branchcode}
 857                 and $budget->{budget_branchcode} ne
 858                 C4::Context->userenv->{branch}
 859               )
 860             {
 861                 return 0;
 862             }
 863         }
 864
 865         # Budget restricted to owner and users
 866         elsif ( $budget->{budget_permission} == 3 ) {
 867             my @budget_users = GetBudgetUsers( $budget->{budget_id} );
 868             if (
 869                 (
 870                         $budget->{budget_owner_id}
 871                     and $budget->{budget_owner_id} !=
 872                     $borrower->{borrowernumber}
 873                     or not $budget->{budget_owner_id}
 874                 )
 875                 and ( 0 == grep { $borrower->{borrowernumber} == $_ }
 876                     @budget_users )
 877               )
 878             {
 879                 return 0;
 880             }
 881         }
 882     }
 883
 884     return 1;
 885 }
 886
 887 sub CanUserModifyBudget {
 888     my ($borrower, $budget, $userflags) = @_;
 889
 890     if (not ref $borrower) {
 891         $borrower = C4::Members::GetMember(borrowernumber => $borrower);
 892     }
 893     if (not ref $budget) {
 894         $budget = GetBudget($budget);
 895     }
 896
 897     return 0 unless ($borrower and $budget);
 898
 899     if (not defined $userflags) {
 900         $userflags = C4::Auth::getuserflags($borrower->{flags},
 901             $borrower->{userid});
 902     }
 903
 904     unless ($userflags->{superlibrarian}
 905     || (ref $userflags->{acquisition}
 906         && $userflags->{acquisition}->{budget_manage_all})
 907     || (!ref $userflags->{acquisition} && $userflags->{acquisition}))
 908     {
 909         if (!CanUserUseBudget($borrower, $budget, $userflags)) {
 910             return 0;
 911         }
 912
 913         if (ref $userflags->{acquisition}
 914         && !$userflags->{acquisition}->{budget_modify}) {
 915             return 0;
 916         }
 917     }
 918
 919     return 1;
 920 }
 921
 922 # -------------------------------------------------------------------
 923
 924 =head2 GetCurrencies
 925
 926   @currencies = &GetCurrencies;
 927
 928 Returns the list of all known currencies.
 929
 930 C<$currencies> is a array; its elements are references-to-hash, whose
 931 keys are the fields from the currency table in the Koha database.
 932
 933 =cut
 934
 935 sub GetCurrencies {
 936     my $dbh   = C4::Context->dbh;
 937     my $query = "
 938         SELECT *
 939         FROM   currency
 940     ";
 941     my $sth = $dbh->prepare($query);
 942     $sth->execute;
 943     my @results = ();
 944     while ( my $data = $sth->fetchrow_hashref ) {
 945         push( @results, $data );
 946     }
 947     return @results;
 948 }
 949
 950 # -------------------------------------------------------------------
 951
 952 sub GetCurrency {
 953     my $dbh   = C4::Context->dbh;
 954     my $query = "
 955         SELECT * FROM currency where active = '1'    ";
 956     my $sth = $dbh->prepare($query);
 957     $sth->execute;
 958     my $r = $sth->fetchrow_hashref;
 959     return $r;
 960 }
 961
 962 =head2 ModCurrencies
 963
 964 &ModCurrencies($currency, $newrate);
 965
 966 Sets the exchange rate for C<$currency> to be C<$newrate>.
 967
 968 =cut
 969
 970 sub ModCurrencies {
 971     my ( $currency, $rate ) = @_;
 972     my $dbh   = C4::Context->dbh;
 973     my $query = qq|
 974         UPDATE currency
 975         SET    rate=?
 976         WHERE  currency=? |;
 977     my $sth = $dbh->prepare($query);
 978     $sth->execute( $rate, $currency );
 979 }
 980
 981 # -------------------------------------------------------------------
 982
 983 =head2 ConvertCurrency
 984
 985   $foreignprice = &ConvertCurrency($currency, $localprice);
 986
 987 Converts the price C<$localprice> to foreign currency C<$currency> by
 988 dividing by the exchange rate, and returns the result.
 989
 990 If no exchange rate is found, e is one to one.
 991
 992 =cut
 993
 994 sub ConvertCurrency {
 995     my ( $currency, $price ) = @_;
 996     my $dbh   = C4::Context->dbh;
 997     my $query = "
 998         SELECT rate
 999         FROM   currency
1000         WHERE  currency=?
1001     ";
1002     my $sth = $dbh->prepare($query);
1003     $sth->execute($currency);
1004     my $cur = ( $sth->fetchrow_array() )[0];
1005     unless ($cur) {
1006         $cur = 1;
1007     }
1008     return ( $price / $cur );
1009 }
1010
1011
1012 =head2 CloneBudgetPeriod
1013
1014   my $new_budget_period_id = CloneBudgetPeriod({
1015     budget_period_id => $budget_period_id,
1016     budget_period_startdate => $budget_period_startdate,
1017     budget_period_enddate   => $budget_period_enddate,
1018     mark_original_budget_as_inactive => 1n
1019     reset_all_budgets => 1,
1020   });
1021
1022 Clone a budget period with all budgets.
1023 If the mark_origin_budget_as_inactive is set (0 by default),
1024 the original budget will be marked as inactive.
1025
1026 If the reset_all_budgets is set (0 by default), all budget (fund)
1027 amounts will be reset.
1028
1029 =cut
1030
1031 sub CloneBudgetPeriod {
1032     my ($params)                = @_;
1033     my $budget_period_id        = $params->{budget_period_id};
1034     my $budget_period_startdate = $params->{budget_period_startdate};
1035     my $budget_period_enddate   = $params->{budget_period_enddate};
1036     my $mark_original_budget_as_inactive =
1037       $params->{mark_original_budget_as_inactive} || 0;
1038     my $reset_all_budgets = $params->{reset_all_budgets} || 0;
1039
1040     my $budget_period = GetBudgetPeriod($budget_period_id);
1041
1042     $budget_period->{budget_period_startdate} = $budget_period_startdate;
1043     $budget_period->{budget_period_enddate}   = $budget_period_enddate;
1044     # The new budget (budget_period) should be active by default
1045     $budget_period->{budget_period_active}    = 1;
1046     my $original_budget_period_id = $budget_period->{budget_period_id};
1047     delete $budget_period->{budget_period_id};
1048     my $new_budget_period_id = AddBudgetPeriod( $budget_period );
1049
1050     my $budgets = GetBudgetHierarchy($budget_period_id);
1051     CloneBudgetHierarchy(
1052         {
1053             budgets              => $budgets,
1054             new_budget_period_id => $new_budget_period_id
1055         }
1056     );
1057
1058     if ($mark_original_budget_as_inactive) {
1059         ModBudgetPeriod(
1060             {
1061                 budget_period_id     => $budget_period_id,
1062                 budget_period_active => 0,
1063             }
1064         );
1065     }
1066
1067     if ( $reset_all_budgets ) {
1068         my $budgets = GetBudgets({ budget_period_id => $new_budget_period_id });
1069         for my $budget ( @$budgets ) {
1070             $budget->{budget_amount} = 0;
1071             ModBudget( $budget );
1072         }
1073     }
1074
1075     return $new_budget_period_id;
1076 }
1077
1078 =head2 CloneBudgetHierarchy
1079
1080   CloneBudgetHierarchy({
1081     budgets => $budgets,
1082     new_budget_period_id => $new_budget_period_id;
1083   });
1084
1085 Clone a budget hierarchy.
1086
1087 =cut
1088
1089 sub CloneBudgetHierarchy {
1090     my ($params)             = @_;
1091     my $budgets              = $params->{budgets};
1092     my $new_budget_period_id = $params->{new_budget_period_id};
1093     next unless @$budgets or $new_budget_period_id;
1094
1095     my $children_of   = $params->{children_of};
1096     my $new_parent_id = $params->{new_parent_id};
1097
1098     my @first_level_budgets =
1099       ( not defined $children_of )
1100       ? map { ( not $_->{budget_parent_id} )             ? $_ : () } @$budgets
1101       : map { ( $_->{budget_parent_id} == $children_of ) ? $_ : () } @$budgets;
1102
1103     # get only the columns of aqbudgets
1104     my @columns = Koha::Database->new()->schema->source('Aqbudget')->columns;
1105
1106     for my $budget ( sort { $a->{budget_id} <=> $b->{budget_id} }
1107         @first_level_budgets )
1108     {
1109
1110         my $tidy_budget =
1111           { map { join( ' ', @columns ) =~ /$_/ ? ( $_ => $budget->{$_} ) : () }
1112               keys($budget) };
1113         my $new_budget_id = AddBudget(
1114             {
1115                 %$tidy_budget,
1116                 budget_id        => undef,
1117                 budget_parent_id => $new_parent_id,
1118                 budget_period_id => $new_budget_period_id
1119             }
1120         );
1121         CloneBudgetHierarchy(
1122             {
1123                 budgets              => $budgets,
1124                 new_budget_period_id => $new_budget_period_id,
1125                 children_of          => $budget->{budget_id},
1126                 new_parent_id        => $new_budget_id
1127             }
1128         );
1129     }
1130 }
1131
1132 =head2 MoveOrders
1133
1134   my $report = MoveOrders({
1135     from_budget_period_id => $from_budget_period_id,
1136     to_budget_period_id   => $to_budget_period_id,
1137   });
1138
1139 Clone a budget hierarchy.
1140
1141 =cut
1142
1143 sub MoveOrders {
1144     my ($params)              = @_;
1145     my $from_budget_period_id = $params->{from_budget_period_id};
1146     my $to_budget_period_id   = $params->{to_budget_period_id};
1147     my $move_remaining_unspent = $params->{move_remaining_unspent};
1148     return
1149       if not $from_budget_period_id
1150           or not $to_budget_period_id
1151           or $from_budget_period_id == $to_budget_period_id;
1152
1153     # Can't move orders to an inactive budget (budgetperiod)
1154     my $budget_period = GetBudgetPeriod($to_budget_period_id);
1155     return unless $budget_period->{budget_period_active};
1156
1157     my @report;
1158     my $dbh     = C4::Context->dbh;
1159     my $sth_update_aqorders = $dbh->prepare(
1160         q|
1161             UPDATE aqorders
1162             SET budget_id = ?
1163             WHERE ordernumber = ?
1164         |
1165     );
1166     my $sth_update_budget_amount = $dbh->prepare(
1167         q|
1168             UPDATE aqbudgets
1169             SET budget_amount = ?
1170             WHERE budget_id = ?
1171         |
1172     );
1173     my $from_budgets = GetBudgetHierarchy($from_budget_period_id);
1174     for my $from_budget (@$from_budgets) {
1175         my $new_budget_id = $dbh->selectcol_arrayref(
1176             q|
1177                 SELECT budget_id
1178                 FROM aqbudgets
1179                 WHERE budget_period_id = ?
1180                     AND budget_code = ?
1181             |, {}, $to_budget_period_id, $from_budget->{budget_code}
1182         );
1183         $new_budget_id = $new_budget_id->[0];
1184         my $new_budget = GetBudget( $new_budget_id );
1185         unless ( $new_budget ) {
1186             push @report,
1187               {
1188                 moved       => 0,
1189                 budget      => $from_budget,
1190                 error       => 'budget_code_not_exists',
1191               };
1192             next;
1193         }
1194         my $orders_to_move = C4::Acquisition::SearchOrders(
1195             {
1196                 budget_id => $from_budget->{budget_id},
1197                 pending   => 1,
1198             }
1199         );
1200
1201         my @orders_moved;
1202         for my $order (@$orders_to_move) {
1203             $sth_update_aqorders->execute( $new_budget->{budget_id}, $order->{ordernumber} );
1204             push @orders_moved, $order;
1205         }
1206
1207         my $unspent_moved = 0;
1208         if ($move_remaining_unspent) {
1209             my $spent   = GetBudgetHierarchySpent( $from_budget->{budget_id} );
1210             my $unspent = $from_budget->{budget_amount} - $spent;
1211             my $new_budget_amount = $new_budget->{budget_amount};
1212             if ( $unspent > 0 ) {
1213                 $new_budget_amount += $unspent;
1214                 $unspent_moved = $unspent;
1215             }
1216             $new_budget->{budget_amount} = $new_budget_amount;
1217             $sth_update_budget_amount->execute( $new_budget_amount,
1218                 $new_budget->{budget_id} );
1219         }
1220
1221         push @report,
1222           {
1223             budget        => $new_budget,
1224             orders_moved  => \@orders_moved,
1225             moved         => 1,
1226             unspent_moved => $unspent_moved,
1227           };
1228     }
1229     return \@report;
1230 }
1231
1232 END { }    # module clean-up code here (global destructor)
1233
1234 1;
1235 __END__
1236
1237 =head1 AUTHOR
1238
1239 Koha Development Team <http://koha-community.org/>
1240
1241 =cut