@@ -, +, @@ correctly. --- C4/Reports/Guided.pm | 213 ++++++++++++++++++++++++++++++++++++++-- reports/guided_reports.pl | 132 +++++-------------------- t/db_dependent/Reports/Guided.t | 113 +++++++++++++++++++-- 3 files changed, 336 insertions(+), 122 deletions(-) --- a/C4/Reports/Guided.pm +++ a/C4/Reports/Guided.pm @@ -45,6 +45,8 @@ BEGIN { nb_rows update_sql GetReservedAuthorisedValues GetParametersFromSQL + GetSQLAuthValueResult + GetPreppedSQLReport IsAuthorisedValueValid ValidateSQLParameters nb_rows update_sql @@ -838,6 +840,135 @@ sub _get_column_defs { return \%columns; } +sub _authval_resultvalue_authval { + my $parm = shift; + my %tmp = ( 'input' => $parm->{'authval'} ); + return \%tmp; +} + +sub _authval_resultvalue_branches { + my $parm = shift; + + my @authorised_values; + my %authorised_lib; + + # builds list, depending on authorised value... + my $libraries = Koha::Libraries->search( {}, { order_by => ['branchname'] } ); + while ( my $library = $libraries->next ) { + push @authorised_values, $library->branchcode; + $authorised_lib{$library->branchcode} = $library->branchname; + } + + my %tmp = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + return \%tmp; +} + +sub _authval_resultvalue_itemtypes { + my $parm = shift; + + my @authorised_values; + my %authorised_lib; + my $dbh=C4::Context->dbh; + # builds list, depending on authorised value... + my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description"); + $sth->execute; + while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) { + push @authorised_values, $itemtype; + $authorised_lib{$itemtype} = $description; + } + + my %tmp = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + return \%tmp; +} + +sub _authval_resultvalue_biblio_framework { + my $parm = shift; + + my @authorised_values; + my %authorised_lib; + + # builds list, depending on authorised value... + my @frameworks = Koha::BiblioFrameworks->search({}, { order_by => ['frameworktext'] }); + my $default_source = ''; + push @authorised_values,$default_source; + $authorised_lib{$default_source} = 'Default'; + foreach my $framework (@frameworks) { + push @authorised_values, $framework->frameworkcode; + $authorised_lib{$framework->frameworkcode} = $framework->frameworktext; + } + + my %tmp = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + return \%tmp; +} + +sub _authval_resultvalue_biblio_cn_source { + my $parm = shift; + + my @authorised_values; + my %authorised_lib; + + # builds list, depending on authorised value... + my $class_sources = GetClassSources(); + my $default_source = C4::Context->preference("DefaultClassificationSource"); + foreach my $class_source (sort keys %$class_sources) { + next unless $class_sources->{$class_source}->{'used'} or + ($class_source eq $default_source); + push @authorised_values, $class_source; + $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'}; + } + + my %tmp = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + return \%tmp; +} + +sub _authval_resultvalue_biblio_categorycode { + my $parm = shift; + + my @authorised_values; + my %authorised_lib; + + # builds list, depending on authorised value... + my @patron_categories = Koha::Patron::Categories->search({}, { order_by => ['description']}); + %authorised_lib = map { $_->categorycode => $_->description } @patron_categories; + push @authorised_values, $_->categorycode for @patron_categories; + + my %tmp = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + return \%tmp; +} + +sub authval_prepvalue_date { + my ($parm, $quoted) = @_; + $quoted = output_pref({ dt => dt_from_string($quoted), dateformat => 'iso', dateonly => 1 }) if $quoted; + return $quoted; +} + +# reserved_savedsql_auth_values contains the special replacement authority values +# used in saved SQL queries. +# +# The 'auth' function takes a hashref - one element returned from GetParametersFromSQL - and +# must return a hashref with one of: +# - 'values' and 'labels' +# (for a dropdown menu) +# - 'input' +# (for an input field) +# - 'auth_val_error' and 'data' +# (in case of error) +# +# The 'prep' function is used to reformat the input we got from the user, so it can +# be used in SQL query. It takes in a hashref (one element from GetParametersFromSQL) and +# the input string, and must return the correctly formatted string which will be used in +# the SQL query. +# +my %reserved_savedsql_auth_values = ( + 'date' => {'auth' => \&_authval_resultvalue_authval, 'prep' => \&_authval_prepvalue_date}, + 'text' => {'auth' => \&_authval_resultvalue_authval}, + 'branches' => {'auth' => \&_authval_resultvalue_branches}, + 'itemtypes' => {'auth' => \&_authval_resultvalue_itemtypes}, + 'cn_source' => {'auth' => \&_authval_resultvalue_biblio_cn_source}, + 'categorycode' => {'auth' => \&_authval_resultvalue_biblio_categorycode}, + 'biblio_framework' => {'auth' => \&_authval_resultvalue_biblio_framework}, + ); + =head2 GetReservedAuthorisedValues my %reserved_authorised_values = GetReservedAuthorisedValues(); @@ -848,16 +979,52 @@ Returns a hash containig all reserved words sub GetReservedAuthorisedValues { my %reserved_authorised_values = - map { $_ => 1 } ( 'date', - 'branches', - 'itemtypes', - 'cn_source', - 'categorycode', - 'biblio_framework' ); + map { $_ => 1 } ( keys(%reserved_savedsql_auth_values) ); return \%reserved_authorised_values; } +=head2 GetSQLAuthValueResult + + my $params = GetParametersFromSQL($sql); + my $authdata = GetSQLAuthValueResult(@{$params}[0]); + +=cut + +sub GetSQLAuthValueResult { + my $authparam = shift; + my $authorised_value = $authparam->{'authval'}; + my %ret; + + if (defined($reserved_savedsql_auth_values{$authorised_value})) { + return &{$reserved_savedsql_auth_values{$authorised_value}{'auth'}}($authparam); + } elsif ( Koha::AuthorisedValues->search({ category => $authorised_value })->count ) { + my @authorised_values; + my %authorised_lib; + my $query = ' + SELECT authorised_value,lib + FROM authorised_values + WHERE category=? + ORDER BY lib + '; + my $dbh=C4::Context->dbh; + my $authorised_values_sth = $dbh->prepare($query); + $authorised_values_sth->execute( $authorised_value); + + while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) { + push @authorised_values, $value; + $authorised_lib{$value} = $lib; + } + %ret = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + } else { + %ret = ( 'auth_val_error' => 1, + 'data' => { + 'entry' => $authparam->{'name'}, + 'auth_val' => $authorised_value + } ); + } + return \%ret; +} =head2 IsAuthorisedValueValid @@ -895,14 +1062,46 @@ sub GetParametersFromSQL { my @split = split(/<<|>>/,$sql); my @sql_parameters = (); + # split on ??. Each odd (2,4,6,...) entry should be a parameter to fill for ( my $i = 0; $i < ($#split/2) ; $i++ ) { my ($name,$authval) = split(/\|/,$split[$i*2+1]); - push @sql_parameters, { 'name' => $name, 'authval' => $authval }; + $authval ||= 'text'; + push @sql_parameters, { 'name' => $name, 'authval' => $authval, 'rawparam' => $split[$i*2+1] }; } return \@sql_parameters; } +=head2 GetPreppedSQLReport + + my $sql = GetPreppedSQLReport( $sql, \@param_names, \@sql_params ); + +Returns an executable query + +=cut + +sub GetPreppedSQLReport { + my ($sql, $param_names, $sql_params ) = @_; + my %lookup; + @lookup{@$param_names} = @$sql_params; + my $split = GetParametersFromSQL( $sql ); + my @tmpl_parameters; + my $i = 0; + foreach my $parm (@$split) { + my $raw = $parm->{'rawparam'}; + my $quoted = @$param_names ? $lookup{ $raw } : @$sql_params[$i]; + # if there are special regexp chars, we must \ them + $raw =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g; + if (defined($reserved_savedsql_auth_values{$parm->{'authval'}}{'prep'})) { + $quoted = &{$reserved_savedsql_auth_values{$parm->{'authval'}}{'prep'}}($parm, $quoted); + } + $quoted = C4::Context->dbh->quote($quoted); + $sql =~ s/<<$raw>>/$quoted/; + $i++; + } + return $sql; +} + =head2 ValidateSQLParameters my @problematic_parameters = ValidateSQLParameters($sql) --- a/reports/guided_reports.pl +++ a/reports/guided_reports.pl @@ -693,109 +693,43 @@ elsif ($phase eq 'Run this report'){ $notes = $report->notes; my @rows = (); + my $split = GetParametersFromSQL( $sql ); + # if we have at least 1 parameter, and it's not filled, then don't execute but ask for parameters - if ($sql =~ /<>/,$sql; + if (scalar(@$split) && !@sql_params) { my @tmpl_parameters; my @authval_errors; my %uniq_params; - for(my $i=0;$i<($#split/2);$i++) { - my ($text,$authorised_value) = split /\|/,$split[$i*2+1]; + my $i = 0; + foreach my $parm (@$split) { + my $text = $parm->{'name'}; + my $authorised_value = $parm->{'authval'}; my $sep = $authorised_value ? "|" : ""; + $i++; if( defined $uniq_params{$text.$sep.$authorised_value} ){ next; } else { $uniq_params{$text.$sep.$authorised_value} = "$i"; } my $input; my $labelid; - if ( not defined $authorised_value ) { - # no authorised value input, provide a text box - $input = "text"; - } elsif ( $authorised_value eq "date" ) { - # require a date, provide a date picker - $input = 'date'; - } else { - # defined $authorised_value, and not 'date' - my $dbh=C4::Context->dbh; - my @authorised_values; - my %authorised_lib; - # builds list, depending on authorised value... - if ( $authorised_value eq "branches" ) { - my $libraries = Koha::Libraries->search( {}, { order_by => ['branchname'] } ); - while ( my $library = $libraries->next ) { - push @authorised_values, $library->branchcode; - $authorised_lib{$library->branchcode} = $library->branchname; - } - } - elsif ( $authorised_value eq "itemtypes" ) { - my $sth = $dbh->prepare("SELECT itemtype,description FROM itemtypes ORDER BY description"); - $sth->execute; - while ( my ( $itemtype, $description ) = $sth->fetchrow_array ) { - push @authorised_values, $itemtype; - $authorised_lib{$itemtype} = $description; - } - } - elsif ( $authorised_value eq "biblio_framework" ) { - my @frameworks = Koha::BiblioFrameworks->search({}, { order_by => ['frameworktext'] }); - my $default_source = ''; - push @authorised_values,$default_source; - $authorised_lib{$default_source} = 'Default'; - foreach my $framework (@frameworks) { - push @authorised_values, $framework->frameworkcode; - $authorised_lib{$framework->frameworkcode} = $framework->frameworktext; - } - } - elsif ( $authorised_value eq "cn_source" ) { - my $class_sources = GetClassSources(); - my $default_source = C4::Context->preference("DefaultClassificationSource"); - foreach my $class_source (sort keys %$class_sources) { - next unless $class_sources->{$class_source}->{'used'} or - ($class_source eq $default_source); - push @authorised_values, $class_source; - $authorised_lib{$class_source} = $class_sources->{$class_source}->{'description'}; - } - } - elsif ( $authorised_value eq "categorycode" ) { - my @patron_categories = Koha::Patron::Categories->search({}, { order_by => ['description']}); - %authorised_lib = map { $_->categorycode => $_->description } @patron_categories; - push @authorised_values, $_->categorycode for @patron_categories; - } - else { - if ( Koha::AuthorisedValues->search({ category => $authorised_value })->count ) { - my $query = ' - SELECT authorised_value,lib - FROM authorised_values - WHERE category=? - ORDER BY lib - '; - my $authorised_values_sth = $dbh->prepare($query); - $authorised_values_sth->execute( $authorised_value); - - while ( my ( $value, $lib ) = $authorised_values_sth->fetchrow_array ) { - push @authorised_values, $value; - $authorised_lib{$value} = $lib; - # For item location, we show the code and the libelle - $authorised_lib{$value} = $lib; - } - } else { - # not exists $authorised_value_categories{$authorised_value}) - push @authval_errors, {'entry' => $text, - 'auth_val' => $authorised_value }; - # tell the template there's an error - $template->param( auth_val_error => 1 ); - # skip scrolling list creation and params push - next; - } - } + + my $ret = GetSQLAuthValueResult($parm); + + if (defined($ret->{'values'})) { $labelid = $text; $labelid =~ s/\W//g; $input = { name => "sql_params", id => "sql_params_".$labelid, - values => \@authorised_values, - labels => \%authorised_lib, + values => $ret->{'values'}, + labels => $ret->{'labels'}, }; - } + } elsif (defined($ret->{'auth_val_error'})) { + push(@authval_errors, $ret->{'data'}); + $template->param( auth_val_error => 1 ); + next; + } else { + $input = $ret->{'input'}; + } push @tmpl_parameters, {'entry' => $text, 'input' => $input, 'labelid' => $labelid, 'name' => $text.$sep.$authorised_value }; } @@ -807,7 +741,7 @@ elsif ($phase eq 'Run this report'){ 'reports' => $report_id, ); } else { - my $sql = get_prepped_report( $sql, \@param_names, \@sql_params); + my $sql = GetPreppedSQLReport( $sql, \@param_names, \@sql_params); my ( $sth, $errors ) = execute_query( $sql, $offset, $limit, undef, $report_id ); my $total = nb_rows($sql) || 0; unless ($sth) { @@ -859,7 +793,7 @@ elsif ($phase eq 'Export'){ my $reportname = $input->param('reportname'); my $reportfilename = $reportname ? "$reportname-reportresults.$format" : "reportresults.$format" ; - $sql = get_prepped_report( $sql, \@param_names, \@sql_params ); + $sql = GetPreppedSQLReport( $sql, \@param_names, \@sql_params ); my ($sth, $q_errors) = execute_query($sql); unless ($q_errors and @$q_errors) { my ( $type, $content ); @@ -1052,23 +986,3 @@ sub create_non_existing_group_and_subgroup { } } } - -# pass $sth and sql_params, get back an executable query -sub get_prepped_report { - my ($sql, $param_names, $sql_params ) = @_; - my %lookup; - @lookup{@$param_names} = @$sql_params; - my @split = split /<<|>>/,$sql; - my @tmpl_parameters; - for(my $i=0;$i<$#split/2;$i++) { - my $quoted = @$param_names ? $lookup{ $split[$i*2+1] } : @$sql_params[$i]; - # if there are special regexp chars, we must \ them - $split[$i*2+1] =~ s/(\||\?|\.|\*|\(|\)|\%)/\\$1/g; - if ($split[$i*2+1] =~ /\|\s*date\s*$/) { - $quoted = output_pref({ dt => dt_from_string($quoted), dateformat => 'iso', dateonly => 1 }) if $quoted; - } - $quoted = C4::Context->dbh->quote($quoted); - $sql =~ s/<<$split[$i*2+1]>>/$quoted/; - } - return $sql; -} --- a/t/db_dependent/Reports/Guided.t +++ a/t/db_dependent/Reports/Guided.t @@ -18,7 +18,7 @@ use Modern::Perl; -use Test::More tests => 9; +use Test::More tests => 11; use Test::Warn; use t::lib::TestBuilder; @@ -110,6 +110,7 @@ subtest 'GetReservedAuthorisedValues' => sub { # to GetReservedAuthorisedValues my %test_authval = ( 'date' => 1, + 'text' => 1, 'branches' => 1, 'itemtypes' => 1, 'cn_source' => 1, @@ -123,7 +124,7 @@ subtest 'GetReservedAuthorisedValues' => sub { }; subtest 'IsAuthorisedValueValid' => sub { - plan tests => 8; + plan tests => 9; ok( IsAuthorisedValueValid('LOC'), 'User defined authorised value category is valid'); @@ -148,16 +149,16 @@ subtest 'GetParametersFromSQL+ValidateSQLParameters' => sub { "; my @test_parameters_with_custom_list = ( - { 'name' => 'Year', 'authval' => 'custom_list' }, - { 'name' => 'Branch', 'authval' => 'branches' }, - { 'name' => 'Borrower', 'authval' => undef } + { 'name' => 'Year', 'authval' => 'custom_list', 'rawparam' => 'Year|custom_list' }, + { 'name' => 'Branch', 'authval' => 'branches', 'rawparam' => 'Branch|branches' }, + { 'name' => 'Borrower', 'authval' => 'text', 'rawparam' => 'Borrower' } ); is_deeply( GetParametersFromSQL($test_query_1), \@test_parameters_with_custom_list, 'SQL params are correctly parsed'); my @problematic_parameters = (); - push @problematic_parameters, { 'name' => 'Year', 'authval' => 'custom_list' }; + push @problematic_parameters, { 'name' => 'Year', 'authval' => 'custom_list', 'rawparam' => 'Year|custom_list' }; is_deeply( ValidateSQLParameters( $test_query_1 ), \@problematic_parameters, '\'custom_list\' not a valid category' ); @@ -176,6 +177,106 @@ subtest 'GetParametersFromSQL+ValidateSQLParameters' => sub { ); }; +subtest 'GetSQLAuthValueResult' => sub { + plan tests => 4; + + my $test_query_1 = "<> <> foo <> <> <> <>"; + my $params = GetParametersFromSQL( $test_query_1 ); + + + my %test_1_return = ( 'input' => 'text' ); + + is_deeply( GetSQLAuthValueResult(@{$params}[0]), + \%test_1_return, + 'Returned implicit text parameter correctly'); + + + my %test_2_return = ( 'input' => 'text' ); + + is_deeply( GetSQLAuthValueResult(@{$params}[1]), + \%test_1_return, + 'Returned explicit text parameter correctly'); + + + my %test_3_return = ( 'input' => 'date' ); + + is_deeply( GetSQLAuthValueResult(@{$params}[2]), + \%test_3_return, + 'Returned date parameter correctly'); + + + # same as _authval_resultvalue_branches() in C4/Reports/Guided.pm + my @authorised_values; + my %authorised_lib; + my $libraries = Koha::Libraries->search( {}, { order_by => ['branchname'] } ); + while ( my $library = $libraries->next ) { + push @authorised_values, $library->branchcode; + $authorised_lib{$library->branchcode} = $library->branchname; + } + my %test_4_return = ( 'values' => \@authorised_values, 'labels' => \%authorised_lib ); + + is_deeply( GetSQLAuthValueResult(@{$params}[3]), + \%test_4_return, + 'Returned branches parameter correctly'); +}; + +subtest 'GetPreppedSQLReport' => sub { + plan tests => 5; + + # Test without parameters + my @paramnames = (); + my @sql_params = (); + + my $test_query_1 = "SELECT foo FROM bar WHERE qux"; + + is( GetPreppedSQLReport( $test_query_1, \@paramnames, \@sql_params ), $test_query_1, + 'Returns exact same SQL when no parameters to substitute'); + + + # Test completely unknown parameters + my $test_query_2 = "SELECT foo FROM bar WHERE <>"; + + is( GetPreppedSQLReport( $test_query_2, \@paramnames, \@sql_params ), + "SELECT foo FROM bar WHERE NULL", + 'Returns completely unknown parameters as NULLs'); + + + # Test unknown parameters + @paramnames = ( "qux" ); + my $test_query_3 = "SELECT foo FROM bar WHERE <>"; + + is( GetPreppedSQLReport( $test_query_3, \@paramnames, \@sql_params ), + "SELECT foo FROM bar WHERE NULL", + 'Returns parameters with unknown sql_param as NULLs'); + + + + # Test parameter substitution + @paramnames = ( "qux" ); + @sql_params = ( "XXXX" ); + + my $test_query_4 = "foo qux <> bar"; + my $test_query_4_temp = "foo qux ? bar"; + + my $dbh = C4::Context->dbh; + my $test_query_4_ok = "foo qux " . $dbh->quote($sql_params[0]) . " bar"; + + is( GetPreppedSQLReport( $test_query_4, \@paramnames, \@sql_params ), + $test_query_4_ok, + 'Returns parameter substituted'); + + + # Test character escaping (and NULL params, too) + @paramnames = ( "qu*x" ); + @sql_params = ( "XXX" ); + my $test_query_5 = "foo <> <> <> bar"; + my $test_query_5_ok = "foo NULL NULL " . $dbh->quote($sql_params[0]) . " bar"; + + is( GetPreppedSQLReport( $test_query_5, \@paramnames, \@sql_params ), + $test_query_5_ok, + 'Handles escaping parameters'); +}; + subtest 'get_saved_reports' => sub { plan tests => 16; my $dbh = C4::Context->dbh; --