← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:10 2021

Filename/usr/local/libexec/sympa/Sympa/List/Config.pm
StatementsExecuted 0 statements in 0s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
0000s0sSympa::List::Config::::BEGIN@191Sympa::List::Config::BEGIN@191
0000s0sSympa::List::Config::::BEGIN@26Sympa::List::Config::BEGIN@26
0000s0sSympa::List::Config::::BEGIN@27Sympa::List::Config::BEGIN@27
0000s0sSympa::List::Config::::BEGIN@29Sympa::List::Config::BEGIN@29
0000s0sSympa::List::Config::::BEGIN@30Sympa::List::Config::BEGIN@30
0000s0sSympa::List::Config::::BEGIN@31Sympa::List::Config::BEGIN@31
0000s0sSympa::List::Config::::BEGIN@33Sympa::List::Config::BEGIN@33
0000s0sSympa::List::Config::::__ANON__Sympa::List::Config::__ANON__ (xsub)
0000s0sSympa::List::Config::::__ANON__[:199]Sympa::List::Config::__ANON__[:199]
0000s0sSympa::List::Config::::_get_schema_apply_privilegeSympa::List::Config::_get_schema_apply_privilege
0000s0sSympa::List::Config::::_init_schema_itemSympa::List::Config::_init_schema_item
0000s0sSympa::List::Config::::_schemaSympa::List::Config::_schema
0000s0sSympa::List::Config::::commitSympa::List::Config::commit
0000s0sSympa::List::Config::::get_schemaSympa::List::Config::get_schema
0000s0sSympa::List::Config::::newSympa::List::Config::new
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments
Time
on line
Calls Time
in subs
Code
1# -*- indent-tabs-mode: nil; -*-
2# vim:ft=perl:et:sw=4
3# $Id$
4
5# Sympa - SYsteme de Multi-Postage Automatique
6#
7# Copyright 2017, 2018 The Sympa Community. See the AUTHORS.md file at the
8# top-level directory of this distribution and at
9# <https://github.com/sympa-community/sympa.git>.
10#
11# This program is free software; you can redistribute it and/or modify
12# it under the terms of the GNU General Public License as published by
13# the Free Software Foundation; either version 2 of the License, or
14# (at your option) any later version.
15#
16# This program is distributed in the hope that it will be useful,
17# but WITHOUT ANY WARRANTY; without even the implied warranty of
18# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19# GNU General Public License for more details.
20#
21# You should have received a copy of the GNU General Public License
22# along with this program. If not, see <http://www.gnu.org/licenses/>.
23
24package Sympa::List::Config;
25
26use strict;
27use warnings;
28
29use Conf;
30use Sympa::Log;
31use Sympa::Robot;
32
33use base qw(Sympa::Config);
34
35my $log = Sympa::Log->instance;
36
37sub new {
38 my $class = shift;
39 my $context = shift;
40 my %options = @_;
41
42 die 'bug in logic. Ask developer' unless ref $context eq 'Sympa::List';
43 $class->SUPER::new($context, %options);
44}
45
46sub _schema {
47 my $self = shift;
48
49 my $list = $self->{context};
50 return Sympa::Robot::list_params($list->{'domain'});
51}
52
53sub _init_schema_item {
54 my $self = shift;
55 my $pitem = shift;
56 my $pnames = shift;
57 my $subres = shift;
58 my %options = @_;
59
60 if (ref $pitem->{format} ne 'HASH' and exists $pitem->{default}) {
61 my $list = $self->{context};
62 my $default = $pitem->{default};
63
64 if (ref $default eq 'HASH' and exists $default->{conf}) {
65 $pitem->{default} =
66 Conf::get_robot_conf($list->{'domain'}, $default->{conf});
67 }
68 }
69
70 $self->SUPER::_init_schema_item($pitem, $pnames, $subres, %options);
71
72 return undef if $options{no_family};
73 my $family = $self->{context}->get_family;
74 return undef unless ref $family eq 'Sympa::Family';
75
76 if (ref $pitem->{format} eq 'HASH') {
77 if ($subres and grep {$_} values %$subres) {
78 return 'constrained';
79 }
80 } else {
81 my $constraint = $family->get_param_constraint(join '.', @$pnames);
82 my @constr;
83 unless (defined $constraint) { # Error
84 return undef;
85 } elsif (ref $constraint eq 'ARRAY') { # Multiple choices
86 @constr = @$constraint;
87 } elsif ($constraint ne '0') { # Fixed value
88 @constr = ($constraint);
89 } else { # No control
90 return undef;
91 }
92
93 if (ref $pitem->{format} eq 'ARRAY') {
94 @constr = grep {
95 my $k = $_;
96 grep { $k eq $_ } @constr
97 } @{$pitem->{format}};
98 } else {
99 my $re = $pitem->{format};
100 @constr = grep {/^($re)$/} @constr;
101 }
102
103 if (@constr) {
104 if (ref $pitem->{format} eq 'ARRAY') {
105 $pitem->{format} = [@constr];
106 } else {
107 $pitem->{format} = join '|', map { quotemeta $_ } @constr;
108 }
109
110 if ($pitem->{occurrence} eq '0-n') {
111 $pitem->{occurrence} = '1-n';
112 } elsif ($pitem->{occurrence} eq '0-1') {
113 $pitem->{occurrence} = '1';
114 }
115
116 if (1 == scalar @constr) {
117 if ($pitem->{occurrence} =~ /n$/) {
118 $pitem->{default} = [@constr];
119 } elsif ($pitem->{scenario} or $pitem->{task}) {
120 $pitem->{default} = {name => $constr[0]};
121 } else {
122 $pitem->{default} = $constr[0];
123 }
124 # Choose more restrictive privilege.
125 # See also _get_schema_apply_privilege().
126 $pitem->{privilege} = 'read'
127 if not $pitem->{privilege}
128 or 'read' lt $pitem->{privilege};
129 } elsif (exists $pitem->{default} and defined $pitem->{default}) {
130 delete $pitem->{default}
131 unless grep { $pitem->{default} eq $_ } @constr;
132 }
133 return 'constrained';
134 }
135 }
136
137 return undef;
138}
139
140sub get_schema {
141 my $self = shift;
142 my $user = shift;
143
144 my $pinfo = $self->SUPER::get_schema;
145 if ($user) {
146 foreach my $pname (CORE::keys %{$pinfo || {}}) {
147 $self->_get_schema_apply_privilege($pinfo->{$pname}, [$pname],
148 $user, undef);
149 }
150 }
151 $pinfo;
152}
153
154# Apply privilege on each parameter.
155sub _get_schema_apply_privilege {
156 my $self = shift;
157 my $pitem = shift;
158 my $pnames = shift;
159 my $user = shift;
160 my $priv_p = shift;
161
162 my $list = $self->{context};
163
164 # Choose most restrictive privilege.
165 # - Trick: "hidden", "read" and "write" precede others in reverse
166 # dictionary order.
167 # - Internal parameters are not editable anyway.
168 my $priv = $list->may_edit(join('.', @{$pnames || []}), $user);
169 $priv = 'read'
170 if $pitem->{internal}
171 and (not $priv or 'read' lt $priv);
172 $priv = $priv_p
173 if not $priv
174 or ($priv_p and $priv_p lt $priv);
175 $pitem->{privilege} = $priv
176 if not $pitem->{privilege}
177 or ($priv and $priv lt $pitem->{privilege});
178 $pitem->{privilege} ||= 'hidden'; # Implicit default
179
180 if (ref $pitem->{format} eq 'HASH') {
181 foreach my $key (CORE::keys %{$pitem->{format} || {}}) {
182 $self->_get_schema_apply_privilege(
183 $pitem->{format}->{$key},
184 [@$pnames, $key],
185 $user, $pitem->{privilege}
186 );
187 }
188 }
189}
190
191use constant _local_validations => {
192 # Checking no topic named "other".
193 reserved_msg_topic_name => sub {
194 my $self = shift;
195 my $new = shift;
196
197 return 'topic_other'
198 if lc $new eq 'other';
199 },
200};
201
202sub commit {
203 my $self = shift;
204 my $errors = shift || [];
205
206 my $list = $self->{context};
207 my $changes = $self->{_changes};
208 my $pinfo = $self->{_pinfo};
209
210 # Updating config_changes for changed parameters.
211 # FIXME:Check subitems also.
212 if (ref($list->get_family) eq 'Sympa::Family') {
213 unless (
214 $list->update_config_changes(
215 'param', [CORE::keys %{$changes || {}}]
216 )
217 ) {
218 push @$errors, ['intern', 'update_config_changes'];
219 return undef;
220 }
221 }
222
223 $self->SUPER::commit($errors);
224}
225
2261;
227__END__