]>
Commit | Line | Data |
---|---|---|
84fb5b46 MKG |
1 | # BEGIN BPS TAGGED BLOCK {{{ |
2 | # | |
3 | # COPYRIGHT: | |
4 | # | |
403d7b0b | 5 | # This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC |
84fb5b46 MKG |
6 | # <sales@bestpractical.com> |
7 | # | |
8 | # (Except where explicitly superseded by other copyright notices) | |
9 | # | |
10 | # | |
11 | # LICENSE: | |
12 | # | |
13 | # This work is made available to you under the terms of Version 2 of | |
14 | # the GNU General Public License. A copy of that license should have | |
15 | # been provided with this software, but in any event can be snarfed | |
16 | # from www.gnu.org. | |
17 | # | |
18 | # This work is distributed in the hope that it will be useful, but | |
19 | # WITHOUT ANY WARRANTY; without even the implied warranty of | |
20 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
21 | # General Public License for more details. | |
22 | # | |
23 | # You should have received a copy of the GNU General Public License | |
24 | # along with this program; if not, write to the Free Software | |
25 | # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA | |
26 | # 02110-1301 or visit their web page on the internet at | |
27 | # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html. | |
28 | # | |
29 | # | |
30 | # CONTRIBUTION SUBMISSION POLICY: | |
31 | # | |
32 | # (The following paragraph is not intended to limit the rights granted | |
33 | # to you to modify and distribute this software under the terms of | |
34 | # the GNU General Public License and is only of importance to you if | |
35 | # you choose to contribute your changes and enhancements to the | |
36 | # community by submitting them to Best Practical Solutions, LLC.) | |
37 | # | |
38 | # By intentionally submitting any modifications, corrections or | |
39 | # derivatives to this work, or any other work intended for use with | |
40 | # Request Tracker, to Best Practical Solutions, LLC, you confirm that | |
41 | # you are the copyright holder for those contributions and you grant | |
42 | # Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable, | |
43 | # royalty-free, perpetual, license to use, copy, create derivative | |
44 | # works based on those contributions, and sublicense and distribute | |
45 | # those contributions and any derivatives thereof. | |
46 | # | |
47 | # END BPS TAGGED BLOCK }}} | |
48 | ||
49 | package RT::Config; | |
50 | ||
51 | use strict; | |
52 | use warnings; | |
53 | ||
54 | ||
55 | use File::Spec (); | |
56 | ||
57 | =head1 NAME | |
58 | ||
59 | RT::Config - RT's config | |
60 | ||
61 | =head1 SYNOPSYS | |
62 | ||
63 | # get config object | |
64 | use RT::Config; | |
65 | my $config = RT::Config->new; | |
66 | $config->LoadConfigs; | |
67 | ||
68 | # get or set option | |
69 | my $rt_web_path = $config->Get('WebPath'); | |
70 | $config->Set(EmailOutputEncoding => 'latin1'); | |
71 | ||
72 | # get config object from RT package | |
73 | use RT; | |
74 | RT->LoadConfig; | |
75 | my $config = RT->Config; | |
76 | ||
77 | =head1 DESCRIPTION | |
78 | ||
79 | C<RT::Config> class provide access to RT's and RT extensions' config files. | |
80 | ||
81 | RT uses two files for site configuring: | |
82 | ||
83 | First file is F<RT_Config.pm> - core config file. This file is shipped | |
84 | with RT distribution and contains default values for all available options. | |
85 | B<You should never edit this file.> | |
86 | ||
87 | Second file is F<RT_SiteConfig.pm> - site config file. You can use it | |
88 | to customize your RT instance. In this file you can override any option | |
89 | listed in core config file. | |
90 | ||
91 | RT extensions could also provide thier config files. Extensions should | |
92 | use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for | |
93 | config files, where <NAME> is extension name. | |
94 | ||
95 | B<NOTE>: All options from RT's config and extensions' configs are saved | |
96 | in one place and thus extension could override RT's options, but it is not | |
97 | recommended. | |
98 | ||
99 | =cut | |
100 | ||
101 | =head2 %META | |
102 | ||
103 | Hash of Config options that may be user overridable | |
104 | or may require more logic than should live in RT_*Config.pm | |
105 | ||
106 | Keyed by config name, there are several properties that | |
107 | can be set for each config optin: | |
108 | ||
109 | Section - What header this option should be grouped | |
110 | under on the user Settings page | |
111 | Overridable - Can users change this option | |
112 | SortOrder - Within a Section, how should the options be sorted | |
113 | for display to the user | |
114 | Widget - Mason component path to widget that should be used | |
115 | to display this config option | |
116 | WidgetArguments - An argument hash passed to the WIdget | |
117 | Description - Friendly description to show the user | |
118 | Values - Arrayref of options (for select Widget) | |
119 | ValuesLabel - Hashref, key is the Value from the Values | |
120 | list, value is a user friendly description | |
121 | of the value | |
122 | Callback - subref that receives no arguments. It returns | |
123 | a hashref of items that are added to the rest | |
124 | of the WidgetArguments | |
125 | PostLoadCheck - subref passed the RT::Config object and the current | |
126 | setting of the config option. Can make further checks | |
127 | (such as seeing if a library is installed) and then change | |
128 | the setting of this or other options in the Config using | |
129 | the RT::Config option. | |
130 | Obfuscate - subref passed the RT::Config object, current setting of the config option | |
131 | and a user object, can return obfuscated value. it's called in | |
132 | RT->Config->GetObfuscated() | |
133 | ||
134 | =cut | |
135 | ||
136 | our %META = ( | |
137 | # General user overridable options | |
138 | DefaultQueue => { | |
139 | Section => 'General', | |
140 | Overridable => 1, | |
141 | SortOrder => 1, | |
142 | Widget => '/Widgets/Form/Select', | |
143 | WidgetArguments => { | |
144 | Description => 'Default queue', #loc | |
145 | Callback => sub { | |
146 | my $ret = { Values => [], ValuesLabel => {}}; | |
147 | my $q = RT::Queues->new($HTML::Mason::Commands::session{'CurrentUser'}); | |
148 | $q->UnLimit; | |
149 | while (my $queue = $q->Next) { | |
150 | next unless $queue->CurrentUserHasRight("CreateTicket"); | |
151 | push @{$ret->{Values}}, $queue->Id; | |
152 | $ret->{ValuesLabel}{$queue->Id} = $queue->Name; | |
153 | } | |
154 | return $ret; | |
155 | }, | |
156 | } | |
157 | }, | |
158 | RememberDefaultQueue => { | |
159 | Section => 'General', | |
160 | Overridable => 1, | |
161 | SortOrder => 2, | |
162 | Widget => '/Widgets/Form/Boolean', | |
163 | WidgetArguments => { | |
164 | Description => 'Remember default queue' # loc | |
165 | } | |
166 | }, | |
167 | UsernameFormat => { | |
168 | Section => 'General', | |
169 | Overridable => 1, | |
170 | SortOrder => 3, | |
171 | Widget => '/Widgets/Form/Select', | |
172 | WidgetArguments => { | |
173 | Description => 'Username format', # loc | |
174 | Values => [qw(concise verbose)], | |
175 | ValuesLabel => { | |
176 | concise => 'Short usernames', # loc | |
177 | verbose => 'Name and email address', # loc | |
178 | }, | |
179 | }, | |
180 | }, | |
181 | AutocompleteOwners => { | |
182 | Section => 'General', | |
183 | Overridable => 1, | |
184 | SortOrder => 3.1, | |
185 | Widget => '/Widgets/Form/Boolean', | |
186 | WidgetArguments => { | |
187 | Description => 'Use autocomplete to find owners?', # loc | |
188 | Hints => 'Replaces the owner dropdowns with textboxes' #loc | |
189 | } | |
190 | }, | |
191 | WebDefaultStylesheet => { | |
192 | Section => 'General', #loc | |
193 | Overridable => 1, | |
194 | SortOrder => 4, | |
195 | Widget => '/Widgets/Form/Select', | |
196 | WidgetArguments => { | |
197 | Description => 'Theme', #loc | |
198 | # XXX: we need support for 'get values callback' | |
199 | Values => [qw(web2 aileron ballard)], | |
200 | }, | |
201 | PostLoadCheck => sub { | |
202 | my $self = shift; | |
203 | my $value = $self->Get('WebDefaultStylesheet'); | |
204 | ||
205 | my @comp_roots = RT::Interface::Web->ComponentRoots; | |
206 | for my $comp_root (@comp_roots) { | |
207 | return if -d $comp_root.'/NoAuth/css/'.$value; | |
208 | } | |
209 | ||
210 | $RT::Logger->warning( | |
211 | "The default stylesheet ($value) does not exist in this instance of RT. " | |
212 | . "Defaulting to aileron." | |
213 | ); | |
214 | ||
215 | $self->Set('WebDefaultStylesheet', 'aileron'); | |
216 | }, | |
217 | }, | |
218 | UseSideBySideLayout => { | |
219 | Section => 'Ticket composition', | |
220 | Overridable => 1, | |
221 | SortOrder => 5, | |
222 | Widget => '/Widgets/Form/Boolean', | |
223 | WidgetArguments => { | |
224 | Description => 'Use a two column layout for create and update forms?' # loc | |
225 | } | |
226 | }, | |
227 | MessageBoxRichText => { | |
228 | Section => 'Ticket composition', | |
229 | Overridable => 1, | |
230 | SortOrder => 5.1, | |
231 | Widget => '/Widgets/Form/Boolean', | |
232 | WidgetArguments => { | |
233 | Description => 'WYSIWYG message composer' # loc | |
234 | } | |
235 | }, | |
236 | MessageBoxRichTextHeight => { | |
237 | Section => 'Ticket composition', | |
238 | Overridable => 1, | |
239 | SortOrder => 6, | |
240 | Widget => '/Widgets/Form/Integer', | |
241 | WidgetArguments => { | |
242 | Description => 'WYSIWYG composer height', # loc | |
243 | } | |
244 | }, | |
245 | MessageBoxWidth => { | |
246 | Section => 'Ticket composition', | |
247 | Overridable => 1, | |
248 | SortOrder => 7, | |
249 | Widget => '/Widgets/Form/Integer', | |
250 | WidgetArguments => { | |
251 | Description => 'Message box width', #loc | |
252 | }, | |
253 | }, | |
254 | MessageBoxHeight => { | |
255 | Section => 'Ticket composition', | |
256 | Overridable => 1, | |
257 | SortOrder => 8, | |
258 | Widget => '/Widgets/Form/Integer', | |
259 | WidgetArguments => { | |
260 | Description => 'Message box height', #loc | |
261 | }, | |
262 | }, | |
263 | MessageBoxWrap => { | |
264 | Section => 'Ticket composition', #loc | |
265 | Overridable => 1, | |
266 | SortOrder => 8.1, | |
267 | Widget => '/Widgets/Form/Select', | |
268 | WidgetArguments => { | |
269 | Description => 'Message box wrapping', #loc | |
270 | Values => [qw(SOFT HARD)], | |
271 | Hints => "When the WYSIWYG editor is not enabled, this setting determines whether automatic line wraps in the ticket message box are sent to RT or not.", # loc | |
272 | }, | |
273 | }, | |
274 | DefaultTimeUnitsToHours => { | |
275 | Section => 'Ticket composition', #loc | |
276 | Overridable => 1, | |
277 | SortOrder => 9, | |
278 | Widget => '/Widgets/Form/Boolean', | |
279 | WidgetArguments => { | |
280 | Description => 'Enter time in hours by default', #loc | |
281 | Hints => 'Only for entry, not display', #loc | |
282 | }, | |
283 | }, | |
284 | SearchResultsRefreshInterval => { | |
285 | Section => 'General', #loc | |
286 | Overridable => 1, | |
287 | SortOrder => 9, | |
288 | Widget => '/Widgets/Form/Select', | |
289 | WidgetArguments => { | |
290 | Description => 'Search results refresh interval', #loc | |
291 | Values => [qw(0 120 300 600 1200 3600 7200)], | |
292 | ValuesLabel => { | |
293 | 0 => "Don't refresh search results.", #loc | |
294 | 120 => "Refresh search results every 2 minutes.", #loc | |
295 | 300 => "Refresh search results every 5 minutes.", #loc | |
296 | 600 => "Refresh search results every 10 minutes.", #loc | |
297 | 1200 => "Refresh search results every 20 minutes.", #loc | |
298 | 3600 => "Refresh search results every 60 minutes.", #loc | |
299 | 7200 => "Refresh search results every 120 minutes.", #loc | |
300 | }, | |
301 | }, | |
302 | }, | |
303 | ||
304 | # User overridable options for RT at a glance | |
84fb5b46 MKG |
305 | HomePageRefreshInterval => { |
306 | Section => 'RT at a glance', #loc | |
307 | Overridable => 1, | |
308 | SortOrder => 2, | |
309 | Widget => '/Widgets/Form/Select', | |
310 | WidgetArguments => { | |
311 | Description => 'Home page refresh interval', #loc | |
312 | Values => [qw(0 120 300 600 1200 3600 7200)], | |
313 | ValuesLabel => { | |
314 | 0 => "Don't refresh home page.", #loc | |
315 | 120 => "Refresh home page every 2 minutes.", #loc | |
316 | 300 => "Refresh home page every 5 minutes.", #loc | |
317 | 600 => "Refresh home page every 10 minutes.", #loc | |
318 | 1200 => "Refresh home page every 20 minutes.", #loc | |
319 | 3600 => "Refresh home page every 60 minutes.", #loc | |
320 | 7200 => "Refresh home page every 120 minutes.", #loc | |
321 | }, | |
322 | }, | |
323 | }, | |
324 | ||
325 | # User overridable options for Ticket displays | |
326 | MaxInlineBody => { | |
327 | Section => 'Ticket display', #loc | |
328 | Overridable => 1, | |
329 | SortOrder => 1, | |
330 | Widget => '/Widgets/Form/Integer', | |
331 | WidgetArguments => { | |
332 | Description => 'Maximum inline message length', #loc | |
333 | Hints => | |
334 | "Length in characters; Use '0' to show all messages inline, regardless of length" #loc | |
335 | }, | |
336 | }, | |
337 | OldestTransactionsFirst => { | |
338 | Section => 'Ticket display', | |
339 | Overridable => 1, | |
340 | SortOrder => 2, | |
341 | Widget => '/Widgets/Form/Boolean', | |
342 | WidgetArguments => { | |
343 | Description => 'Show oldest history first', #loc | |
344 | }, | |
345 | }, | |
346 | DeferTransactionLoading => { | |
347 | Section => 'Ticket display', | |
348 | Overridable => 1, | |
349 | SortOrder => 3, | |
350 | Widget => '/Widgets/Form/Boolean', | |
351 | WidgetArguments => { | |
352 | Description => 'Hide ticket history by default', #loc | |
353 | }, | |
354 | }, | |
355 | ShowUnreadMessageNotifications => { | |
356 | Section => 'Ticket display', | |
357 | Overridable => 1, | |
358 | SortOrder => 4, | |
359 | Widget => '/Widgets/Form/Boolean', | |
360 | WidgetArguments => { | |
361 | Description => 'Notify me of unread messages', #loc | |
362 | }, | |
363 | ||
364 | }, | |
365 | PlainTextPre => { | |
366 | Section => 'Ticket display', | |
367 | Overridable => 1, | |
368 | SortOrder => 5, | |
369 | Widget => '/Widgets/Form/Boolean', | |
370 | WidgetArguments => { | |
371 | Description => 'add <pre> tag around plain text attachments', #loc | |
372 | Hints => "Use this to protect the format of plain text" #loc | |
373 | }, | |
374 | }, | |
375 | PlainTextMono => { | |
376 | Section => 'Ticket display', | |
377 | Overridable => 1, | |
378 | SortOrder => 5, | |
379 | Widget => '/Widgets/Form/Boolean', | |
380 | WidgetArguments => { | |
381 | Description => 'display wrapped and formatted plain text attachments', #loc | |
382 | Hints => 'Use css rules to display text monospaced and with formatting preserved, but wrap as needed. This does not work well with IE6 and you should use the previous option', #loc | |
383 | }, | |
384 | }, | |
385 | MoreAboutRequestorTicketList => { | |
386 | Section => 'Ticket display', #loc | |
387 | Overridable => 1, | |
388 | SortOrder => 6, | |
389 | Widget => '/Widgets/Form/Select', | |
390 | WidgetArguments => { | |
391 | Description => q|What tickets to display in the 'More about requestor' box|, #loc | |
392 | Values => [qw(Active Inactive All None)], | |
393 | ValuesLabel => { | |
dab09ea8 MKG |
394 | Active => "Show the Requestor's 10 highest priority active tickets", #loc |
395 | Inactive => "Show the Requestor's 10 highest priority inactive tickets", #loc | |
84fb5b46 MKG |
396 | All => "Show the Requestor's 10 highest priority tickets", #loc |
397 | None => "Show no tickets for the Requestor", #loc | |
398 | }, | |
399 | }, | |
400 | }, | |
401 | SimplifiedRecipients => { | |
402 | Section => 'Ticket display', #loc | |
403 | Overridable => 1, | |
404 | SortOrder => 7, | |
405 | Widget => '/Widgets/Form/Boolean', | |
406 | WidgetArguments => { | |
407 | Description => q|Show simplified recipient list on ticket update|, #loc | |
408 | }, | |
409 | }, | |
410 | DisplayTicketAfterQuickCreate => { | |
411 | Section => 'Ticket display', | |
412 | Overridable => 1, | |
413 | SortOrder => 8, | |
414 | Widget => '/Widgets/Form/Boolean', | |
415 | WidgetArguments => { | |
416 | Description => q{Display ticket after "Quick Create"}, #loc | |
417 | }, | |
418 | }, | |
419 | ||
420 | # User overridable locale options | |
421 | DateTimeFormat => { | |
422 | Section => 'Locale', #loc | |
423 | Overridable => 1, | |
424 | Widget => '/Widgets/Form/Select', | |
425 | WidgetArguments => { | |
426 | Description => 'Date format', #loc | |
427 | Callback => sub { my $ret = { Values => [], ValuesLabel => {}}; | |
428 | my $date = RT::Date->new($HTML::Mason::Commands::session{'CurrentUser'}); | |
403d7b0b | 429 | $date->SetToNow; |
84fb5b46 MKG |
430 | foreach my $value ($date->Formatters) { |
431 | push @{$ret->{Values}}, $value; | |
403d7b0b MKG |
432 | $ret->{ValuesLabel}{$value} = $date->Get( |
433 | Format => $value, | |
434 | Timezone => 'user', | |
435 | ); | |
84fb5b46 MKG |
436 | } |
437 | return $ret; | |
438 | }, | |
439 | }, | |
440 | }, | |
441 | ||
442 | RTAddressRegexp => { | |
443 | Type => 'SCALAR', | |
444 | PostLoadCheck => sub { | |
445 | my $self = shift; | |
446 | my $value = $self->Get('RTAddressRegexp'); | |
447 | if (not $value) { | |
448 | $RT::Logger->debug( | |
449 | 'The RTAddressRegexp option is not set in the config.' | |
450 | .' Not setting this option results in additional SQL queries to' | |
451 | .' check whether each address belongs to RT or not.' | |
452 | .' It is especially important to set this option if RT recieves' | |
453 | .' emails on addresses that are not in the database or config.' | |
454 | ); | |
455 | } elsif (ref $value and ref $value eq "Regexp") { | |
456 | # Ensure that the regex is case-insensitive; while the | |
457 | # local part of email addresses is _technically_ | |
458 | # case-sensitive, most MTAs don't treat it as such. | |
459 | $RT::Logger->warning( | |
460 | 'RTAddressRegexp is set to a case-sensitive regular expression.' | |
461 | .' This may lead to mail loops with MTAs which treat the' | |
462 | .' local part as case-insensitive -- which is most of them.' | |
463 | ) if "$value" =~ /^\(\?[a-z]*-([a-z]*):/ and "$1" =~ /i/; | |
464 | } | |
465 | }, | |
466 | }, | |
467 | # User overridable mail options | |
468 | EmailFrequency => { | |
469 | Section => 'Mail', #loc | |
470 | Overridable => 1, | |
471 | Default => 'Individual messages', | |
472 | Widget => '/Widgets/Form/Select', | |
473 | WidgetArguments => { | |
474 | Description => 'Email delivery', #loc | |
475 | Values => [ | |
476 | 'Individual messages', #loc | |
477 | 'Daily digest', #loc | |
478 | 'Weekly digest', #loc | |
479 | 'Suspended' #loc | |
480 | ] | |
481 | } | |
482 | }, | |
483 | NotifyActor => { | |
484 | Section => 'Mail', #loc | |
485 | Overridable => 1, | |
486 | SortOrder => 2, | |
487 | Widget => '/Widgets/Form/Boolean', | |
488 | WidgetArguments => { | |
489 | Description => 'Outgoing mail', #loc | |
490 | Hints => 'Should RT send you mail for ticket updates you make?', #loc | |
491 | } | |
492 | }, | |
493 | ||
494 | # this tends to break extensions that stash links in ticket update pages | |
495 | Organization => { | |
496 | Type => 'SCALAR', | |
497 | PostLoadCheck => sub { | |
498 | my ($self,$value) = @_; | |
499 | $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace. Please fix this.") | |
500 | if $value =~ /\s/;; | |
501 | }, | |
502 | }, | |
503 | ||
504 | # Internal config options | |
505 | FullTextSearch => { | |
506 | Type => 'HASH', | |
507 | PostLoadCheck => sub { | |
508 | my $self = shift; | |
509 | my $v = $self->Get('FullTextSearch'); | |
510 | return unless $v->{Enable} and $v->{Indexed}; | |
511 | my $dbtype = $self->Get('DatabaseType'); | |
512 | if ($dbtype eq 'Oracle') { | |
513 | if (not $v->{IndexName}) { | |
514 | $RT::Logger->error("No IndexName set for full-text index; disabling"); | |
515 | $v->{Enable} = $v->{Indexed} = 0; | |
516 | } | |
517 | } elsif ($dbtype eq 'Pg') { | |
518 | my $bad = 0; | |
519 | if (not $v->{'Column'}) { | |
520 | $RT::Logger->error("No Column set for full-text index; disabling"); | |
521 | $v->{Enable} = $v->{Indexed} = 0; | |
522 | } elsif ($v->{'Column'} eq "Content" | |
523 | and (not $v->{'Table'} or $v->{'Table'} eq "Attachments")) { | |
524 | $RT::Logger->error("Column for full-text index is set to Content, not tsvector column; disabling"); | |
525 | $v->{Enable} = $v->{Indexed} = 0; | |
526 | } | |
527 | } elsif ($dbtype eq 'mysql') { | |
528 | if (not $v->{'Table'}) { | |
529 | $RT::Logger->error("No Table set for full-text index; disabling"); | |
530 | $v->{Enable} = $v->{Indexed} = 0; | |
531 | } elsif ($v->{'Table'} eq "Attachments") { | |
532 | $RT::Logger->error("Table for full-text index is set to Attachments, not SphinxSE table; disabling"); | |
533 | $v->{Enable} = $v->{Indexed} = 0; | |
534 | } elsif (not $v->{'MaxMatches'}) { | |
535 | $RT::Logger->warn("No MaxMatches set for full-text index; defaulting to 10000"); | |
536 | $v->{MaxMatches} = 10_000; | |
537 | } | |
538 | } else { | |
539 | $RT::Logger->error("Indexed full-text-search not supported for $dbtype"); | |
540 | $v->{Indexed} = 0; | |
541 | } | |
542 | }, | |
543 | }, | |
544 | DisableGraphViz => { | |
545 | Type => 'SCALAR', | |
546 | PostLoadCheck => sub { | |
547 | my $self = shift; | |
548 | my $value = shift; | |
549 | return if $value; | |
550 | return if $INC{'GraphViz.pm'}; | |
551 | local $@; | |
552 | return if eval {require GraphViz; 1}; | |
553 | $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@"); | |
554 | $self->Set( DisableGraphViz => 1 ); | |
555 | }, | |
556 | }, | |
557 | DisableGD => { | |
558 | Type => 'SCALAR', | |
559 | PostLoadCheck => sub { | |
560 | my $self = shift; | |
561 | my $value = shift; | |
562 | return if $value; | |
563 | return if $INC{'GD.pm'}; | |
564 | local $@; | |
565 | return if eval {require GD; 1}; | |
566 | $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@"); | |
567 | $self->Set( DisableGD => 1 ); | |
568 | }, | |
569 | }, | |
570 | MailPlugins => { Type => 'ARRAY' }, | |
571 | Plugins => { | |
572 | Type => 'ARRAY', | |
573 | PostLoadCheck => sub { | |
574 | my $self = shift; | |
575 | my $value = $self->Get('Plugins'); | |
576 | # XXX Remove in RT 4.2 | |
577 | return unless $value and grep {$_ eq "RT::FM"} @{$value}; | |
578 | warn 'RTFM has been integrated into core RT, and must be removed from your @Plugins'; | |
579 | }, | |
580 | }, | |
581 | GnuPG => { Type => 'HASH' }, | |
582 | GnuPGOptions => { Type => 'HASH', | |
583 | PostLoadCheck => sub { | |
584 | my $self = shift; | |
585 | my $gpg = $self->Get('GnuPG'); | |
586 | return unless $gpg->{'Enable'}; | |
587 | my $gpgopts = $self->Get('GnuPGOptions'); | |
588 | unless (-d $gpgopts->{homedir} && -r _ ) { # no homedir, no gpg | |
589 | $RT::Logger->debug( | |
590 | "RT's GnuPG libraries couldn't successfully read your". | |
591 | " configured GnuPG home directory (".$gpgopts->{homedir} | |
592 | ."). PGP support has been disabled"); | |
593 | $gpg->{'Enable'} = 0; | |
594 | return; | |
595 | } | |
596 | ||
597 | ||
598 | require RT::Crypt::GnuPG; | |
599 | unless (RT::Crypt::GnuPG->Probe()) { | |
600 | $RT::Logger->debug( | |
601 | "RT's GnuPG libraries couldn't successfully execute gpg.". | |
602 | " PGP support has been disabled"); | |
603 | $gpg->{'Enable'} = 0; | |
604 | } | |
605 | } | |
606 | }, | |
b5747ff2 | 607 | ReferrerWhitelist => { Type => 'ARRAY' }, |
84fb5b46 MKG |
608 | ResolveDefaultUpdateType => { |
609 | PostLoadCheck => sub { | |
610 | my $self = shift; | |
611 | my $value = shift; | |
612 | return unless $value; | |
613 | $RT::Logger->info('The ResolveDefaultUpdateType config option has been deprecated. '. | |
614 | 'You can change the site default in your %Lifecycles config.'); | |
615 | } | |
616 | }, | |
617 | WebPath => { | |
618 | PostLoadCheck => sub { | |
619 | my $self = shift; | |
620 | my $value = shift; | |
621 | ||
622 | # "In most cases, you should leave $WebPath set to '' (an empty value)." | |
623 | return unless $value; | |
624 | ||
625 | # try to catch someone who assumes that you shouldn't leave this empty | |
626 | if ($value eq '/') { | |
627 | $RT::Logger->error("For the WebPath config option, use the empty string instead of /"); | |
628 | return; | |
629 | } | |
630 | ||
631 | # $WebPath requires a leading / but no trailing /, or it can be blank. | |
632 | return if $value =~ m{^/.+[^/]$}; | |
633 | ||
634 | if ($value =~ m{/$}) { | |
635 | $RT::Logger->error("The WebPath config option requires no trailing slash"); | |
636 | } | |
637 | ||
638 | if ($value !~ m{^/}) { | |
639 | $RT::Logger->error("The WebPath config option requires a leading slash"); | |
640 | } | |
641 | }, | |
642 | }, | |
643 | WebDomain => { | |
644 | PostLoadCheck => sub { | |
645 | my $self = shift; | |
646 | my $value = shift; | |
647 | ||
648 | if (!$value) { | |
649 | $RT::Logger->error("You must set the WebDomain config option"); | |
650 | return; | |
651 | } | |
652 | ||
653 | if ($value =~ m{^(\w+://)}) { | |
654 | $RT::Logger->error("The WebDomain config option must not contain a scheme ($1)"); | |
655 | return; | |
656 | } | |
657 | ||
658 | if ($value =~ m{(/.*)}) { | |
659 | $RT::Logger->error("The WebDomain config option must not contain a path ($1)"); | |
660 | return; | |
661 | } | |
662 | ||
663 | if ($value =~ m{:(\d*)}) { | |
664 | $RT::Logger->error("The WebDomain config option must not contain a port ($1)"); | |
665 | return; | |
666 | } | |
667 | }, | |
668 | }, | |
669 | WebPort => { | |
670 | PostLoadCheck => sub { | |
671 | my $self = shift; | |
672 | my $value = shift; | |
673 | ||
674 | if (!$value) { | |
675 | $RT::Logger->error("You must set the WebPort config option"); | |
676 | return; | |
677 | } | |
678 | ||
679 | if ($value !~ m{^\d+$}) { | |
680 | $RT::Logger->error("The WebPort config option must be an integer"); | |
681 | } | |
682 | }, | |
683 | }, | |
684 | WebBaseURL => { | |
685 | PostLoadCheck => sub { | |
686 | my $self = shift; | |
687 | my $value = shift; | |
688 | ||
689 | if (!$value) { | |
690 | $RT::Logger->error("You must set the WebBaseURL config option"); | |
691 | return; | |
692 | } | |
693 | ||
694 | if ($value !~ m{^https?://}i) { | |
695 | $RT::Logger->error("The WebBaseURL config option must contain a scheme (http or https)"); | |
696 | } | |
697 | ||
698 | if ($value =~ m{/$}) { | |
699 | $RT::Logger->error("The WebBaseURL config option requires no trailing slash"); | |
700 | } | |
701 | ||
702 | if ($value =~ m{^https?://.+?(/[^/].*)}i) { | |
703 | $RT::Logger->error("The WebBaseURL config option must not contain a path ($1)"); | |
704 | } | |
705 | }, | |
706 | }, | |
707 | WebURL => { | |
708 | PostLoadCheck => sub { | |
709 | my $self = shift; | |
710 | my $value = shift; | |
711 | ||
712 | if (!$value) { | |
713 | $RT::Logger->error("You must set the WebURL config option"); | |
714 | return; | |
715 | } | |
716 | ||
717 | if ($value !~ m{^https?://}i) { | |
718 | $RT::Logger->error("The WebURL config option must contain a scheme (http or https)"); | |
719 | } | |
720 | ||
721 | if ($value !~ m{/$}) { | |
722 | $RT::Logger->error("The WebURL config option requires a trailing slash"); | |
723 | } | |
724 | }, | |
725 | }, | |
726 | EmailInputEncodings => { | |
727 | Type => 'ARRAY', | |
728 | PostLoadCheck => sub { | |
729 | my $self = shift; | |
730 | my $value = $self->Get('EmailInputEncodings'); | |
731 | return unless $value && @$value; | |
732 | ||
733 | my %seen; | |
734 | foreach my $encoding ( grep defined && length, splice @$value ) { | |
dab09ea8 | 735 | next if $seen{ $encoding }; |
84fb5b46 MKG |
736 | if ( $encoding eq '*' ) { |
737 | unshift @$value, '*'; | |
738 | next; | |
739 | } | |
740 | ||
741 | my $canonic = Encode::resolve_alias( $encoding ); | |
742 | unless ( $canonic ) { | |
743 | warn "Unknown encoding '$encoding' in \@EmailInputEncodings option"; | |
744 | } | |
745 | elsif ( $seen{ $canonic }++ ) { | |
746 | next; | |
747 | } | |
748 | else { | |
749 | push @$value, $canonic; | |
750 | } | |
751 | } | |
752 | }, | |
753 | }, | |
754 | ||
755 | ActiveStatus => { | |
756 | Type => 'ARRAY', | |
757 | PostLoadCheck => sub { | |
758 | my $self = shift; | |
759 | return unless shift; | |
760 | # XXX Remove in RT 4.2 | |
761 | warn <<EOT; | |
762 | The ActiveStatus configuration has been replaced by the new Lifecycles | |
763 | functionality. You should set the 'active' property of the 'default' | |
764 | lifecycle and add transition rules; see RT_Config.pm for documentation. | |
765 | EOT | |
766 | }, | |
767 | }, | |
768 | InactiveStatus => { | |
769 | Type => 'ARRAY', | |
770 | PostLoadCheck => sub { | |
771 | my $self = shift; | |
772 | return unless shift; | |
773 | # XXX Remove in RT 4.2 | |
774 | warn <<EOT; | |
775 | The InactiveStatus configuration has been replaced by the new Lifecycles | |
776 | functionality. You should set the 'inactive' property of the 'default' | |
777 | lifecycle and add transition rules; see RT_Config.pm for documentation. | |
778 | EOT | |
779 | }, | |
780 | }, | |
781 | ); | |
782 | my %OPTIONS = (); | |
783 | ||
784 | =head1 METHODS | |
785 | ||
786 | =head2 new | |
787 | ||
788 | Object constructor returns new object. Takes no arguments. | |
789 | ||
790 | =cut | |
791 | ||
792 | sub new { | |
793 | my $proto = shift; | |
794 | my $class = ref($proto) ? ref($proto) : $proto; | |
795 | my $self = bless {}, $class; | |
796 | $self->_Init(@_); | |
797 | return $self; | |
798 | } | |
799 | ||
800 | sub _Init { | |
801 | return; | |
802 | } | |
803 | ||
804 | =head2 InitConfig | |
805 | ||
806 | Do nothin right now. | |
807 | ||
808 | =cut | |
809 | ||
810 | sub InitConfig { | |
811 | my $self = shift; | |
812 | my %args = ( File => '', @_ ); | |
813 | $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/; | |
814 | return 1; | |
815 | } | |
816 | ||
817 | =head2 LoadConfigs | |
818 | ||
819 | Load all configs. First of all load RT's config then load | |
820 | extensions' config files in alphabetical order. | |
821 | Takes no arguments. | |
822 | ||
823 | =cut | |
824 | ||
825 | sub LoadConfigs { | |
826 | my $self = shift; | |
827 | ||
828 | $self->InitConfig( File => 'RT_Config.pm' ); | |
829 | $self->LoadConfig( File => 'RT_Config.pm' ); | |
830 | ||
831 | my @configs = $self->Configs; | |
832 | $self->InitConfig( File => $_ ) foreach @configs; | |
833 | $self->LoadConfig( File => $_ ) foreach @configs; | |
834 | return; | |
835 | } | |
836 | ||
837 | =head1 LoadConfig | |
838 | ||
839 | Takes param hash with C<File> field. | |
840 | First, the site configuration file is loaded, in order to establish | |
841 | overall site settings like hostname and name of RT instance. | |
842 | Then, the core configuration file is loaded to set fallback values | |
843 | for all settings; it bases some values on settings from the site | |
844 | configuration file. | |
845 | ||
846 | B<Note> that core config file don't change options if site config | |
847 | has set them so to add value to some option instead of | |
848 | overriding you have to copy original value from core config file. | |
849 | ||
850 | =cut | |
851 | ||
852 | sub LoadConfig { | |
853 | my $self = shift; | |
854 | my %args = ( File => '', @_ ); | |
855 | $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/; | |
856 | if ( $args{'File'} eq 'RT_SiteConfig.pm' | |
857 | and my $site_config = $ENV{RT_SITE_CONFIG} ) | |
858 | { | |
859 | $self->_LoadConfig( %args, File => $site_config ); | |
860 | } else { | |
861 | $self->_LoadConfig(%args); | |
862 | } | |
863 | $args{'File'} =~ s/Site(?=Config\.pm$)//; | |
864 | $self->_LoadConfig(%args); | |
865 | return 1; | |
866 | } | |
867 | ||
868 | sub _LoadConfig { | |
869 | my $self = shift; | |
870 | my %args = ( File => '', @_ ); | |
871 | ||
872 | my ($is_ext, $is_site); | |
873 | if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) { | |
874 | ($is_ext, $is_site) = ('', 1); | |
875 | } else { | |
876 | $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : ''; | |
877 | $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0; | |
878 | } | |
879 | ||
880 | eval { | |
881 | package RT; | |
882 | local *Set = sub(\[$@%]@) { | |
883 | my ( $opt_ref, @args ) = @_; | |
884 | my ( $pack, $file, $line ) = caller; | |
885 | return $self->SetFromConfig( | |
886 | Option => $opt_ref, | |
887 | Value => [@args], | |
888 | Package => $pack, | |
889 | File => $file, | |
890 | Line => $line, | |
891 | SiteConfig => $is_site, | |
892 | Extension => $is_ext, | |
893 | ); | |
894 | }; | |
895 | my @etc_dirs = ($RT::LocalEtcPath); | |
896 | push @etc_dirs, RT->PluginDirs('etc') if $is_ext; | |
897 | push @etc_dirs, $RT::EtcPath, @INC; | |
898 | local @INC = @etc_dirs; | |
899 | require $args{'File'}; | |
900 | }; | |
901 | if ($@) { | |
902 | return 1 if $is_site && $@ =~ /^Can't locate \Q$args{File}/; | |
903 | if ( $is_site || $@ !~ /^Can't locate \Q$args{File}/ ) { | |
904 | die qq{Couldn't load RT config file $args{'File'}:\n\n$@}; | |
905 | } | |
906 | ||
907 | my $username = getpwuid($>); | |
908 | my $group = getgrgid($(); | |
909 | ||
910 | my ( $file_path, $fileuid, $filegid ); | |
911 | foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) { | |
912 | my $tmp = File::Spec->catfile( $_, $args{File} ); | |
913 | ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ]; | |
914 | if ( defined $fileuid ) { | |
915 | $file_path = $tmp; | |
916 | last; | |
917 | } | |
918 | } | |
919 | unless ($file_path) { | |
920 | die | |
921 | qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n} | |
922 | . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@}; | |
923 | } | |
924 | ||
925 | my $message = <<EOF; | |
926 | ||
927 | RT couldn't load RT config file %s as: | |
928 | user: $username | |
929 | group: $group | |
930 | ||
931 | The file is owned by user %s and group %s. | |
932 | ||
933 | This usually means that the user/group your webserver is running | |
934 | as cannot read the file. Be careful not to make the permissions | |
935 | on this file too liberal, because it contains database passwords. | |
936 | You may need to put the webserver user in the appropriate group | |
937 | (%s) or change permissions be able to run succesfully. | |
938 | EOF | |
939 | ||
940 | my $fileusername = getpwuid($fileuid); | |
941 | my $filegroup = getgrgid($filegid); | |
942 | my $errormessage = sprintf( $message, | |
943 | $file_path, $fileusername, $filegroup, $filegroup ); | |
944 | die "$errormessage\n$@"; | |
945 | } | |
946 | return 1; | |
947 | } | |
948 | ||
949 | sub PostLoadCheck { | |
950 | my $self = shift; | |
951 | foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) { | |
952 | $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) ); | |
953 | } | |
954 | } | |
955 | ||
956 | =head2 Configs | |
957 | ||
958 | Returns list of config files found in local etc, plugins' etc | |
959 | and main etc directories. | |
960 | ||
961 | =cut | |
962 | ||
963 | sub Configs { | |
964 | my $self = shift; | |
965 | ||
966 | my @configs = (); | |
967 | foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) { | |
968 | my $mask = File::Spec->catfile( $path, "*_Config.pm" ); | |
969 | my @files = glob $mask; | |
970 | @files = grep !/^RT_Config\.pm$/, | |
971 | grep $_ && /^\w+_Config\.pm$/, | |
972 | map { s/^.*[\\\/]//; $_ } @files; | |
973 | push @configs, sort @files; | |
974 | } | |
975 | ||
976 | my %seen; | |
977 | @configs = grep !$seen{$_}++, @configs; | |
978 | return @configs; | |
979 | } | |
980 | ||
981 | =head2 Get | |
982 | ||
983 | Takes name of the option as argument and returns its current value. | |
984 | ||
985 | In the case of a user-overridable option, first checks the user's | |
986 | preferences before looking for site-wide configuration. | |
987 | ||
988 | Returns values from RT_SiteConfig, RT_Config and then the %META hash | |
989 | of configuration variables's "Default" for this config variable, | |
990 | in that order. | |
991 | ||
992 | Returns different things in scalar and array contexts. For scalar | |
993 | options it's not that important, however for arrays and hash it's. | |
994 | In scalar context returns references to arrays and hashes. | |
995 | ||
996 | Use C<scalar> perl's op to force context, especially when you use | |
997 | C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)> | |
998 | as perl's '=>' op doesn't change context of the right hand argument to | |
999 | scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>. | |
1000 | ||
1001 | It's also important for options that have no default value(no default | |
1002 | in F<etc/RT_Config.pm>). If you don't force scalar context then you'll | |
1003 | get empty list and all your named args will be messed up. For example | |
1004 | C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)> | |
1005 | will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably | |
1006 | unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)> | |
1007 | will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>. | |
1008 | ||
1009 | =cut | |
1010 | ||
1011 | sub Get { | |
1012 | my ( $self, $name, $user ) = @_; | |
1013 | ||
1014 | my $res; | |
1015 | if ( $user && $user->id && $META{$name}->{'Overridable'} ) { | |
1016 | $user = $user->UserObj if $user->isa('RT::CurrentUser'); | |
1017 | my $prefs = $user->Preferences($RT::System); | |
1018 | $res = $prefs->{$name} if $prefs; | |
1019 | } | |
1020 | $res = $OPTIONS{$name} unless defined $res; | |
1021 | $res = $META{$name}->{'Default'} unless defined $res; | |
1022 | return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); | |
1023 | } | |
1024 | ||
1025 | =head2 GetObfuscated | |
1026 | ||
1027 | the same as Get, except it returns Obfuscated value via Obfuscate sub | |
1028 | ||
1029 | =cut | |
1030 | ||
1031 | sub GetObfuscated { | |
1032 | my $self = shift; | |
1033 | my ( $name, $user ) = @_; | |
1034 | my $obfuscate = $META{$name}->{Obfuscate}; | |
1035 | ||
1036 | # we use two Get here is to simplify the logic of the return value | |
1037 | # configs need obfuscation are supposed to be less, so won't be too heavy | |
1038 | ||
1039 | return $self->Get(@_) unless $obfuscate; | |
1040 | ||
1041 | my $res = $self->Get(@_); | |
1042 | $res = $obfuscate->( $self, $res, $user ); | |
1043 | return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' ); | |
1044 | } | |
1045 | ||
1046 | =head2 Set | |
1047 | ||
1048 | Set option's value to new value. Takes name of the option and new value. | |
1049 | Returns old value. | |
1050 | ||
1051 | The new value should be scalar, array or hash depending on type of the option. | |
1052 | If the option is not defined in meta or the default RT config then it is of | |
1053 | scalar type. | |
1054 | ||
1055 | =cut | |
1056 | ||
1057 | sub Set { | |
1058 | my ( $self, $name ) = ( shift, shift ); | |
1059 | ||
1060 | my $old = $OPTIONS{$name}; | |
1061 | my $type = $META{$name}->{'Type'} || 'SCALAR'; | |
1062 | if ( $type eq 'ARRAY' ) { | |
1063 | $OPTIONS{$name} = [@_]; | |
1064 | { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); } | |
1065 | } elsif ( $type eq 'HASH' ) { | |
1066 | $OPTIONS{$name} = {@_}; | |
1067 | { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); } | |
1068 | } else { | |
1069 | $OPTIONS{$name} = shift; | |
1070 | {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; } | |
1071 | } | |
1072 | $META{$name}->{'Type'} = $type; | |
1073 | return $self->_ReturnValue( $old, $type ); | |
1074 | } | |
1075 | ||
1076 | sub _ReturnValue { | |
1077 | my ( $self, $res, $type ) = @_; | |
1078 | return $res unless wantarray; | |
1079 | ||
1080 | if ( $type eq 'ARRAY' ) { | |
1081 | return @{ $res || [] }; | |
1082 | } elsif ( $type eq 'HASH' ) { | |
1083 | return %{ $res || {} }; | |
1084 | } | |
1085 | return $res; | |
1086 | } | |
1087 | ||
1088 | sub SetFromConfig { | |
1089 | my $self = shift; | |
1090 | my %args = ( | |
1091 | Option => undef, | |
1092 | Value => [], | |
1093 | Package => 'RT', | |
1094 | File => '', | |
1095 | Line => 0, | |
1096 | SiteConfig => 1, | |
1097 | Extension => 0, | |
1098 | @_ | |
1099 | ); | |
1100 | ||
1101 | unless ( $args{'File'} ) { | |
1102 | ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1); | |
1103 | } | |
1104 | ||
1105 | my $opt = $args{'Option'}; | |
1106 | ||
1107 | my $type; | |
1108 | my $name = $self->__GetNameByRef($opt); | |
1109 | if ($name) { | |
1110 | $type = ref $opt; | |
1111 | $name =~ s/.*:://; | |
1112 | } else { | |
1113 | $name = $$opt; | |
1114 | $type = $META{$name}->{'Type'} || 'SCALAR'; | |
1115 | } | |
1116 | ||
1117 | # if option is already set we have to check where | |
1118 | # it comes from and may be ignore it | |
1119 | if ( exists $OPTIONS{$name} ) { | |
1120 | if ( $type eq 'HASH' ) { | |
1121 | $args{'Value'} = [ | |
1122 | @{ $args{'Value'} }, | |
1123 | @{ $args{'Value'} }%2? (undef) : (), | |
1124 | $self->Get( $name ), | |
1125 | ]; | |
1126 | } elsif ( $args{'SiteConfig'} && $args{'Extension'} ) { | |
1127 | # if it's site config of an extension then it can only | |
1128 | # override options that came from its main config | |
1129 | if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) { | |
1130 | my %source = %{ $META{$name}->{'Source'} }; | |
1131 | warn | |
1132 | "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." | |
1133 | ." This option earlier has been set in $source{'File'} line $source{'Line'}." | |
1134 | ." To overide this option use ". ($source{'Extension'}||'RT') | |
1135 | ." site config." | |
1136 | ; | |
1137 | return 1; | |
1138 | } | |
1139 | } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) { | |
1140 | # if it's core config then we can override any option that came from another | |
1141 | # core config, but not site config | |
1142 | ||
1143 | my %source = %{ $META{$name}->{'Source'} }; | |
1144 | if ( $source{'Extension'} ne $args{'Extension'} ) { | |
1145 | # as a site config is loaded earlier then its base config | |
1146 | # then we warn only on different extensions, for example | |
1147 | # RTIR's options is set in main site config | |
1148 | warn | |
1149 | "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored." | |
1150 | ." It may be ok, but we want you to be aware." | |
1151 | ." This option has been set earlier in $source{'File'} line $source{'Line'}." | |
1152 | ; | |
1153 | } | |
1154 | ||
1155 | return 1; | |
1156 | } | |
1157 | } | |
1158 | ||
1159 | $META{$name}->{'Type'} = $type; | |
1160 | foreach (qw(Package File Line SiteConfig Extension)) { | |
1161 | $META{$name}->{'Source'}->{$_} = $args{$_}; | |
1162 | } | |
1163 | $self->Set( $name, @{ $args{'Value'} } ); | |
1164 | ||
1165 | return 1; | |
1166 | } | |
1167 | ||
1168 | our %REF_SYMBOLS = ( | |
1169 | SCALAR => '$', | |
1170 | ARRAY => '@', | |
1171 | HASH => '%', | |
1172 | CODE => '&', | |
1173 | ); | |
1174 | ||
1175 | { | |
1176 | my $last_pack = ''; | |
1177 | ||
1178 | sub __GetNameByRef { | |
1179 | my $self = shift; | |
1180 | my $ref = shift; | |
1181 | my $pack = shift; | |
1182 | if ( !$pack && $last_pack ) { | |
1183 | my $tmp = $self->__GetNameByRef( $ref, $last_pack ); | |
1184 | return $tmp if $tmp; | |
1185 | } | |
1186 | $pack ||= 'main::'; | |
1187 | $pack .= '::' unless substr( $pack, -2 ) eq '::'; | |
1188 | ||
1189 | no strict 'refs'; | |
1190 | my $name = undef; | |
1191 | ||
1192 | # scan $pack's nametable(hash) | |
1193 | foreach my $k ( keys %{$pack} ) { | |
1194 | ||
1195 | # The hash for main:: has a reference to itself | |
1196 | next if $k eq 'main::'; | |
1197 | ||
1198 | # if the entry has a trailing '::' then | |
1199 | # it is a link to another name space | |
1200 | if ( substr( $k, -2 ) eq '::') { | |
1201 | $name = $self->__GetNameByRef( $ref, $k ); | |
1202 | return $name if $name; | |
1203 | } | |
1204 | ||
1205 | # entry of the table with references to | |
1206 | # SCALAR, ARRAY... and other types with | |
1207 | # the same name | |
1208 | my $entry = ${$pack}{$k}; | |
1209 | next unless $entry; | |
1210 | ||
1211 | # get entry for type we are looking for | |
1212 | # XXX skip references to scalars or other references. | |
1213 | # Otherwie 5.10 goes boom. maybe we should skip any | |
1214 | # reference | |
1215 | next if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF'; | |
403d7b0b MKG |
1216 | |
1217 | my $ref_type = ref($ref); | |
1218 | ||
1219 | # regex/arrayref/hashref/coderef are stored in SCALAR glob | |
1220 | $ref_type = 'SCALAR' if $ref_type eq 'REF'; | |
1221 | ||
1222 | my $entry_ref = *{$entry}{ $ref_type }; | |
84fb5b46 MKG |
1223 | next unless $entry_ref; |
1224 | ||
1225 | # if references are equal then we've found | |
1226 | if ( $entry_ref == $ref ) { | |
1227 | $last_pack = $pack; | |
403d7b0b | 1228 | return ( $REF_SYMBOLS{ $ref_type } || '*' ) . $pack . $k; |
84fb5b46 MKG |
1229 | } |
1230 | } | |
1231 | return ''; | |
1232 | } | |
1233 | } | |
1234 | ||
1235 | =head2 Metadata | |
1236 | ||
1237 | ||
1238 | =head2 Meta | |
1239 | ||
1240 | =cut | |
1241 | ||
1242 | sub Meta { | |
1243 | return $META{ $_[1] }; | |
1244 | } | |
1245 | ||
1246 | sub Sections { | |
1247 | my $self = shift; | |
1248 | my %seen; | |
1249 | my @sections = sort | |
1250 | grep !$seen{$_}++, | |
1251 | map $_->{'Section'} || 'General', | |
1252 | values %META; | |
1253 | return @sections; | |
1254 | } | |
1255 | ||
1256 | sub Options { | |
1257 | my $self = shift; | |
1258 | my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ ); | |
1259 | my @res = keys %META; | |
1260 | ||
1261 | @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'}, | |
1262 | @res | |
1263 | ) if defined $args{'Section'}; | |
1264 | ||
1265 | if ( defined $args{'Overridable'} ) { | |
1266 | @res | |
1267 | = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'}, | |
1268 | @res ); | |
1269 | } | |
1270 | ||
1271 | if ( $args{'Sorted'} ) { | |
1272 | @res = sort { | |
1273 | ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999) | |
1274 | || $a cmp $b | |
1275 | } @res; | |
1276 | } else { | |
1277 | @res = sort { $a cmp $b } @res; | |
1278 | } | |
1279 | return @res; | |
1280 | } | |
1281 | ||
1282 | =head2 AddOption( Name => '', Section => '', ... ) | |
1283 | ||
1284 | =cut | |
1285 | ||
1286 | sub AddOption { | |
1287 | my $self = shift; | |
1288 | my %args = ( | |
1289 | Name => undef, | |
1290 | Section => undef, | |
1291 | Overridable => 0, | |
1292 | SortOrder => undef, | |
1293 | Widget => '/Widgets/Form/String', | |
1294 | WidgetArguments => {}, | |
1295 | @_ | |
1296 | ); | |
1297 | ||
1298 | unless ( $args{Name} ) { | |
1299 | $RT::Logger->error("Need Name to add a new config"); | |
1300 | return; | |
1301 | } | |
1302 | ||
1303 | unless ( $args{Section} ) { | |
1304 | $RT::Logger->error("Need Section to add a new config option"); | |
1305 | return; | |
1306 | } | |
1307 | ||
1308 | $META{ delete $args{Name} } = \%args; | |
1309 | } | |
1310 | ||
1311 | =head2 DeleteOption( Name => '' ) | |
1312 | ||
1313 | =cut | |
1314 | ||
1315 | sub DeleteOption { | |
1316 | my $self = shift; | |
1317 | my %args = ( | |
1318 | Name => undef, | |
1319 | @_ | |
1320 | ); | |
1321 | if ( $args{Name} ) { | |
1322 | delete $META{$args{Name}}; | |
1323 | } | |
1324 | else { | |
1325 | $RT::Logger->error("Need Name to remove a config option"); | |
1326 | return; | |
1327 | } | |
1328 | } | |
1329 | ||
1330 | =head2 UpdateOption( Name => '' ), Section => '', ... ) | |
1331 | ||
1332 | =cut | |
1333 | ||
1334 | sub UpdateOption { | |
1335 | my $self = shift; | |
1336 | my %args = ( | |
1337 | Name => undef, | |
1338 | Section => undef, | |
1339 | Overridable => undef, | |
1340 | SortOrder => undef, | |
1341 | Widget => undef, | |
1342 | WidgetArguments => undef, | |
1343 | @_ | |
1344 | ); | |
1345 | ||
1346 | my $name = delete $args{Name}; | |
1347 | ||
1348 | unless ( $name ) { | |
1349 | $RT::Logger->error("Need Name to update a new config"); | |
1350 | return; | |
1351 | } | |
1352 | ||
1353 | unless ( exists $META{$name} ) { | |
1354 | $RT::Logger->error("Config $name doesn't exist"); | |
1355 | return; | |
1356 | } | |
1357 | ||
1358 | for my $type ( keys %args ) { | |
1359 | next unless defined $args{$type}; | |
1360 | $META{$name}{$type} = $args{$type}; | |
1361 | } | |
1362 | return 1; | |
1363 | } | |
1364 | ||
1365 | RT::Base->_ImportOverlays(); | |
1366 | ||
1367 | 1; |