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