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 with
  17 # Koha; if not, write to the Free Software Foundation, Inc., 59 Temple Place,
  18 # Suite 330, Boston, MA  02111-1307 USA
  19
  20 use strict;
  21 use C4::Context;
  22 use C4::Dates qw(format_date format_date_in_iso);
  23 use C4::Debug;
  24
  25 use vars qw($VERSION @ISA @EXPORT);
  26
  27 BEGIN {
  28         # set the version for version checking
  29         $VERSION = 3.01;
  30         require Exporter;
  31         @ISA    = qw(Exporter);
  32         @EXPORT = qw(
  33
  34         &GetBudget
  35         &GetBudgets
  36         &GetBudgetHierarchy
  37             &AddBudget
  38         &ModBudget
  39         &DelBudget
  40         &GetBudgetSpent
  41         &GetPeriodsCount
  42
  43             &GetBudgetPeriod
  44         &GetBudgetPeriods
  45         &ModBudgetPeriod
  46             &DelBudgetPeriod
  47
  48             &GetBudgetPeriodsDropbox
  49         &GetBudgetSortDropbox
  50             &GetAuthcatDropbox
  51         &GetAuthvalueDropbox
  52         &GetBudgetPermDropbox
  53
  54         &ModBudgetPlan
  55         &GetCurrency
  56         &GetCurrencies
  57         &ModCurrencies
  58         &ConvertCurrency
  59         &GetBudgetsPlanCell
  60         &AddBudgetPlanValue
  61         &GetBudgetAuthCats
  62         &BudgetHasChildren
  63         &CheckBudgetParent
  64         &CheckBudgetParentPerm
  65         );
  66 }
  67
  68 # ----------------------------BUDGETS.PM-----------------------------";
  69 sub CheckBudgetParentPerm {
  70     my ( $budget, $borrower_id ) = @_;
  71     my $depth = $budget->{depth};
  72     my $parent_id = $budget->{budget_parent_id};
  73     while ($depth) {
  74         my $parent = GetBudget($parent_id);
  75         $parent_id = $parent->{budget_parent_id};
  76         if ( $parent->{budget_owner_id} == $borrower_id ) {
  77             return 1;
  78         }
  79         $depth--
  80     }
  81     return 0;
  82 }
  83
  84 # -------------------------------------------------------------------
  85 sub GetPeriodsCount {
  86     my $dbh = C4::Context->dbh;
  87     my $sth = $dbh->prepare("
  88         SELECT COUNT(*) AS sum FROM aqbudgetperiods ");
  89     $sth->execute();
  90     my $res = $sth->fetchrow_hashref;
  91     return $res->{'sum'};
  92 }
  93
  94 # -------------------------------------------------------------------
  95 sub CheckBudgetParent {
  96     my ( $new_parent, $budget ) = @_;
  97     my $new_parent_id = $new_parent->{'budget_id'};
  98     my $budget_id     = $budget->{'budget_id'};
  99     my $dbh           = C4::Context->dbh;
 100     my $parent_id_tmp = $new_parent_id;
 101
 102     # check new-parent is not a child (or a child's child ;)
 103     my $sth = $dbh->prepare(qq|
 104         SELECT budget_parent_id FROM
 105             aqbudgets where budget_id = ? | );
 106     while (1) {
 107         $sth->execute($parent_id_tmp);
 108         my $res = $sth->fetchrow_hashref;
 109         if ( $res->{'budget_parent_id'} == $budget_id ) {
 110             return 1;
 111         }
 112         if ( not defined $res->{'budget_parent_id'} ) {
 113             return 0;
 114         }
 115         $parent_id_tmp = $res->{'budget_parent_id'};
 116     }
 117 }
 118
 119 # -------------------------------------------------------------------
 120 sub BudgetHasChildren {
 121     my ( $budget_id  ) = @_;
 122     my $dbh = C4::Context->dbh;
 123     my $sth = $dbh->prepare(qq|
 124        SELECT count(*) as sum FROM  aqbudgets
 125         WHERE budget_parent_id = ?   | );
 126     $sth->execute( $budget_id );
 127     my $sum = $sth->fetchrow_hashref;
 128     $sth->finish;
 129     return $sum->{'sum'};
 130 }
 131
 132 # -------------------------------------------------------------------
 133 sub GetBudgetsPlanCell {
 134     my ( $cell, $period, $budget ) = @_;
 135     my ($actual, $sth);
 136     my $dbh = C4::Context->dbh;
 137     if ( $cell->{'authcat'} eq 'MONTHS' ) {
 138         # get the actual amount
 139         $sth = $dbh->prepare( qq|
 140
 141             SELECT SUM(ecost) AS actual FROM aqorders
 142                 WHERE    budget_id = ? AND
 143                 entrydate like "$cell->{'authvalue'}%"  |
 144         );
 145         $sth->execute( $cell->{'budget_id'} );
 146     } elsif ( $cell->{'authcat'} eq 'BRANCHES' ) {
 147         # get the actual amount
 148         $sth = $dbh->prepare( qq|
 149
 150             SELECT SUM(ecost) FROM aqorders
 151                 LEFT JOIN aqorders_items
 152                 ON (aqorders.ordernumber = aqorders_items.ordernumber)
 153                 LEFT JOIN items
 154                 ON (aqorders_items.itemnumber = items.itemnumber)
 155                 WHERE budget_id = ? AND homebranch = ? |          );
 156
 157         $sth->execute( $cell->{'budget_id'}, $cell->{'authvalue'} );
 158     } elsif ( $cell->{'authcat'} eq 'ITEMTYPES' ) {
 159         # get the actual amount
 160         $sth = $dbh->prepare(  qq|
 161
 162             SELECT SUM( ecost *  quantity) AS actual
 163                 FROM aqorders JOIN biblioitems
 164                 ON (biblioitems.biblionumber = aqorders.biblionumber )
 165                 WHERE aqorders.budget_id = ? and itemtype  = ? |
 166         );
 167         $sth->execute(  $cell->{'budget_id'},
 168                         $cell->{'authvalue'} );
 169     }
 170     # ELSE GENERIC ORDERS SORT1/SORT2 STAT COUNT.
 171     else {
 172         # get the actual amount
 173         $sth = $dbh->prepare( qq|
 174
 175         SELECT  SUM(ecost * quantity) AS actual
 176             FROM aqorders
 177             JOIN aqbudgets ON (aqbudgets.budget_id = aqorders.budget_id )
 178             WHERE  aqorders.budget_id = ? AND
 179                 ((aqbudgets.sort1_authcat = ? AND sort1 =?) OR
 180                 (aqbudgets.sort2_authcat = ? AND sort2 =?))    |
 181         );
 182         $sth->{TraceLevel} = 2;
 183         $sth->execute(  $cell->{'budget_id'},
 184                         $budget->{'sort1_authcat'},
 185                         $cell->{'authvalue'},
 186                         $budget->{'sort2_authcat'},
 187                         $cell->{'authvalue'}
 188         );
 189     }
 190     $actual = $sth->fetchrow_array;
 191
 192     # get the estimated amount
 193     my $sth = $dbh->prepare( qq|
 194
 195         SELECT estimated_amount AS estimated FROM aqbudgets_planning
 196             WHERE budget_period_id = ? AND
 197                 budget_id = ? AND
 198                 authvalue = ? AND
 199                 authcat = ?         |
 200     );
 201     $sth->execute(  $cell->{'budget_period_id'},
 202                     $cell->{'budget_id'},
 203                     $cell->{'authvalue'},
 204                     $cell->{'authcat'},
 205     );
 206     my $estimated = $sth->fetchrow_array;
 207     return $actual, $estimated;
 208 }
 209
 210 # -------------------------------------------------------------------
 211 sub ModBudgetPlan {
 212     my ( $budget_plan, $budget_period_id, $authcat ) = @_;
 213     my $dbh = C4::Context->dbh;
 214     foreach my $buds (@$budget_plan) {
 215         my $lines = $buds->{lines};
 216         my $sth = $dbh->prepare( qq|
 217                 DELETE FROM aqbudgets_planning
 218                     WHERE   budget_period_id   = ? AND
 219                             budget_id   = ? AND
 220                             authcat            = ? |
 221         );
 222     #delete a aqplan line of cells, then insert new cells,
 223     # these could be UPDATES rather than DEL/INSERTS...
 224         $sth->execute( $budget_period_id,  $lines->[0]{budget_id}   , $authcat );
 225
 226         foreach my $cell (@$lines) {
 227             my $sth = $dbh->prepare( qq|
 228
 229                 INSERT INTO aqbudgets_planning
 230                      SET   budget_id     = ?,
 231                      budget_period_id  = ?,
 232                      authcat          = ?,
 233                      estimated_amount  = ?,
 234                      authvalue       = ?  |
 235             );
 236             $sth->execute(
 237                             $cell->{'budget_id'},
 238                             $cell->{'budget_period_id'},
 239                             $cell->{'authcat'},
 240                             $cell->{'estimated_amount'},
 241                             $cell->{'authvalue'},
 242             );
 243         }
 244     }
 245 }
 246
 247 # -------------------------------------------------------------------
 248 sub GetBudgetSpent {
 249         my ($budget_id) = @_;
 250         my $dbh = C4::Context->dbh;
 251         my $sth = $dbh->prepare(qq|
 252         SELECT SUM(ecost *  quantity  ) AS sum FROM aqorders
 253             WHERE budget_id = ? AND
 254             datecancellationprinted IS NULL
 255     |);
 256
 257         $sth->execute($budget_id);
 258         my $sum =  $sth->fetchrow_array;
 259 #       $sum =  sprintf  "%.2f", $sum;
 260         return $sum;
 261 }
 262
 263 # -------------------------------------------------------------------
 264 sub GetBudgetPermDropbox {
 265         my ($perm) = @_;
 266         my %labels;
 267         $labels{'0'} = 'None';
 268         $labels{'1'} = 'Owner';
 269         $labels{'2'} = 'Library';
 270         my $radio = CGI::scrolling_list(
 271                 -name      => 'budget_permission',
 272                 -values    => [ '0', '1', '2' ],
 273                 -default   => $perm,
 274                 -labels    => \%labels,
 275                 -size    => 1,
 276         );
 277         return $radio;
 278 }
 279
 280 # -------------------------------------------------------------------
 281 sub GetAuthcatDropbox  {
 282         my ($name, $default ) = @_;
 283         my @authorised_values;
 284         my $value;
 285         my $dbh = C4::Context->dbh;
 286         my $sth = $dbh->prepare(qq|
 287                 SELECT distinct(category)
 288             FROM authorised_values WHERE category LIKE 'Asort%'
 289             ORDER BY lib |
 290         );
 291         $sth->execute();
 292
 293         push @authorised_values, '';
 294         while (my $value = $sth->fetchrow_array) {
 295                 push @authorised_values, $value;
 296         }
 297
 298     my $budget_authcat_dropbox = CGI::scrolling_list(
 299         -name     => $name,
 300         -values   => \@authorised_values,
 301         -override => 1,
 302         -size     => 1,
 303         -default  => $default,
 304         -multiple => 0,
 305         -tabindex => 1,
 306         -id       => $name,
 307     );
 308         return $budget_authcat_dropbox;
 309 }
 310
 311 # -------------------------------------------------------------------
 312 sub GetBudgetAuthCats  {
 313         my @auth_cats;
 314         my $value;
 315         my $dbh = C4::Context->dbh;
 316         my $sth = $dbh->prepare(
 317                 "SELECT distinct(category)
 318             FROM authorised_values where category like 'Asort%'
 319             ORDER BY category"
 320         );
 321         $sth->execute();
 322     while ( my $value = $sth->fetchrow_array ) {
 323         push @auth_cats, $value;
 324     }
 325     my @loop_data = ();    # initialize an array to hold your loop
 326     while (@auth_cats) {
 327         my %row_data;      # get a fresh hash for the row data
 328         $row_data{authcat} = shift @auth_cats;
 329         push( @loop_data, \%row_data );
 330     }
 331     return @loop_data;
 332 }
 333
 334 # -------------------------------------------------------------------
 335 sub GetAuthvalueDropbox {
 336         my ( $name, $authcat, $default ) = @_;
 337         my @authorised_values;
 338         my %authorised_lib;
 339         my $value;
 340         my $dbh = C4::Context->dbh;
 341         my $sth = $dbh->prepare(
 342                 "SELECT authorised_value,lib
 343             FROM authorised_values
 344             WHERE category = ?
 345             ORDER BY  lib"
 346         );
 347         $sth->execute( $authcat );
 348
 349         push @authorised_values, '';
 350         while (my ($value, $lib) = $sth->fetchrow_array) {
 351                 push @authorised_values, $value;
 352                 $authorised_lib{$value} = $lib;
 353         }
 354
 355     return 0 if keys(%authorised_lib) == 0;
 356
 357     my $budget_authvalue_dropbox = CGI::scrolling_list(
 358         -values   => \@authorised_values,
 359         -labels   => \%authorised_lib,
 360         -default  => $default,
 361         -override => 1,
 362         -size     => 1,
 363         -multiple => 0,
 364         -name     => $name,
 365         -id       => $name,
 366     );
 367
 368     return $budget_authvalue_dropbox
 369 }
 370
 371 # -------------------------------------------------------------------
 372 sub GetBudgetPeriodsDropbox {
 373     my ($budget_period_id) = @_;
 374         my %labels;
 375         my @values;
 376         my ($active, $periods) = GetBudgetPeriods();
 377         foreach my $r (@$periods) {
 378                 $labels{"$r->{budget_period_id}"} = $r->{budget_period_description};
 379                 push @values, $r->{budget_period_id};
 380         }
 381
 382         # if no buget_id is passed then its an add
 383         my $budget_period_dropbox = CGI::scrolling_list(
 384                 -name    => 'budget_period_id',
 385                 -values  => \@values,
 386                 -default => $budget_period_id ? $budget_period_id :  $active,
 387                 -size    => 1,
 388                 -labels  => \%labels,
 389         );
 390         return $budget_period_dropbox;
 391 }
 392
 393 # -------------------------------------------------------------------
 394 sub GetBudgetPeriods {
 395         my $dbh = C4::Context->dbh;
 396         my $sth = $dbh->prepare(qq|
 397         SELECT *
 398          FROM aqbudgetperiods
 399          ORDER BY budget_period_startdate, budget_period_enddate |
 400         );
 401         $sth->execute();
 402         my @results;
 403         my $active;
 404         while (my $data = $sth->fetchrow_hashref) {
 405                 if ($data->{'budget_period_active'} == 1) {
 406                         $active = $data->{'budget_period_id'};
 407                 }
 408                 push(@results, $data);
 409         }
 410         $sth->finish;
 411         return ($active, \@results);
 412 }
 413
 414 # -------------------------------------------------------------------
 415 sub GetBudgetPeriod {
 416         my ($budget_period_id) = @_;
 417         my $dbh = C4::Context->dbh;
 418         ## $total = number of records linked to the record that must be deleted
 419         my $total = 0;
 420         ## get information about the record that will be deleted
 421         my $sth;
 422         if ($budget_period_id gt 0) {
 423                 $sth = $dbh->prepare( qq|
 424               SELECT      *
 425                 FROM aqbudgetperiods
 426                 WHERE budget_period_id=? |
 427                 );
 428                 $sth->execute($budget_period_id);
 429         } else {         # ACTIVE BUDGET
 430                 $sth = $dbh->prepare(qq|
 431                           SELECT      *
 432                 FROM aqbudgetperiods
 433                 WHERE budget_period_active=1 |
 434                 );
 435                 $sth->execute();
 436         }
 437         my $data = $sth->fetchrow_hashref;
 438         $sth->finish;
 439         return $data;
 440 }
 441
 442 # -------------------------------------------------------------------
 443 sub DelBudgetPeriod() {
 444         my ($budget_period_id) = @_;
 445         my $dbh = C4::Context->dbh;
 446           ; ## $total = number of records linked to the record that must be deleted
 447     my $total = 0;
 448
 449         ## get information about the record that will be deleted
 450         my $sth = $dbh->prepare(qq|
 451                 SELECT     budget_period_id
 452                  , budget_period_startdate
 453                  , budget_period_enddate
 454                  , budget_period_amount
 455                  , budget_period_ref
 456                  , budget_period_description
 457          FROM aqbudgetperiods
 458          WHERE budget_period_id=? |
 459         );
 460         $sth->execute($budget_period_id);
 461         my $data = $sth->fetchrow_hashref;
 462         $sth->finish;
 463 }
 464
 465 # -------------------------------------------------------------------
 466 sub ModBudgetPeriod() {
 467         my ($budget_period_id) = @_;
 468         my $dbh = C4::Context->dbh
 469           ; ## $total = number of records linked to the record that must be deleted       my $total = 0;
 470
 471         ## get information about the record that will be deleted
 472         my $sth = $dbh->prepare("
 473             SELECT     budget_period_id
 474                  , budget_period_startdate
 475                  , budget_period_enddate
 476                  , budget_period_amount
 477                  , budget_period_ref
 478                  , budget_period_description
 479         FROM aqbudgetperiods
 480         WHERE budget_period_id=?;"
 481         );
 482         $sth->execute($budget_period_id);
 483         my $data = $sth->fetchrow_hashref;
 484         $sth->finish;
 485 }
 486
 487 # -------------------------------------------------------------------
 488 sub GetBudgetHierarchy {
 489         my ($budget_period_id, $branchcode, $owner) = @_;
 490         my @bind_params;
 491         my $dbh   = C4::Context->dbh;
 492         my $query = qq|
 493                     SELECT *
 494                     FROM aqbudgets
 495                     JOIN aqbudgetperiods USING (budget_period_id)
 496                     WHERE budget_period_active=1 |;
 497     # show only period X if requested
 498     if ($budget_period_id) {
 499         $query .= "AND aqbudgets.budget_period_id = ?";
 500         push @bind_params, $budget_period_id;
 501     }
 502         # show only budgets owned by me, my branch or everyone
 503     if ($owner) {
 504         if ($branchcode) {
 505             $query .= " AND (budget_owner_id = ? OR budget_branchcode = ? OR (budget_branchcode IS NULL AND budget_owner_id IS NULL))";
 506             push @bind_params, $owner;
 507             push @bind_params, $branchcode;
 508         } else {
 509             $query .= ' AND budget_owner_id = ? OR budget_owner_id IS NULL';
 510             push @bind_params, $owner;
 511         }
 512     } else {
 513         if ($branchcode) {
 514             $query .= " AND (budget_branchcode =? or budget_branchcode is NULL)";
 515             push @bind_params, $branchcode;
 516         }
 517     }
 518         my $sth = $dbh->prepare($query);
 519         $sth->execute(@bind_params);
 520         my $results = $sth->fetchall_arrayref({});
 521         my @res     = @$results;
 522         my $i = 0;
 523         while (1) {
 524                 my $depth_cnt = 0;
 525                 foreach my $r (@res) {
 526                         my @child;
 527                         # look for children
 528                         $r->{depth} = '0' if !defined $r->{budget_parent_id};
 529                         foreach my $r2 (@res) {
 530                                 if (defined $r2->{budget_parent_id}
 531                                         && $r2->{budget_parent_id} == $r->{budget_id}) {
 532                                         push @child, $r2->{budget_id};
 533                                         $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
 534                                 }
 535                         }
 536                         $r->{child} = \@child if scalar @child > 0;    # add the child
 537                         $depth_cnt++ if !defined $r->{'depth'};
 538                 }
 539                 last if ($depth_cnt == 0 || $i == 100);
 540                 $i++;
 541         }
 542
 543         # look for top parents 1st
 544         my @sort;
 545         my ($i, $depth_count) = 0;
 546         while (1) {
 547                 my $children = 0;
 548                 foreach my $r (@res) {
 549                         if ($r->{depth} == $depth_count) {
 550                                 $children++ if (ref $r->{child} eq 'ARRAY');
 551
 552                                 # find the parent id element_id and insert it after
 553                                 my $i2 = 0;
 554                                 my $parent;
 555                                 if ($depth_count > 0) {
 556
 557                                         # add indent
 558                                         my $depth = $r->{depth} * 2;
 559                                         my $space = pack "A[$depth]";
 560                                         $r->{budget_code_indent} = $space . $r->{budget_code};
 561                                         $r->{budget_name_indent} = $space . $r->{budget_name};
 562                                         foreach my $r3 (@sort) {
 563                                                 if ($r3->{budget_id} == $r->{budget_parent_id}) {
 564                                                         $parent = $i2;
 565                                                         last;
 566                                                 }
 567                                                 $i2++;
 568                                         }
 569                                 } else {
 570                                         $r->{budget_code_indent} = $r->{budget_code};
 571                                         $r->{budget_name_indent} = $r->{budget_name};
 572                                 }
 573
 574                                 if (defined $parent) {
 575                                         splice @sort, ($parent + 1), 0, $r;
 576                                 } else {
 577                                         push @sort, $r;
 578                                 }
 579                         }
 580
 581                         $i++;
 582                 }    # --------------foreach
 583                 $depth_count++;
 584                 last if $children == 0;
 585         }
 586
 587 # add budget-percent and allocation, and flags for html-template
 588         foreach my $r (@sort) {
 589                 my $subs_href = $r->{'child'};
 590         my @subs_arr = @$subs_href if defined $subs_href;
 591
 592         my $moo = $r->{'budget_code_indent'};
 593         $moo =~ s/\ /\&nbsp\;/g;
 594         $r->{'budget_code_indent'} =  $moo;
 595
 596         my $moo = $r->{'budget_name_indent'};
 597         $moo =~ s/\ /\&nbsp\;/g;
 598         $r->{'budget_name_indent'} = $moo;
 599
 600         $r->{'budget_spent'}       = GetBudgetSpent( $r->{'budget_id'} );
 601
 602 #        $budget->{'budget_alloc'}       = sprintf( "%.2f", $budget->{'budget_alloc'} - $budget->{'budget_amount  alloc'} );
 603 #        $budget->{'budget_alloc'} = sprintf( "%.2f", $budget->{'budget_alloc'} );
 604
 605         $r->{'budget_amount_total'} =  $r->{'budget_amount'} + $r->{'budget_amount_sublevel'}  ;
 606 #           $r->{budget_alloc} = $r->{'budget_amount'} - $r->{'budget_amount_sublevel'}  ;
 607
 608           #  $r->{'budget_amount_sublevel'}  ;
 609
 610         # foreach sub-levels
 611         my $unalloc_count ;
 612
 613                 foreach my $sub (@subs_arr) {
 614                         my $sub_budget = GetBudget($sub);
 615                         # $r->{budget_spent_sublevel} += $bud->{'budget_amount'} ;
 616
 617                         $r->{budget_spent_sublevel} +=    GetBudgetSpent( $sub_budget->{'budget_id'} );
 618                         $unalloc_count +=   $sub_budget->{'budget_amount'} + $sub_budget->{'budget_amount_sublevel'};
 619                 }
 620
 621             $r->{budget_unalloc_sublevel} =  $r->{'budget_amount_sublevel'}   -   $unalloc_count;
 622
 623         #                 (($r->{'budget_amount'} - $r->{'budget_alloc'}) /  $r->{'budget_amount'}) * 100;
 624
 625 =c
 626 #        my $percent =     $r->{'budget_amount'}  ? (  $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 :  0;
 627  #       my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 628
 629         #                 (($r->{'budget_amount'} - $r->{'budget_alloc'}) /  $r->{'budget_amount'}) * 100;
 630 #        my $percent = ( $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 631 #        my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 632                 if ($percent == 0) {
 633                         $r->{budget_alloc_none} = 1;
 634                 } elsif ($percent == 100) {
 635                         $r->{budget_alloc_full} = 1
 636
 637                 } else {
 638                         $r->{budget_alloc_percent} =    sprintf("%00d", $percent);
 639                 }
 640 =cut
 641
 642         if ( scalar  @subs_arr == 0  && $r->{budget_amount_sublevel} > 0 ) {
 643             $r->{warn_no_subs} = 1;
 644         }
 645         }
 646         return \@sort;
 647 }
 648
 649 # -------------------------------------------------------------------
 650 sub AddBudget {
 651 my ($budget) = @_;
 652 my $dbh        = C4::Context->dbh;
 653         my $query = qq|
 654     INSERT INTO aqbudgets
 655     SET budget_code         = ?,
 656         budget_period_id    = ?,
 657         budget_parent_id    = ?,
 658         budget_name         = ?,
 659         budget_branchcode   = ?,
 660         budget_amount       = ?,
 661         budget_amount_sublevel       = ?,
 662         budget_encumb       = ?,
 663         budget_expend       = ?,
 664         budget_notes        = ?,
 665         sort1_authcat       = ?,
 666         sort2_authcat       = ?,
 667         budget_owner_id     = ?,
 668         budget_permission   = ?
 669     |;
 670         my $sth = $dbh->prepare($query);
 671         $sth->execute(
 672         $budget->{'budget_code'}        ? $budget->{'budget_code'} : undef,
 673         $budget->{'budget_period_id'}   ? $budget->{'budget_period_id'} : undef,
 674         $budget->{'budget_parent_id'}   ? $budget->{'budget_parent_id'} : undef,
 675         $budget->{'budget_name'}        ? $budget->{'budget_name'} : undef,
 676         $budget->{'budget_branchcode'}  ? $budget->{'budget_branchcode'} : undef,
 677         $budget->{'budget_amount'}      ? $budget->{'budget_amount'} : undef,
 678         $budget->{'budget_amount_sublevel'}      ? $budget->{'budget_amount_sublevel'} : undef,
 679         $budget->{'budget_encumb'}      ? $budget->{'budget_encumb'} : undef,
 680         $budget->{'budget_expend'}      ? $budget->{'budget_expend'} : undef,
 681         $budget->{'budget_notes'}       ? $budget->{'budget_notes'} : undef,
 682         $budget->{'sort1_authcat'}      ? $budget->{'sort1_authcat'} : undef,
 683         $budget->{'sort2_authcat'}      ? $budget->{'sort2_authcat'} : undef,
 684         $budget->{'budget_owner_id'}    ? $budget->{'budget_owner_id'} : undef,
 685         $budget->{'budget_permission'}  ? $budget->{'budget_permission'} : undef,
 686         );
 687         $sth->finish;
 688 }
 689
 690 # -------------------------------------------------------------------
 691 sub ModBudget {
 692     my ($budget) = @_;
 693     my $dbh      = C4::Context->dbh;
 694         my $query = qq|
 695     UPDATE aqbudgets
 696     SET budget_code         = ?,
 697         budget_period_id    = ?,
 698         budget_parent_id    = ?,
 699         budget_name         = ?,
 700         budget_branchcode   = ?,
 701         budget_amount       = ?,
 702         budget_amount_sublevel       = ?,
 703         budget_encumb       = ?,
 704         budget_expend       = ?,
 705         budget_notes        = ?,
 706         sort1_authcat       = ?,
 707         sort2_authcat       = ?,
 708         budget_owner_id     = ?,
 709         budget_permission   = ?
 710     WHERE budget_id = ?
 711     |;
 712
 713         my $sth = $dbh->prepare($query);
 714     $sth->execute(
 715         $budget->{'budget_code'}        ? $budget->{'budget_code'} : undef,
 716         $budget->{'budget_period_id'}   ? $budget->{'budget_period_id'} : undef,
 717         $budget->{'budget_parent_id'}   ? $budget->{'budget_parent_id'} : undef,
 718         $budget->{'budget_name'}        ? $budget->{'budget_name'} : undef,
 719         $budget->{'budget_branchcode'}  ? $budget->{'budget_branchcode'} : undef,
 720         $budget->{'budget_amount'}      ? $budget->{'budget_amount'} : undef,
 721         $budget->{'budget_amount_sublevel'}      ? $budget->{'budget_amount_sublevel'} : undef,
 722         $budget->{'budget_encumb'}      ? $budget->{'budget_encumb'} : undef,
 723         $budget->{'budget_expend'}      ? $budget->{'budget_expend'} : undef,
 724         $budget->{'budget_notes'}       ? $budget->{'budget_notes'} : undef,
 725         $budget->{'sort1_authcat'}      ? $budget->{'sort1_authcat'} : undef,
 726         $budget->{'sort2_authcat'}      ? $budget->{'sort2_authcat'} : undef,
 727         $budget->{'budget_owner_id'}    ? $budget->{'budget_owner_id'} : undef,
 728         $budget->{'budget_permission'}  ? $budget->{'budget_permission'} : undef,
 729         $budget->{'budget_id'},
 730     );
 731     $sth->finish;
 732 }
 733
 734 # -------------------------------------------------------------------
 735 sub DelBudget {
 736         my ($budget_id) = @_;
 737         my $dbh         = C4::Context->dbh;
 738         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
 739         my $rc          = $sth->execute($budget_id);
 740         $sth->finish;
 741         return $rc;
 742 }
 743
 744 =back
 745
 746 =head2 FUNCTIONS ABOUT BUDGETS
 747
 748 =over 2
 749
 750 =cut
 751
 752 =head3 GetBudget
 753
 754 =over 4
 755
 756 &GetBudget($budget_id);
 757
 758 get a specific budget
 759
 760 =back
 761
 762 =cut
 763
 764 # -------------------------------------------------------------------
 765 sub GetBudget {
 766     my ( $budget_id ) = @_;
 767     my $dbh = C4::Context->dbh;
 768     my $query;
 769     my $query = "
 770         SELECT *
 771         FROM   aqbudgets
 772         WHERE  budget_id=?
 773         ";
 774     my $sth = $dbh->prepare($query);
 775     $sth->execute( $budget_id );
 776     my $result = $sth->fetchrow_hashref;
 777     return $result;
 778 }
 779
 780 =head3 GetBudgets
 781
 782 =over 4
 783
 784 &GetBudget($budget_id);
 785
 786 gets all budgets
 787
 788 =back
 789
 790 =cut
 791
 792 # -------------------------------------------------------------------
 793 sub GetBudgets {
 794     my ($active) = @_;
 795     my $dbh      = C4::Context->dbh;
 796     my $q        = "SELECT * from aqbudgets";
 797     my $row;
 798     my $sth;
 799     unless ($active) {
 800         $sth = $dbh->prepare($q);
 801         $sth->execute();
 802     } else {
 803         $q   = "select budget_period_id from aqbudgetperiods where budget_period_active = 1 ";
 804         $sth = $dbh->prepare($q);
 805         $sth->execute();
 806         $row = $sth->fetchrow_hashref();
 807         $q   = "select * from aqbudgets  WHERE budget_period_id =? ";
 808         $sth = $dbh->prepare($q);
 809         $sth->execute( $row->{'budget_period_id'} );
 810     }
 811     my $results = $sth->fetchall_arrayref( {} );
 812     $sth->finish;
 813     return $results;
 814 }
 815
 816 # -------------------------------------------------------------------
 817
 818 =head3 GetCurrencies
 819
 820 @currencies = &GetCurrencies;
 821
 822 Returns the list of all known currencies.
 823
 824 C<$currencies> is a array; its elements are references-to-hash, whose
 825 keys are the fields from the currency table in the Koha database.
 826
 827 =cut
 828
 829 sub GetCurrencies {
 830     my $dbh   = C4::Context->dbh;
 831     my $query = "
 832         SELECT *
 833         FROM   currency
 834     ";
 835     my $sth = $dbh->prepare($query);
 836     $sth->execute;
 837     my @results = ();
 838     while ( my $data = $sth->fetchrow_hashref ) {
 839         push( @results, $data );
 840     }
 841     $sth->finish;
 842     return @results;
 843 }
 844
 845 # -------------------------------------------------------------------
 846
 847 sub GetCurrency {
 848     my $dbh   = C4::Context->dbh;
 849     my $query = "
 850         SELECT * FROM currency where active = '1'    ";
 851     my $sth = $dbh->prepare($query);
 852     $sth->execute;
 853     my $r = $sth->fetchrow_hashref;
 854     $sth->finish;
 855     return $r;
 856 }
 857
 858 =head3 ModCurrencies
 859
 860 &ModCurrencies($currency, $newrate);
 861
 862 Sets the exchange rate for C<$currency> to be C<$newrate>.
 863
 864 =cut
 865
 866 sub ModCurrencies {
 867     my ( $currency, $rate ) = @_;
 868     my $dbh   = C4::Context->dbh;
 869     my $query = qq|
 870         UPDATE currency
 871         SET    rate=?
 872         WHERE  currency=? |;
 873     my $sth = $dbh->prepare($query);
 874     $sth->execute( $rate, $currency );
 875 }
 876
 877 # -------------------------------------------------------------------
 878
 879 =head3 ConvertCurrency
 880
 881 $foreignprice = &ConvertCurrency($currency, $localprice);
 882
 883 Converts the price C<$localprice> to foreign currency C<$currency> by
 884 dividing by the exchange rate, and returns the result.
 885
 886 If no exchange rate is found,e is one
 887 to one.
 888
 889 =cut
 890
 891 sub ConvertCurrency {
 892     my ( $currency, $price ) = @_;
 893     my $dbh   = C4::Context->dbh;
 894     my $query = "
 895         SELECT rate
 896         FROM   currency
 897         WHERE  currency=?
 898     ";
 899     my $sth = $dbh->prepare($query);
 900     $sth->execute($currency);
 901     my $cur = ( $sth->fetchrow_array() )[0];
 902     unless ($cur) {
 903         $cur = 1;
 904     }
 905     return ( $price / $cur );
 906 }
 907
 908 END { }    # module clean-up code here (global destructor)
 909
 910 1;
 911 __END__
 912
 913 =back
 914
 915 =head1 AUTHOR
 916
 917 Koha Developement team <info@koha.org>
 918
 919 =cut