"Fossies" - the Fresh Open Source Software Archive

Member "koha-19.11.15/members/statistics.pl" (23 Feb 2021, 6428 Bytes) of package /linux/misc/koha-19.11.15.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "statistics.pl" see the Fossies "Dox" file reference documentation and the last Fossies "Diffs" side-by-side code changes report: 20.05.06_vs_20.11.00.

    1 #!/usr/bin/perl
    2 
    3 # Copyright 2012 BibLibre
    4 # This file is part of Koha.
    5 #
    6 # Koha is free software; you can redistribute it and/or modify it under the
    7 # terms of the GNU General Public License as published by the Free Software
    8 # Foundation; either version 2 of the License, or (at your option) any later
    9 # version.
   10 #
   11 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
   12 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
   13 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
   14 #
   15 # You should have received a copy of the GNU General Public License along with
   16 # Koha; if not, write to the Free Software Foundation, Inc.,
   17 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
   18 
   19 =head1 members/statistics.pl
   20 
   21   Generate statistic issues for a member
   22 
   23 =cut
   24 
   25 use Modern::Perl;
   26 
   27 use CGI qw ( -utf8 );
   28 use C4::Auth;
   29 use C4::Context;
   30 use C4::Members;
   31 use C4::Members::Statistics;
   32 use C4::Output;
   33 use Koha::Patrons;
   34 use Koha::Patron::Categories;
   35 
   36 my $input = new CGI;
   37 
   38 my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
   39     {   template_name   => "members/statistics.tt",
   40         query           => $input,
   41         type            => "intranet",
   42         flagsrequired   => { borrowers => 'edit_borrowers' },
   43         debug           => 1,
   44     }
   45 );
   46 
   47 my $borrowernumber = $input->param('borrowernumber');
   48 
   49 my $logged_in_user = Koha::Patrons->find( $loggedinuser ) or die "Not logged in";
   50 my $patron         = Koha::Patrons->find( $borrowernumber );
   51 output_and_exit_if_error( $input, $cookie, $template, { module => 'members', logged_in_user => $logged_in_user, current_patron => $patron } );
   52 
   53 my $category = $patron->category;
   54 
   55 # Construct column names
   56 my $fields = C4::Members::Statistics::get_fields();
   57 our @statistic_column_names = split '\|', $fields;
   58 our @value_column_names = ( 'count_precedent_state', 'count_total_issues_today', 'count_total_issues_returned_today' );
   59 our @column_names = ( @statistic_column_names, @value_column_names );
   60 
   61 # Get statistics
   62 my $precedent_state = GetPrecedentStateByBorrower( $borrowernumber );
   63 my $total_issues_today = GetTotalIssuesTodayByBorrower( $borrowernumber );
   64 my $total_issues_returned_today = GetTotalIssuesReturnedTodayByBorrower( $borrowernumber );
   65 my $r = merge (
   66     @$precedent_state, @$total_issues_today, @$total_issues_returned_today
   67 );
   68 
   69 add_actual_state( $r );
   70 my ( $total, $datas ) = build_array( $r );
   71 
   72 # Gettings sums
   73 my $count_total_precedent_state = $total->{count_precedent_state} || 0;
   74 my $count_total_issues = $total->{count_total_issues_today} || 0;
   75 my $count_total_issues_returned = $total->{count_total_issues_returned_today} || 0;
   76 my $count_total_actual_state = ($count_total_precedent_state - $count_total_issues_returned + $count_total_issues);
   77 
   78 $template->param(
   79     patron             => $patron,
   80     statisticsview     => 1,
   81     datas              => $datas,
   82     column_names       => \@statistic_column_names,
   83     count_total_issues => $count_total_issues,
   84     count_total_issues_returned => $count_total_issues_returned,
   85     count_total_precedent_state => $count_total_precedent_state,
   86     count_total_actual_state => $count_total_actual_state,
   87 );
   88 
   89 output_html_with_http_headers $input, $cookie, $template->output;
   90 
   91 
   92 =head1 FUNCTIONS
   93 
   94 =head2 add_actual_state
   95 
   96   Add a 'count_actual_state' key in all hashes
   97   count_actual_state = count_precedent_state - count_total_issues_returned_today + count_total_issues_today
   98 
   99 =cut
  100 
  101 sub add_actual_state {
  102     my ( $array ) = @_;
  103     for my $hash ( @$array ) {
  104         $hash->{count_actual_state} = ( $hash->{count_precedent_state} // 0 ) - ( $hash->{count_total_issues_returned_today} // 0 ) + ( $hash->{count_total_issues_today} // 0 );
  105     }
  106 }
  107 
  108 =head2 build_array
  109 
  110   Build a new array containing values of hashes.
  111   It used by template whitch display silly values.
  112   ex:
  113     $array = [
  114       {
  115         'count_total_issues_returned_today' => 1,
  116         'ccode' => 'ccode',
  117         'count_actual_state' => 1,
  118         'count_precedent_state' => 1,
  119         'homebranch' => 'homebranch',
  120         'count_total_issues_today' => 1,
  121         'itype' => 'itype'
  122       }
  123     ];
  124   and returns:
  125     [
  126       [
  127         'homebranch',
  128         'itype',
  129         'ccode',
  130         1,
  131         1,
  132         1,
  133         1
  134       ]
  135     ];
  136 
  137 =cut
  138 
  139 sub build_array {
  140     my ( $array ) = @_;
  141     my ( @r, $total );
  142     for my $hash ( @$array) {
  143         my @line;
  144         for my $cn ( ( @column_names, 'count_actual_state') ) {
  145             if ( grep /$cn/, ( @value_column_names, 'count_actual_state') ) {
  146                 $hash->{$cn} //= 0;
  147                 if ( exists $total->{$cn} ) {
  148                     $total->{$cn} += $hash->{$cn} if $hash->{$cn};
  149                 } else {
  150                     $total->{$cn} = $hash->{$cn};
  151                 }
  152             }
  153             push @line, $hash->{$cn};
  154         }
  155         push @r, \@line;
  156     }
  157     return ( $total, \@r );
  158 }
  159 
  160 =head2 merge
  161 
  162   Merge hashes with the same statistic column names into one
  163   param: array, a arrayref of arrayrefs
  164   ex:
  165   @array = (
  166      {
  167        'ccode' => 'ccode',
  168        'count_precedent_state' => '1',
  169        'homebranch' => 'homebranch',
  170        'itype' => 'itype'
  171      },
  172      {
  173        'count_total_issues_returned_today' => '1',
  174        'ccode' => 'ccode',
  175        'homebranch' => 'homebranch',
  176        'itype' => 'itype'
  177      }
  178    );
  179    and returns:
  180    [
  181      {
  182        'count_total_issues_returned_today' => '1',
  183        'ccode' => 'ccode',
  184        'count_precedent_state' => '1',
  185        'homebranch' => 'homebranch',
  186        'itype' => 'itype'
  187      }
  188    ];
  189 
  190 =cut
  191 
  192 sub merge {
  193     my @array = @_;
  194     my @r;
  195     for my $h ( @array ) {
  196         my $exists = 0;
  197         for my $ch ( @r ) {
  198             $exists = 1;
  199             for my $cn ( @statistic_column_names ) {
  200                 if (   ( not defined $ch->{$cn} && defined $h->{$cn} )
  201                     || ( defined $ch->{$cn} && not defined $h->{$cn} )
  202                     || ( $ch->{$cn} ne $h->{$cn} ) )
  203                 {
  204                     $exists = 0;
  205                     last;
  206                 }
  207             }
  208             if ($exists){
  209                 for my $cn ( @value_column_names ) {
  210                     next if not exists $h->{$cn};
  211                     $ch->{$cn} = $h->{$cn} ? $h->{$cn} : 0;
  212                 }
  213                 last;
  214             }
  215         }
  216 
  217         if ( not $exists ) {push @r, $h;}
  218     }
  219     return \@r;
  220 }