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                     WHERE budget_period_id = ? |;
 496         push @bind_params, $budget_period_id;
 497         # show only budgets owned by me, my branch or everyone
 498     if ($owner) {
 499         if ($branchcode) {
 500             $query .= " AND (budget_owner_id = ? OR budget_branchcode = ? OR (budget_branchcode IS NULL AND budget_owner_id IS NULL))";
 501             push @bind_params, $owner;
 502             push @bind_params, $branchcode;
 503         } else {
 504             $query .= ' AND budget_owner_id = ?';
 505             push @bind_params, $owner;
 506         }
 507     } else {
 508         if ($branchcode) {
 509             $query .= " AND (budget_branchcode =? or budget_branchcode is NULL)";
 510             push @bind_params, $branchcode;
 511         }
 512     }
 513     warn "Q : $query";
 514         my $sth = $dbh->prepare($query);
 515         $sth->execute(@bind_params);
 516         my $results = $sth->fetchall_arrayref({});
 517         my @res     = @$results;
 518         my $i = 0;
 519         while (1) {
 520                 my $depth_cnt = 0;
 521                 foreach my $r (@res) {
 522                         my @child;
 523                         # look for children
 524                         $r->{depth} = '0' if !defined $r->{budget_parent_id};
 525                         foreach my $r2 (@res) {
 526                                 if (defined $r2->{budget_parent_id}
 527                                         && $r2->{budget_parent_id} == $r->{budget_id}) {
 528                                         push @child, $r2->{budget_id};
 529                                         $r2->{depth} = ($r->{depth} + 1) if defined $r->{depth};
 530                                 }
 531                         }
 532                         $r->{child} = \@child if scalar @child > 0;    # add the child
 533                         $depth_cnt++ if !defined $r->{'depth'};
 534                 }
 535                 last if ($depth_cnt == 0 || $i == 100);
 536                 $i++;
 537         }
 538
 539         # look for top parents 1st
 540         my @sort;
 541         my ($i, $depth_count) = 0;
 542         while (1) {
 543                 my $children = 0;
 544                 foreach my $r (@res) {
 545                         if ($r->{depth} == $depth_count) {
 546                                 $children++ if (ref $r->{child} eq 'ARRAY');
 547
 548                                 # find the parent id element_id and insert it after
 549                                 my $i2 = 0;
 550                                 my $parent;
 551                                 if ($depth_count > 0) {
 552
 553                                         # add indent
 554                                         my $depth = $r->{depth} * 2;
 555                                         my $space = pack "A[$depth]";
 556                                         $r->{budget_code_indent} = $space . $r->{budget_code};
 557                                         $r->{budget_name_indent} = $space . $r->{budget_name};
 558                                         foreach my $r3 (@sort) {
 559                                                 if ($r3->{budget_id} == $r->{budget_parent_id}) {
 560                                                         $parent = $i2;
 561                                                         last;
 562                                                 }
 563                                                 $i2++;
 564                                         }
 565                                 } else {
 566                                         $r->{budget_code_indent} = $r->{budget_code};
 567                                         $r->{budget_name_indent} = $r->{budget_name};
 568                                 }
 569
 570                                 if (defined $parent) {
 571                                         splice @sort, ($parent + 1), 0, $r;
 572                                 } else {
 573                                         push @sort, $r;
 574                                 }
 575                         }
 576
 577                         $i++;
 578                 }    # --------------foreach
 579                 $depth_count++;
 580                 last if $children == 0;
 581         }
 582
 583 # add budget-percent and allocation, and flags for html-template
 584         foreach my $r (@sort) {
 585                 my $subs_href = $r->{'child'};
 586         my @subs_arr = @$subs_href if defined $subs_href;
 587
 588         my $moo = $r->{'budget_code_indent'};
 589         $moo =~ s/\ /\&nbsp\;/g;
 590         $r->{'budget_code_indent'} =  $moo;
 591
 592         my $moo = $r->{'budget_name_indent'};
 593         $moo =~ s/\ /\&nbsp\;/g;
 594         $r->{'budget_name_indent'} = $moo;
 595
 596         $r->{'budget_spent'}       = GetBudgetSpent( $r->{'budget_id'} );
 597
 598 #        $budget->{'budget_alloc'}       = sprintf( "%.2f", $budget->{'budget_alloc'} - $budget->{'budget_amount  alloc'} );
 599 #        $budget->{'budget_alloc'} = sprintf( "%.2f", $budget->{'budget_alloc'} );
 600
 601         $r->{'budget_amount_total'} =  $r->{'budget_amount'} + $r->{'budget_amount_sublevel'}  ;
 602 #           $r->{budget_alloc} = $r->{'budget_amount'} - $r->{'budget_amount_sublevel'}  ;
 603
 604           #  $r->{'budget_amount_sublevel'}  ;
 605
 606         # foreach sub-levels
 607         my $unalloc_count ;
 608
 609                 foreach my $sub (@subs_arr) {
 610                         my $sub_budget = GetBudget($sub);
 611                         # $r->{budget_spent_sublevel} += $bud->{'budget_amount'} ;
 612
 613                         $r->{budget_spent_sublevel} +=    GetBudgetSpent( $sub_budget->{'budget_id'} );
 614                         $unalloc_count +=   $sub_budget->{'budget_amount'} + $sub_budget->{'budget_amount_sublevel'};
 615                 }
 616
 617             $r->{budget_unalloc_sublevel} =  $r->{'budget_amount_sublevel'}   -   $unalloc_count;
 618
 619         #                 (($r->{'budget_amount'} - $r->{'budget_alloc'}) /  $r->{'budget_amount'}) * 100;
 620
 621 =c
 622 #        my $percent =     $r->{'budget_amount'}  ? (  $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 :  0;
 623  #       my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 624
 625         #                 (($r->{'budget_amount'} - $r->{'budget_alloc'}) /  $r->{'budget_amount'}) * 100;
 626 #        my $percent = ( $r->{'budget_alloc'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 627 #        my $spent_percent = ( $r->{'budget_spent'} / $r->{'budget_amount'} ) * 100 if $r->{'budget_amount'};
 628                 if ($percent == 0) {
 629                         $r->{budget_alloc_none} = 1;
 630                 } elsif ($percent == 100) {
 631                         $r->{budget_alloc_full} = 1
 632
 633                 } else {
 634                         $r->{budget_alloc_percent} =    sprintf("%00d", $percent);
 635                 }
 636 =cut
 637
 638         if ( scalar  @subs_arr == 0  && $r->{budget_amount_sublevel} > 0 ) {
 639             $r->{warn_no_subs} = 1;
 640         }
 641         }
 642         return \@sort;
 643 }
 644
 645 # -------------------------------------------------------------------
 646 sub AddBudget {
 647 my ($budget) = @_;
 648 my $dbh        = C4::Context->dbh;
 649         my $query = qq|
 650     INSERT INTO aqbudgets
 651     SET budget_code         = ?,
 652         budget_period_id    = ?,
 653         budget_parent_id    = ?,
 654         budget_name         = ?,
 655         budget_branchcode   = ?,
 656         budget_amount       = ?,
 657         budget_amount_sublevel       = ?,
 658         budget_encumb       = ?,
 659         budget_expend       = ?,
 660         budget_notes        = ?,
 661         sort1_authcat       = ?,
 662         sort2_authcat       = ?,
 663         budget_owner_id     = ?,
 664         budget_permission   = ?
 665     |;
 666         my $sth = $dbh->prepare($query);
 667         $sth->execute(
 668         $budget->{'budget_code'}        ? $budget->{'budget_code'} : undef,
 669         $budget->{'budget_period_id'}   ? $budget->{'budget_period_id'} : undef,
 670         $budget->{'budget_parent_id'}   ? $budget->{'budget_parent_id'} : undef,
 671         $budget->{'budget_name'}        ? $budget->{'budget_name'} : undef,
 672         $budget->{'budget_branchcode'}  ? $budget->{'budget_branchcode'} : undef,
 673         $budget->{'budget_amount'}      ? $budget->{'budget_amount'} : undef,
 674         $budget->{'budget_amount_sublevel'}      ? $budget->{'budget_amount_sublevel'} : undef,
 675         $budget->{'budget_encumb'}      ? $budget->{'budget_encumb'} : undef,
 676         $budget->{'budget_expend'}      ? $budget->{'budget_expend'} : undef,
 677         $budget->{'budget_notes'}       ? $budget->{'budget_notes'} : undef,
 678         $budget->{'sort1_authcat'}      ? $budget->{'sort1_authcat'} : undef,
 679         $budget->{'sort2_authcat'}      ? $budget->{'sort2_authcat'} : undef,
 680         $budget->{'budget_owner_id'}    ? $budget->{'budget_owner_id'} : undef,
 681         $budget->{'budget_permission'}  ? $budget->{'budget_permission'} : undef,
 682         );
 683         $sth->finish;
 684 }
 685
 686 # -------------------------------------------------------------------
 687 sub ModBudget {
 688     my ($budget) = @_;
 689     my $dbh      = C4::Context->dbh;
 690         my $query = qq|
 691     UPDATE aqbudgets
 692     SET budget_code         = ?,
 693         budget_period_id    = ?,
 694         budget_parent_id    = ?,
 695         budget_name         = ?,
 696         budget_branchcode   = ?,
 697         budget_amount       = ?,
 698         budget_amount_sublevel       = ?,
 699         budget_encumb       = ?,
 700         budget_expend       = ?,
 701         budget_notes        = ?,
 702         sort1_authcat       = ?,
 703         sort2_authcat       = ?,
 704         budget_owner_id     = ?,
 705         budget_permission   = ?
 706     WHERE budget_id = ?
 707     |;
 708
 709         my $sth = $dbh->prepare($query);
 710     $sth->execute(
 711         $budget->{'budget_code'}        ? $budget->{'budget_code'} : undef,
 712         $budget->{'budget_period_id'}   ? $budget->{'budget_period_id'} : undef,
 713         $budget->{'budget_parent_id'}   ? $budget->{'budget_parent_id'} : undef,
 714         $budget->{'budget_name'}        ? $budget->{'budget_name'} : undef,
 715         $budget->{'budget_branchcode'}  ? $budget->{'budget_branchcode'} : undef,
 716         $budget->{'budget_amount'}      ? $budget->{'budget_amount'} : undef,
 717         $budget->{'budget_amount_sublevel'}      ? $budget->{'budget_amount_sublevel'} : undef,
 718         $budget->{'budget_encumb'}      ? $budget->{'budget_encumb'} : undef,
 719         $budget->{'budget_expend'}      ? $budget->{'budget_expend'} : undef,
 720         $budget->{'budget_notes'}       ? $budget->{'budget_notes'} : undef,
 721         $budget->{'sort1_authcat'}      ? $budget->{'sort1_authcat'} : undef,
 722         $budget->{'sort2_authcat'}      ? $budget->{'sort2_authcat'} : undef,
 723         $budget->{'budget_owner_id'}    ? $budget->{'budget_owner_id'} : undef,
 724         $budget->{'budget_permission'}  ? $budget->{'budget_permission'} : undef,
 725         $budget->{'budget_id'},
 726     );
 727     $sth->finish;
 728 }
 729
 730 # -------------------------------------------------------------------
 731 sub DelBudget {
 732         my ($budget_id) = @_;
 733         my $dbh         = C4::Context->dbh;
 734         my $sth         = $dbh->prepare("delete from aqbudgets where budget_id=?");
 735         my $rc          = $sth->execute($budget_id);
 736         $sth->finish;
 737         return $rc;
 738 }
 739
 740 =back
 741
 742 =head2 FUNCTIONS ABOUT BUDGETS
 743
 744 =over 2
 745
 746 =cut
 747
 748 =head3 GetBudget
 749
 750 =over 4
 751
 752 &GetBudget($budget_id);
 753
 754 get a specific budget
 755
 756 =back
 757
 758 =cut
 759
 760 # -------------------------------------------------------------------
 761 sub GetBudget {
 762     my ( $budget_id ) = @_;
 763     my $dbh = C4::Context->dbh;
 764     my $query;
 765     my $query = "
 766         SELECT *
 767         FROM   aqbudgets
 768         WHERE  budget_id=?
 769         ";
 770     my $sth = $dbh->prepare($query);
 771     $sth->execute( $budget_id );
 772     my $result = $sth->fetchrow_hashref;
 773     return $result;
 774 }
 775
 776 =head3 GetBudgets
 777
 778 =over 4
 779
 780 &GetBudget($budget_id);
 781
 782 gets all budgets
 783
 784 =back
 785
 786 =cut
 787
 788 # -------------------------------------------------------------------
 789 sub GetBudgets {
 790     my ($active) = @_;
 791     my $dbh      = C4::Context->dbh;
 792     my $q        = "SELECT * from aqbudgets";
 793     my $row;
 794     my $sth;
 795     unless ($active) {
 796         $sth = $dbh->prepare($q);
 797         $sth->execute();
 798     } else {
 799         $q   = "select budget_period_id from aqbudgetperiods where budget_period_active = 1 ";
 800         $sth = $dbh->prepare($q);
 801         $sth->execute();
 802         $row = $sth->fetchrow_hashref();
 803         $q   = "select * from aqbudgets  WHERE budget_period_id =? ";
 804         $sth = $dbh->prepare($q);
 805         $sth->execute( $row->{'budget_period_id'} );
 806     }
 807     my $results = $sth->fetchall_arrayref( {} );
 808     $sth->finish;
 809     return $results;
 810 }
 811
 812 # -------------------------------------------------------------------
 813
 814 =head3 GetCurrencies
 815
 816 @currencies = &GetCurrencies;
 817
 818 Returns the list of all known currencies.
 819
 820 C<$currencies> is a array; its elements are references-to-hash, whose
 821 keys are the fields from the currency table in the Koha database.
 822
 823 =cut
 824
 825 sub GetCurrencies {
 826     my $dbh   = C4::Context->dbh;
 827     my $query = "
 828         SELECT *
 829         FROM   currency
 830     ";
 831     my $sth = $dbh->prepare($query);
 832     $sth->execute;
 833     my @results = ();
 834     while ( my $data = $sth->fetchrow_hashref ) {
 835         push( @results, $data );
 836     }
 837     $sth->finish;
 838     return @results;
 839 }
 840
 841 # -------------------------------------------------------------------
 842
 843 sub GetCurrency {
 844     my $dbh   = C4::Context->dbh;
 845     my $query = "
 846         SELECT * FROM currency where active = '1'    ";
 847     my $sth = $dbh->prepare($query);
 848     $sth->execute;
 849     my $r = $sth->fetchrow_hashref;
 850     $sth->finish;
 851     return $r;
 852 }
 853
 854 =head3 ModCurrencies
 855
 856 &ModCurrencies($currency, $newrate);
 857
 858 Sets the exchange rate for C<$currency> to be C<$newrate>.
 859
 860 =cut
 861
 862 sub ModCurrencies {
 863     my ( $currency, $rate ) = @_;
 864     my $dbh   = C4::Context->dbh;
 865     my $query = qq|
 866         UPDATE currency
 867         SET    rate=?
 868         WHERE  currency=? |;
 869     my $sth = $dbh->prepare($query);
 870     $sth->execute( $rate, $currency );
 871 }
 872
 873 # -------------------------------------------------------------------
 874
 875 =head3 ConvertCurrency
 876
 877 $foreignprice = &ConvertCurrency($currency, $localprice);
 878
 879 Converts the price C<$localprice> to foreign currency C<$currency> by
 880 dividing by the exchange rate, and returns the result.
 881
 882 If no exchange rate is found,e is one
 883 to one.
 884
 885 =cut
 886
 887 sub ConvertCurrency {
 888     my ( $currency, $price ) = @_;
 889     my $dbh   = C4::Context->dbh;
 890     my $query = "
 891         SELECT rate
 892         FROM   currency
 893         WHERE  currency=?
 894     ";
 895     my $sth = $dbh->prepare($query);
 896     $sth->execute($currency);
 897     my $cur = ( $sth->fetchrow_array() )[0];
 898     unless ($cur) {
 899         $cur = 1;
 900     }
 901     return ( $price / $cur );
 902 }
 903
 904 END { }    # module clean-up code here (global destructor)
 905
 906 1;
 907 __END__
 908
 909 =back
 910
 911 =head1 AUTHOR
 912
 913 Koha Developement team <info@koha.org>
 914
 915 =cut