|
Lines 1-7
Link Here
|
| 1 |
package Koha::Devel::Sysprefs; |
1 |
package Koha::Devel::Sysprefs; |
| 2 |
|
2 |
|
| 3 |
use Modern::Perl; |
3 |
use Modern::Perl; |
| 4 |
use File::Slurp qw(read_file); |
4 |
use File::Slurp qw(read_file write_file); |
|
|
5 |
|
| 6 |
use C4::Context; |
| 5 |
|
7 |
|
| 6 |
=head1 NAME |
8 |
=head1 NAME |
| 7 |
|
9 |
|
|
Lines 37-42
sub new {
Link Here
|
| 37 |
return $self; |
39 |
return $self; |
| 38 |
} |
40 |
} |
| 39 |
|
41 |
|
|
|
42 |
=head2 extract_syspref_from_line |
| 43 |
|
| 44 |
my $pref = $syspref_handler->extract_syspref_from_line($line); |
| 45 |
|
| 46 |
Parse a line from sysprefs.sql and return a hashref containing the different syspref's values |
| 47 |
|
| 48 |
=cut |
| 49 |
|
| 50 |
sub extract_syspref_from_line { |
| 51 |
my ( $self, $line ) = @_; |
| 52 |
|
| 53 |
if ( |
| 54 |
$line =~ /^INSERT INTO / # first line |
| 55 |
|| $line =~ /^;$/ # last line |
| 56 |
|| $line =~ /^--/ # Comment line |
| 57 |
) |
| 58 |
{ |
| 59 |
return; |
| 60 |
} |
| 61 |
|
| 62 |
if ( |
| 63 |
$line =~ m/ |
| 64 |
'(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s* |
| 65 |
'(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s* |
| 66 |
(?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* |
| 67 |
(?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* |
| 68 |
(?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)') |
| 69 |
/xms |
| 70 |
) |
| 71 |
{ |
| 72 |
my $variable = $+{variable}; |
| 73 |
my $value = $+{value}; |
| 74 |
my $options = $+{options_content}; |
| 75 |
my $explanation = $+{explanation_content}; |
| 76 |
my $type = $+{type_content}; |
| 77 |
|
| 78 |
if ($options) { |
| 79 |
$options =~ s/\\'/'/g; |
| 80 |
$options =~ s/\\\\/\\/g; |
| 81 |
} |
| 82 |
if ($explanation) { |
| 83 |
$explanation =~ s/\\'/'/g; |
| 84 |
$explanation =~ s/\\n/\n/g; |
| 85 |
} |
| 86 |
|
| 87 |
return { |
| 88 |
variable => $variable, |
| 89 |
value => $value, |
| 90 |
options => $options, |
| 91 |
explanation => $explanation, |
| 92 |
type => $type, |
| 93 |
}; |
| 94 |
} |
| 95 |
return {}; |
| 96 |
} |
| 97 |
|
| 40 |
=head2 get_sysprefs_from_file |
98 |
=head2 get_sysprefs_from_file |
| 41 |
|
99 |
|
| 42 |
my @sysprefs = $syspref_handler->get_sysprefs_from_file(); |
100 |
my @sysprefs = $syspref_handler->get_sysprefs_from_file(); |
|
Lines 51-97
sub get_sysprefs_from_file {
Link Here
|
| 51 |
my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; |
109 |
my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; |
| 52 |
for my $line (@lines) { |
110 |
for my $line (@lines) { |
| 53 |
chomp $line; |
111 |
chomp $line; |
| 54 |
next if $line =~ /^INSERT INTO /; # first line |
112 |
|
| 55 |
next if $line =~ /^;$/; # last line |
113 |
# FIXME Explode if already exists? |
| 56 |
next if $line =~ /^--/; # Comment line |
114 |
my $syspref = $self->extract_syspref_from_line($line); |
| 57 |
if ( |
115 |
if ( $syspref && exists $syspref->{variable} ) { |
| 58 |
$line =~ m/ |
|
|
| 59 |
'(?<variable>[^'\\]*(?:\\.[^'\\]*)*)',\s* |
| 60 |
'(?<value>[^'\\]*(?:\\.[^'\\]*)*)',\s* |
| 61 |
(?<options>NULL|'(?<options_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* |
| 62 |
(?<explanation>NULL|'(?<explanation_content>[^'\\]*(?:\\.[^'\\]*)*)'),\s* |
| 63 |
(?<type>NULL|'(?<type_content>[^'\\]*(?:\\.[^'\\]*)*)') |
| 64 |
/xms |
| 65 |
) |
| 66 |
{ |
| 67 |
my $variable = $+{variable}; |
| 68 |
my $value = $+{value}; |
| 69 |
my $options = $+{options_content}; |
| 70 |
my $explanation = $+{explanation_content}; |
| 71 |
my $type = $+{type_content}; |
| 72 |
|
| 73 |
if ($options) { |
| 74 |
$options =~ s/\\'/'/g; |
| 75 |
$options =~ s/\\\\/\\/g; |
| 76 |
} |
| 77 |
if ($explanation) { |
| 78 |
$explanation =~ s/\\'/'/g; |
| 79 |
$explanation =~ s/\\n/\n/g; |
| 80 |
} |
| 81 |
|
116 |
|
| 82 |
# FIXME Explode if already exists? |
117 |
# FIXME Explode if already exists? |
| 83 |
push @sysprefs, { |
118 |
push @sysprefs, $syspref; |
| 84 |
variable => $variable, |
119 |
} elsif ( defined $syspref ) { |
| 85 |
value => $value, |
|
|
| 86 |
options => $options, |
| 87 |
explanation => $explanation, |
| 88 |
type => $type, |
| 89 |
}; |
| 90 |
} else { |
| 91 |
die "$line does not match"; |
120 |
die "$line does not match"; |
| 92 |
} |
121 |
} |
| 93 |
} |
122 |
} |
| 94 |
return @sysprefs; |
123 |
return @sysprefs; |
| 95 |
} |
124 |
} |
| 96 |
|
125 |
|
|
|
126 |
=head2 add_new_pref |
| 127 |
|
| 128 |
$syspref_handler->add_new_pref({variable => $variable, value => $value, options => $options, explanation => $explanation, type => $type}); |
| 129 |
|
| 130 |
Add new syspref to the sysprefs.sql file |
| 131 |
|
| 132 |
=cut |
| 133 |
|
| 134 |
sub add_new_pref { |
| 135 |
my ( $self, $new_syspref ) = @_; |
| 136 |
my @lines = read_file( $self->{filepath} ) or die "Can't open $self->{filepath}: $!"; |
| 137 |
my @sysprefs; |
| 138 |
for my $line (@lines) { |
| 139 |
chomp $line; |
| 140 |
|
| 141 |
# FIXME Explode if already exists? |
| 142 |
my $syspref = $self->extract_syspref_from_line($line); |
| 143 |
push @sysprefs, { variable => $syspref ? $syspref->{variable} : undef, line => $line }; |
| 144 |
} |
| 145 |
|
| 146 |
push @sysprefs, |
| 147 |
{ |
| 148 |
variable => $new_syspref->{variable}, |
| 149 |
line => sprintf( |
| 150 |
"('%s', %s, %s, '%s', '%s'),", $new_syspref->{variable}, |
| 151 |
( defined $new_syspref->{value} ? "'$new_syspref->{value}'" : 'NULL' ), |
| 152 |
( defined $new_syspref->{options} ? "'$new_syspref->{options}'" : 'NULL' ), $new_syspref->{explanation}, |
| 153 |
$new_syspref->{type} |
| 154 |
) |
| 155 |
}; |
| 156 |
@sysprefs = sort { |
| 157 |
defined $a->{variable} |
| 158 |
&& defined $b->{variable} |
| 159 |
&& ( lc( $a->{variable} ) =~ s/_/ZZZ/gr ) |
| 160 |
cmp( |
| 161 |
lc( $b->{variable} ) =~ |
| 162 |
s/_/ZZZ/gr ) # mysql sorts underscore last, if you modify this qa-test-tools will need adjustments |
| 163 |
} @sysprefs; |
| 164 |
write_file( $self->{filepath}, join( "\n", map { $_->{line} } @sysprefs ) ); |
| 165 |
} |
| 166 |
|
| 97 |
1; |
167 |
1; |