| Lines 1-141
          
      
      
        Link Here | 
            
              | 1 | #!/usr/bin/perl  |  |  | 
            
              | 2 |  | 
            
              | 3 | # Copyright (C) 2010 Tamil s.a.r.l. | 
            
              | 4 | # | 
            
              | 5 | # This file is part of Koha. | 
            
              | 6 | # | 
            
              | 7 | # Koha is free software; you can redistribute it and/or modify it | 
            
              | 8 | # under the terms of the GNU General Public License as published by | 
            
              | 9 | # the Free Software Foundation; either version 3 of the License, or | 
            
              | 10 | # (at your option) any later version. | 
            
              | 11 | # | 
            
              | 12 | # Koha is distributed in the hope that it will be useful, but | 
            
              | 13 | # WITHOUT ANY WARRANTY; without even the implied warranty of | 
            
              | 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | 
            
              | 15 | # GNU General Public License for more details. | 
            
              | 16 | # | 
            
              | 17 | # You should have received a copy of the GNU General Public License | 
            
              | 18 | # along with Koha; if not, see <http://www.gnu.org/licenses>. | 
            
              | 19 |  | 
            
              | 20 | use strict; | 
            
              | 21 | use warnings; | 
            
              | 22 |  | 
            
              | 23 | use Test::More qw(no_plan); | 
            
              | 24 |  | 
            
              | 25 | use C4::Context; | 
            
              | 26 |  | 
            
              | 27 | my $root_dir = 'installer/data/mysql'; | 
            
              | 28 | my $base_perms_file = "en/mandatory/userpermissions.sql"; | 
            
              | 29 | my @trans_perms_files = qw( | 
            
              | 30 |     de-DE/mandatory/userpermissions.sql | 
            
              | 31 |     it-IT/necessari/userpermissions.sql | 
            
              | 32 |     fr-FR/1-Obligatoire/userpermissions.sql | 
            
              | 33 |     uk-UA/mandatory/permissions_and_user_flags.sql | 
            
              | 34 |     ru-RU/mandatory/permissions_and_user_flags.sql | 
            
              | 35 |     pl-PL/mandatory/userpermissions.sql | 
            
              | 36 |     nb-NO/1-Obligatorisk/userpermissions.sql | 
            
              | 37 |     es-ES/mandatory/userpermissions.sql | 
            
              | 38 | ); | 
            
              | 39 |  | 
            
              | 40 | ok( | 
            
              | 41 |     open( my $ref_fh, "<$root_dir/$base_perms_file" ), | 
            
              | 42 |     "Open reference user permissions file $root_dir/$base_perms_file" ); | 
            
              | 43 | my $ref_perm = get_perms_from_file( $ref_fh ); | 
            
              | 44 | my @ref_perms = sort { lc $a cmp lc $b } keys %$ref_perm; | 
            
              | 45 | cmp_ok( | 
            
              | 46 |     $#ref_perms, '>=', 0, | 
            
              | 47 |     "Found " . ($#ref_perms + 1) . " user permissions" ); | 
            
              | 48 |  | 
            
              | 49 | foreach my $file_name ( @trans_perms_files ) { | 
            
              | 50 |     compare_perms( $file_name ); | 
            
              | 51 | } | 
            
              | 52 |  | 
            
              | 53 |  | 
            
              | 54 | # | 
            
              | 55 | # Get user permissions from SQL file populating permissions table with INSERT | 
            
              | 56 | # statement. | 
            
              | 57 | # | 
            
              | 58 | # Example: | 
            
              | 59 | #  INSERT INTO permissions (module_bit, code, description) VALUES | 
            
              | 60 | #  ( 1, 'override_renewals', 'Override blocked renewals'), | 
            
              | 61 | # | 
            
              | 62 | sub get_perms_from_file { | 
            
              | 63 |     my $fh = shift; | 
            
              | 64 |     my %perm; | 
            
              | 65 |     my $found_insert = 0; | 
            
              | 66 |     while ( <$fh> ) { | 
            
              | 67 |         next if /^--/; # Comment line | 
            
              | 68 |         $found_insert = 1 if /insert\s+into/i and /permissions/i; | 
            
              | 69 |         next unless $found_insert; | 
            
              | 70 |         #/VALUES.*\(\'([\w\-:]+)\'/; | 
            
              | 71 |         /,\s*\'(.*?)\'/; | 
            
              | 72 |         my $variable = $1; | 
            
              | 73 |         next unless $variable; | 
            
              | 74 |         $perm{$variable} = 1; | 
            
              | 75 |     } | 
            
              | 76 |     return \%perm; | 
            
              | 77 | } | 
            
              | 78 |  | 
            
              | 79 |  | 
            
              | 80 | sub compare_perms { | 
            
              | 81 |     my $trans_file = shift; | 
            
              | 82 |     ok( | 
            
              | 83 |        open( my $trans_fh, "<$root_dir/$trans_file" ), | 
            
              | 84 |        "Open translated user permissions file $root_dir/$trans_file" ); | 
            
              | 85 |     my $trans_perm = get_perms_from_file( $trans_fh ); | 
            
              | 86 |     my @trans_perms = sort { lc $a cmp lc $b } keys %$trans_perm; | 
            
              | 87 |     cmp_ok( | 
            
              | 88 |         $#trans_perms, '>=', 0, | 
            
              | 89 |         "Found " . ($#trans_perms + 1) . " perms" ); | 
            
              | 90 |  | 
            
              | 91 |     my @to_add_perms; | 
            
              | 92 |     foreach ( @ref_perms ) { | 
            
              | 93 |        push @to_add_perms, $_ if ! $trans_perm->{$_}; | 
            
              | 94 |     } | 
            
              | 95 |     if ( $#to_add_perms >= 0 ) { | 
            
              | 96 |         fail( 'No user permissions to add') or diag( "User permissions to add in $trans_file: " . join(', ', @to_add_perms ) ); | 
            
              | 97 |     } | 
            
              | 98 |     else { | 
            
              | 99 |         pass( 'No user permissions to add' ); | 
            
              | 100 |     } | 
            
              | 101 |  | 
            
              | 102 |     my @to_delete_perms; | 
            
              | 103 |     foreach ( @trans_perms ) { | 
            
              | 104 |        push @to_delete_perms, $_ if ! $ref_perm->{$_}; | 
            
              | 105 |     } | 
            
              | 106 |     if ( $#to_delete_perms >= 0 ) { | 
            
              | 107 |         fail( 'No user permissions to delete' ); | 
            
              | 108 |         diag( "User permissions to delete in $trans_file: " . join(', ', @to_delete_perms ) ); | 
            
              | 109 |         diag( 'Warning: Some of those user permissions may rather have to be added to English permissions' ); | 
            
              | 110 |     } | 
            
              | 111 |     else { | 
            
              | 112 |         pass( 'No user permissions to delete' ); | 
            
              | 113 |     } | 
            
              | 114 | } | 
            
              | 115 |  | 
            
              | 116 |  | 
            
              | 117 | =head1 NAME | 
            
              | 118 |  | 
            
              | 119 | permissions.t | 
            
              | 120 |  | 
            
              | 121 | =head1 DESCRIPTION | 
            
              | 122 |  | 
            
              | 123 | This test identifies incoherences between translated user permissions files and | 
            
              | 124 | the 'en' reference file. | 
            
              | 125 |  | 
            
              | 126 | Koha user permissions are loaded to 'permissions' table from a text SQL file | 
            
              | 127 | during Koha installation by web installer. The reference file is the one | 
            
              | 128 | provided for English (en) installation : | 
            
              | 129 |  | 
            
              | 130 |   <koha_root>/installer/data/mysql/en/mandatory/userpermissions.sql | 
            
              | 131 |  | 
            
              | 132 | Alternatives files are provided for other languages. Those files | 
            
              | 133 | are difficult to keep syncrhonized with reference file. | 
            
              | 134 |  | 
            
              | 135 | =head1 USAGE | 
            
              | 136 |  | 
            
              | 137 |  prove -v permissions.t | 
            
              | 138 |  prove permissions.t | 
            
              | 139 |  | 
            
              | 140 | =cut | 
            
              | 141 |  | 
            
              | 142 | -  |