rt/lib/RT/Config.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
   6 #                                          <jesse@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 use File::Spec ();
  55
  56 =head1 NAME
  57
  58     RT::Config - RT's config
  59
  60 =head1 SYNOPSYS
  61
  62     # get config object
  63     use RT::Config;
  64     my $config = new RT::Config;
  65     $config->LoadConfigs;
  66
  67     # get or set option
  68     my $rt_web_path = $config->Get('WebPath');
  69     $config->Set(EmailOutputEncoding => 'latin1');
  70
  71     # get config object from RT package
  72     use RT;
  73     RT->LoadConfig;
  74     my $config = RT->Config;
  75
  76 =head1 DESCRIPTION
  77
  78 C<RT::Config> class provide access to RT's and RT extensions' config files.
  79
  80 RT uses two files for site configuring:
  81
  82 First file is F<RT_Config.pm> - core config file. This file is shipped
  83 with RT distribution and contains default values for all available options.
  84 B<You should never edit this file.>
  85
  86 Second file is F<RT_SiteConfig.pm> - site config file. You can use it
  87 to customize your RT instance. In this file you can override any option
  88 listed in core config file.
  89
  90 RT extensions could also provide thier config files. Extensions should
  91 use F<< <NAME>_Config.pm >> and F<< <NAME>_SiteConfig.pm >> names for
  92 config files, where <NAME> is extension name.
  93
  94 B<NOTE>: All options from RT's config and extensions' configs are saved
  95 in one place and thus extension could override RT's options, but it is not
  96 recommended.
  97
  98 =cut
  99
 100 =head2 %META
 101
 102 Hash of Config options that may be user overridable
 103 or may require more logic than should live in RT_*Config.pm
 104
 105 Keyed by config name, there are several properties that
 106 can be set for each config optin:
 107
 108  Section     - What header this option should be grouped
 109                under on the user Settings page
 110  Overridable - Can users change this option
 111  SortOrder   - Within a Section, how should the options be sorted
 112                for display to the user
 113  Widget      - Mason component path to widget that should be used
 114                to display this config option
 115  WidgetArguments - An argument hash passed to the WIdget
 116     Description - Friendly description to show the user
 117     Values      - Arrayref of options (for select Widget)
 118     ValuesLabel - Hashref, key is the Value from the Values
 119                   list, value is a user friendly description
 120                   of the value
 121     Callback    - subref that receives no arguments.  It returns
 122                   a hashref of items that are added to the rest
 123                   of the WidgetArguments
 124  PostLoadCheck - subref passed the RT::Config object and the current
 125                  setting of the config option.  Can make further checks
 126                  (such as seeing if a library is installed) and then change
 127                  the setting of this or other options in the Config using
 128                  the RT::Config option.
 129
 130 =cut
 131
 132 our %META = (
 133     # General user overridable options
 134     DefaultQueue => {
 135         Section         => 'General',
 136         Overridable     => 1,
 137         SortOrder       => 1,
 138         Widget          => '/Widgets/Form/Select',
 139         WidgetArguments => {
 140             Description => 'Default queue',    #loc
 141             Callback    => sub {
 142                 my $ret = { Values => [], ValuesLabel => {}};
 143                 my $q = new RT::Queues($HTML::Mason::Commands::session{'CurrentUser'});
 144                 $q->UnLimit;
 145                 while (my $queue = $q->Next) {
 146                     next unless $queue->CurrentUserHasRight("CreateTicket");
 147                     push @{$ret->{Values}}, $queue->Id;
 148                     $ret->{ValuesLabel}{$queue->Id} = $queue->Name;
 149                 }
 150                 return $ret;
 151             },
 152         }
 153     },
 154     UsernameFormat => {
 155         Section         => 'General',
 156         Overridable     => 1,
 157         SortOrder       => 2,
 158         Widget          => '/Widgets/Form/Select',
 159         WidgetArguments => {
 160             Description => 'Username format', # loc
 161             Values      => [qw(concise verbose)],
 162             ValuesLabel => {
 163                 concise => 'Short usernames', # loc_left_pair
 164                 verbose => 'Name and email address', # loc_left_pair
 165             },
 166         },
 167     },
 168     WebDefaultStylesheet => {
 169         Section         => 'General',                #loc
 170         Overridable     => 1,
 171         SortOrder       => 3,
 172         Widget          => '/Widgets/Form/Select',
 173         WidgetArguments => {
 174             Description => 'Theme',                  #loc
 175             # XXX: we need support for 'get values callback'
 176             Values => [qw(3.5-default 3.4-compat web2 freeside2.1)],
 177         },
 178     },
 179     MessageBoxRichText => {
 180         Section => 'General',
 181         Overridable => 1,
 182         SortOrder => 4,
 183         Widget => '/Widgets/Form/Boolean',
 184         WidgetArguments => {
 185             Description => 'WYSIWYG message composer' # loc
 186         }
 187     },
 188     MessageBoxRichTextHeight => {
 189         Section => 'General',
 190         Overridable => 1,
 191         SortOrder => 5,
 192         Widget => '/Widgets/Form/Integer',
 193         WidgetArguments => {
 194             Description => 'WYSIWYG composer height', # loc
 195         }
 196     },
 197     MessageBoxWidth => {
 198         Section         => 'General',
 199         Overridable     => 1,
 200         SortOrder       => 6,
 201         Widget          => '/Widgets/Form/Integer',
 202         WidgetArguments => {
 203             Description => 'Message box width',           #loc
 204         },
 205     },
 206     MessageBoxHeight => {
 207         Section         => 'General',
 208         Overridable     => 1,
 209         SortOrder       => 7,
 210         Widget          => '/Widgets/Form/Integer',
 211         WidgetArguments => {
 212             Description => 'Message box height',          #loc
 213         },
 214     },
 215     SearchResultsRefreshInterval => {
 216         Section         => 'General',                       #loc
 217         Overridable     => 1,
 218         SortOrder       => 8,
 219         Widget          => '/Widgets/Form/Select',
 220         WidgetArguments => {
 221             Description => 'Search results refresh interval',                            #loc
 222             Values      => [qw(0 120 300 600 1200 3600 7200)],
 223             ValuesLabel => {
 224                 0 => "Don't refresh search results.",                      #loc
 225                 120 => "Refresh search results every 2 minutes.",          #loc
 226                 300 => "Refresh search results every 5 minutes.",          #loc
 227                 600 => "Refresh search results every 10 minutes.",         #loc
 228                 1200 => "Refresh search results every 20 minutes.",        #loc
 229                 3600 => "Refresh search results every 60 minutes.",        #loc
 230                 7200 => "Refresh search results every 120 minutes.",       #loc
 231             },
 232         },
 233     },
 234
 235     # User overridable options for RT at a glance
 236     DefaultSummaryRows => {
 237         Section         => 'RT at a glance',    #loc
 238         Overridable     => 1,
 239         SortOrder       => 1,
 240         Widget          => '/Widgets/Form/Integer',
 241         WidgetArguments => {
 242             Description => 'Number of search results',    #loc
 243         },
 244     },
 245     HomePageRefreshInterval => {
 246         Section         => 'RT at a glance',                       #loc
 247         Overridable     => 1,
 248         SortOrder       => 2,
 249         Widget          => '/Widgets/Form/Select',
 250         WidgetArguments => {
 251             Description => 'Home page refresh interval',                #loc
 252             Values      => [qw(0 120 300 600 1200 3600 7200)],
 253             ValuesLabel => {
 254                 0 => "Don't refresh home page.",                  #loc
 255                 120 => "Refresh home page every 2 minutes.",      #loc
 256                 300 => "Refresh home page every 5 minutes.",      #loc
 257                 600 => "Refresh home page every 10 minutes.",     #loc
 258                 1200 => "Refresh home page every 20 minutes.",    #loc
 259                 3600 => "Refresh home page every 60 minutes.",    #loc
 260                 7200 => "Refresh home page every 120 minutes.",   #loc
 261             },
 262         },
 263     },
 264
 265     # User overridable options for Ticket displays
 266     MaxInlineBody => {
 267         Section         => 'Ticket display',              #loc
 268         Overridable     => 1,
 269         SortOrder       => 1,
 270         Widget          => '/Widgets/Form/Integer',
 271         WidgetArguments => {
 272             Description => 'Maximum inline message length',    #loc
 273             Hints =>
 274             "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
 275         },
 276     },
 277     OldestTransactionsFirst => {
 278         Section         => 'Ticket display',
 279         Overridable     => 1,
 280         SortOrder       => 2,
 281         Widget          => '/Widgets/Form/Boolean',
 282         WidgetArguments => {
 283             Description => 'Show oldest history first',    #loc
 284         },
 285     },
 286     ShowUnreadMessageNotifications => {
 287         Section         => 'Ticket display',
 288         Overridable     => 1,
 289         SortOrder       => 3,
 290         Widget          => '/Widgets/Form/Boolean',
 291         WidgetArguments => {
 292             Description => 'Notify me of unread messages',    #loc
 293         },
 294
 295     },
 296     PlainTextPre => {
 297         Section         => 'Ticket display',
 298         Overridable     => 1,
 299         SortOrder       => 4,
 300         Widget          => '/Widgets/Form/Boolean',
 301         WidgetArguments => {
 302             Description => 'add <pre> tag around plain text attachments', #loc
 303             Hints       => "Use this to protect the format of plain text" #loc
 304         },
 305     },
 306     PlainTextMono => {
 307         Section         => 'Ticket display',
 308         Overridable     => 1,
 309         SortOrder       => 5,
 310         Widget          => '/Widgets/Form/Boolean',
 311         WidgetArguments => {
 312             Description => 'display wrapped and formatted plain text attachments', #loc
 313             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
 314         },
 315     },
 316     DisplayAfterQuickCreate => {
 317         Section         => 'Ticket display',
 318         Overridable     => 1,
 319         SortOrder       => 6,
 320         Widget          => '/Widgets/Form/Boolean',
 321         WidgetArguments => {
 322             Description => 'On Quick Create, redirect to ticket display', #loc
 323             #Hints => '', #loc
 324         },
 325     },
 326
 327     # User overridable locale options
 328     DateTimeFormat => {
 329         Section         => 'Locale',                       #loc
 330         Overridable     => 1,
 331         Widget          => '/Widgets/Form/Select',
 332         WidgetArguments => {
 333             Description => 'Date format',                            #loc
 334             Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
 335                               my $date = new RT::Date($HTML::Mason::Commands::session{'CurrentUser'});
 336                               $date->Set;
 337                               foreach my $value ($date->Formatters) {
 338                                  push @{$ret->{Values}}, $value;
 339                                  $ret->{ValuesLabel}{$value} = $date->$value();
 340                               }
 341                               return $ret;
 342             },
 343         },
 344     },
 345
 346     RTAddressRegexp => {
 347         Type    => 'SCALAR',
 348         PostLoadCheck => sub {
 349             my $self = shift;
 350             my $value = $self->Get('RTAddressRegexp');
 351             return if $value;
 352
 353             #XXX freeside - should fix this at some point, but it is being WAY
 354             #too noisy in the logs
 355             #$RT::Logger->error(
 356             #    'The RTAddressRegexp option is not set in the config.'
 357             #    .' Not setting this option results in additional SQL queries to'
 358             #    .' check whether each address belongs to RT or not.'
 359             #    .' It is especially important to set this option if RT recieves'
 360             #    .' emails on addresses that are not in the database or config.'
 361             #);
 362         },
 363     },
 364     # User overridable mail options
 365     EmailFrequency => {
 366         Section         => 'Mail',                                     #loc
 367         Overridable     => 1,
 368         Default     => 'Individual messages',
 369         Widget          => '/Widgets/Form/Select',
 370         WidgetArguments => {
 371             Description => 'Email delivery',    #loc
 372             Values      => [
 373             'Individual messages',    #loc
 374             'Daily digest',           #loc
 375             'Weekly digest',          #loc
 376             'Suspended'               #loc
 377             ]
 378         }
 379     },
 380     NotifyActor => {
 381         Section         => 'Mail',                                     #loc
 382         Overridable     => 1,
 383         SortOrder       => 2,
 384         Widget          => '/Widgets/Form/Boolean',
 385         WidgetArguments => {
 386             Description => 'Outgoing mail', #loc
 387             Hints => 'Should RT send you mail for ticket updates you make?', #loc
 388         }
 389     },
 390
 391     # this tends to break extensions that stash links in ticket update pages
 392     Organization => {
 393         Type            => 'SCALAR',
 394         PostLoadCheck   => sub {
 395             my ($self,$value) = @_;
 396             $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace.  Please fix this.")
 397                 if $value =~ /\s/;;
 398         },
 399     },
 400
 401     # Internal config options
 402     DisableGraphViz => {
 403         Type            => 'SCALAR',
 404         PostLoadCheck   => sub {
 405             my $self  = shift;
 406             my $value = shift;
 407             return if $value;
 408             return if $INC{'GraphViz.pm'};
 409             local $@;
 410             return if eval {require GraphViz; 1};
 411             $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
 412             $self->Set( DisableGraphViz => 1 );
 413         },
 414     },
 415     DisableGD => {
 416         Type            => 'SCALAR',
 417         PostLoadCheck   => sub {
 418             my $self  = shift;
 419             my $value = shift;
 420             return if $value;
 421             return if $INC{'GD.pm'};
 422             local $@;
 423             return if eval {require GD; 1};
 424             $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
 425             $self->Set( DisableGD => 1 );
 426         },
 427     },
 428     MailPlugins  => { Type => 'ARRAY' },
 429     Plugins      => { Type => 'ARRAY' },
 430     GnuPG        => { Type => 'HASH' },
 431     GnuPGOptions => { Type => 'HASH',
 432         PostLoadCheck => sub {
 433             my $self = shift;
 434             my $gpg = $self->Get('GnuPG');
 435             return unless $gpg->{'Enable'};
 436             my $gpgopts = $self->Get('GnuPGOptions');
 437             unless (-d $gpgopts->{homedir}  && -r _ ) { # no homedir, no gpg
 438                 $RT::Logger->debug(
 439                     "RT's GnuPG libraries couldn't successfully read your".
 440                     " configured GnuPG home directory (".$gpgopts->{homedir}
 441                     ."). PGP support has been disabled");
 442                 $gpg->{'Enable'} = 0;
 443                 return;
 444             }
 445
 446
 447             require RT::Crypt::GnuPG;
 448             unless (RT::Crypt::GnuPG->Probe()) {
 449                 $RT::Logger->debug(
 450                     "RT's GnuPG libraries couldn't successfully execute gpg.".
 451                     " PGP support has been disabled");
 452                 $gpg->{'Enable'} = 0;
 453             }
 454         }
 455     },
 456 );
 457 my %OPTIONS = ();
 458
 459 =head1 METHODS
 460
 461 =head2 new
 462
 463 Object constructor returns new object. Takes no arguments.
 464
 465 =cut
 466
 467 sub new {
 468     my $proto = shift;
 469     my $class = ref($proto) ? ref($proto) : $proto;
 470     my $self  = bless {}, $class;
 471     $self->_Init(@_);
 472     return $self;
 473 }
 474
 475 sub _Init {
 476     return;
 477 }
 478
 479 =head2 InitConfig
 480
 481 Do nothin right now.
 482
 483 =cut
 484
 485 sub InitConfig {
 486     my $self = shift;
 487     my %args = ( File => '', @_ );
 488     $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
 489     return 1;
 490 }
 491
 492 =head2 LoadConfigs
 493
 494 Load all configs. First of all load RT's config then load
 495 extensions' config files in alphabetical order.
 496 Takes no arguments.
 497
 498 =cut
 499
 500 sub LoadConfigs {
 501     my $self    = shift;
 502
 503     $self->InitConfig( File => 'RT_Config.pm' );
 504     $self->LoadConfig( File => 'RT_Config.pm' );
 505
 506     my @configs = $self->Configs;
 507     $self->InitConfig( File => $_ ) foreach @configs;
 508     $self->LoadConfig( File => $_ ) foreach @configs;
 509     return;
 510 }
 511
 512 =head1 LoadConfig
 513
 514 Takes param hash with C<File> field.
 515 First, the site configuration file is loaded, in order to establish
 516 overall site settings like hostname and name of RT instance.
 517 Then, the core configuration file is loaded to set fallback values
 518 for all settings; it bases some values on settings from the site
 519 configuration file.
 520
 521 B<Note> that core config file don't change options if site config
 522 has set them so to add value to some option instead of
 523 overriding you have to copy original value from core config file.
 524
 525 =cut
 526
 527 sub LoadConfig {
 528     my $self = shift;
 529     my %args = ( File => '', @_ );
 530     $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
 531     if ( $args{'File'} eq 'RT_SiteConfig.pm'
 532         and my $site_config = $ENV{RT_SITE_CONFIG} )
 533     {
 534         $self->_LoadConfig( %args, File => $site_config );
 535     } else {
 536         $self->_LoadConfig(%args);
 537     }
 538     $args{'File'} =~ s/Site(?=Config\.pm$)//;
 539     $self->_LoadConfig(%args);
 540     return 1;
 541 }
 542
 543 sub _LoadConfig {
 544     my $self = shift;
 545     my %args = ( File => '', @_ );
 546
 547     my ($is_ext, $is_site);
 548     if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
 549         ($is_ext, $is_site) = ('', 1);
 550     } else {
 551         $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
 552         $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
 553     }
 554
 555     eval {
 556         package RT;
 557         local *Set = sub(\[$@%]@) {
 558             my ( $opt_ref, @args ) = @_;
 559             my ( $pack, $file, $line ) = caller;
 560             return $self->SetFromConfig(
 561                 Option     => $opt_ref,
 562                 Value      => [@args],
 563                 Package    => $pack,
 564                 File       => $file,
 565                 Line       => $line,
 566                 SiteConfig => $is_site,
 567                 Extension  => $is_ext,
 568             );
 569         };
 570         my @etc_dirs = ($RT::LocalEtcPath);
 571         push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
 572         push @etc_dirs, $RT::EtcPath, @INC;
 573         local @INC = @etc_dirs;
 574         require $args{'File'};
 575     };
 576     if ($@) {
 577         return 1 if $is_site && $@ =~ qr{^Can't locate \Q$args{File}};
 578         if ( $is_site || $@ !~ qr{^Can't locate \Q$args{File}} ) {
 579             die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
 580         }
 581
 582         my $username = getpwuid($>);
 583         my $group    = getgrgid($();
 584
 585         my ( $file_path, $fileuid, $filegid );
 586         foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
 587             my $tmp = File::Spec->catfile( $_, $args{File} );
 588             ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
 589             if ( defined $fileuid ) {
 590                 $file_path = $tmp;
 591                 last;
 592             }
 593         }
 594         unless ($file_path) {
 595             die
 596                 qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
 597                 . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
 598         }
 599
 600         my $message = <<EOF;
 601
 602 RT couldn't load RT config file %s as:
 603     user: $username
 604     group: $group
 605
 606 The file is owned by user %s and group %s.
 607
 608 This usually means that the user/group your webserver is running
 609 as cannot read the file.  Be careful not to make the permissions
 610 on this file too liberal, because it contains database passwords.
 611 You may need to put the webserver user in the appropriate group
 612 (%s) or change permissions be able to run succesfully.
 613 EOF
 614
 615         my $fileusername = getpwuid($fileuid);
 616         my $filegroup    = getgrgid($filegid);
 617         my $errormessage = sprintf( $message,
 618             $file_path, $fileusername, $filegroup, $filegroup );
 619         die "$errormessage\n$@";
 620     }
 621     return 1;
 622 }
 623
 624 sub PostLoadCheck {
 625     my $self = shift;
 626     foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
 627         $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
 628     }
 629 }
 630
 631 =head2 Configs
 632
 633 Returns list of config files found in local etc, plugins' etc
 634 and main etc directories.
 635
 636 =cut
 637
 638 sub Configs {
 639     my $self    = shift;
 640
 641     my @configs = ();
 642     foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
 643         my $mask = File::Spec->catfile( $path, "*_Config.pm" );
 644         my @files = glob $mask;
 645         @files = grep !/^RT_Config\.pm$/,
 646             grep $_ && /^\w+_Config\.pm$/,
 647             map { s/^.*[\\\/]//; $_ } @files;
 648         push @configs, sort @files;
 649     }
 650
 651     my %seen;
 652     @configs = grep !$seen{$_}++, @configs;
 653     return @configs;
 654 }
 655
 656 =head2 Get
 657
 658 Takes name of the option as argument and returns its current value.
 659
 660 In the case of a user-overridable option, first checks the user's
 661 preferences before looking for site-wide configuration.
 662
 663 Returns values from RT_SiteConfig, RT_Config and then the %META hash
 664 of configuration variables's "Default" for this config variable,
 665 in that order.
 666
 667 Returns different things in scalar and array contexts. For scalar
 668 options it's not that important, however for arrays and hash it's.
 669 In scalar context returns references to arrays and hashes.
 670
 671 Use C<scalar> perl's op to force context, especially when you use
 672 C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
 673 as perl's '=>' op doesn't change context of the right hand argument to
 674 scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
 675
 676 It's also important for options that have no default value(no default
 677 in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
 678 get empty list and all your named args will be messed up. For example
 679 C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
 680 will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
 681 unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
 682 will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
 683
 684 =cut
 685
 686 sub Get {
 687     my ( $self, $name, $user ) = @_;
 688
 689     my $res;
 690     if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
 691         $user = $user->UserObj if $user->isa('RT::CurrentUser');
 692         my $prefs = $user->Preferences($RT::System);
 693         $res = $prefs->{$name} if $prefs;
 694     }
 695     $res = $OPTIONS{$name}           unless defined $res;
 696     $res = $META{$name}->{'Default'} unless defined $res;
 697     return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
 698 }
 699
 700 =head2 Set
 701
 702 Set option's value to new value. Takes name of the option and new value.
 703 Returns old value.
 704
 705 The new value should be scalar, array or hash depending on type of the option.
 706 If the option is not defined in meta or the default RT config then it is of
 707 scalar type.
 708
 709 =cut
 710
 711 sub Set {
 712     my ( $self, $name ) = ( shift, shift );
 713
 714     my $old = $OPTIONS{$name};
 715     my $type = $META{$name}->{'Type'} || 'SCALAR';
 716     if ( $type eq 'ARRAY' ) {
 717         $OPTIONS{$name} = [@_];
 718         { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
 719     } elsif ( $type eq 'HASH' ) {
 720         $OPTIONS{$name} = {@_};
 721         { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
 722     } else {
 723         $OPTIONS{$name} = shift;
 724         {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
 725     }
 726     $META{$name}->{'Type'} = $type;
 727     return $self->_ReturnValue( $old, $type );
 728 }
 729
 730 sub _ReturnValue {
 731     my ( $self, $res, $type ) = @_;
 732     return $res unless wantarray;
 733
 734     if ( $type eq 'ARRAY' ) {
 735         return @{ $res || [] };
 736     } elsif ( $type eq 'HASH' ) {
 737         return %{ $res || {} };
 738     }
 739     return $res;
 740 }
 741
 742 sub SetFromConfig {
 743     my $self = shift;
 744     my %args = (
 745         Option     => undef,
 746         Value      => [],
 747         Package    => 'RT',
 748         File       => '',
 749         Line       => 0,
 750         SiteConfig => 1,
 751         Extension  => 0,
 752         @_
 753     );
 754
 755     unless ( $args{'File'} ) {
 756         ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
 757     }
 758
 759     my $opt = $args{'Option'};
 760
 761     my $type;
 762     my $name = $self->__GetNameByRef($opt);
 763     if ($name) {
 764         $type = ref $opt;
 765         $name =~ s/.*:://;
 766     } else {
 767         $name = $$opt;
 768         $type = $META{$name}->{'Type'} || 'SCALAR';
 769     }
 770
 771     # if option is already set we have to check where
 772     # it comes from and may be ignore it
 773     if ( exists $OPTIONS{$name} ) {
 774         if ( $args{'SiteConfig'} && $args{'Extension'} ) {
 775             # if it's site config of an extension then it can only
 776             # override options that came from its main config
 777             if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
 778                 my %source = %{ $META{$name}->{'Source'} };
 779                 warn
 780                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 781                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
 782                     ." To overide this option use ". ($source{'Extension'}||'RT')
 783                     ." site config."
 784                 ;
 785                 return 1;
 786             }
 787         } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
 788             # if it's core config then we can override any option that came from another
 789             # core config, but not site config
 790
 791             my %source = %{ $META{$name}->{'Source'} };
 792             if ( $source{'Extension'} ne $args{'Extension'} ) {
 793                 # as a site config is loaded earlier then its base config
 794                 # then we warn only on different extensions, for example
 795                 # RTIR's options is set in main site config or RTFM's
 796                 warn
 797                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 798                     ." It's may be ok, but we want you to be aware."
 799                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
 800                 ;
 801             }
 802
 803             return 1;
 804         }
 805     }
 806
 807     $META{$name}->{'Type'} = $type;
 808     foreach (qw(Package File Line SiteConfig Extension)) {
 809         $META{$name}->{'Source'}->{$_} = $args{$_};
 810     }
 811     $self->Set( $name, @{ $args{'Value'} } );
 812
 813     return 1;
 814 }
 815
 816 {
 817     my $last_pack = '';
 818
 819     sub __GetNameByRef {
 820         my $self = shift;
 821         my $ref  = shift;
 822         my $pack = shift;
 823         if ( !$pack && $last_pack ) {
 824             my $tmp = $self->__GetNameByRef( $ref, $last_pack );
 825             return $tmp if $tmp;
 826         }
 827         $pack ||= 'main::';
 828         $pack .= '::' unless substr( $pack, -2 ) eq '::';
 829
 830         my %ref_sym = (
 831             SCALAR => '$',
 832             ARRAY  => '@',
 833             HASH   => '%',
 834             CODE   => '&',
 835         );
 836         no strict 'refs';
 837         my $name = undef;
 838
 839         # scan $pack's nametable(hash)
 840         foreach my $k ( keys %{$pack} ) {
 841
 842             # hash for main:: has reference on itself
 843             next if $k eq 'main::';
 844
 845             # if entry has trailing '::' then
 846             # it is link to other name space
 847             if ( $k =~ /::$/ ) {
 848                 $name = $self->__GetNameByRef( $ref, $k );
 849                 return $name if $name;
 850             }
 851
 852             # entry of the table with references to
 853             # SCALAR, ARRAY... and other types with
 854             # the same name
 855             my $entry = ${$pack}{$k};
 856             next unless $entry;
 857
 858             # get entry for type we are looking for
 859             # XXX skip references to scalars or other references.
 860             # Otherwie 5.10 goes boom. may be we should skip any
 861             # reference
 862             next if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF';
 863             my $entry_ref = *{$entry}{ ref($ref) };
 864             next unless $entry_ref;
 865
 866             # if references are equal then we've found
 867             if ( $entry_ref == $ref ) {
 868                 $last_pack = $pack;
 869                 return ( $ref_sym{ ref($ref) } || '*' ) . $pack . $k;
 870             }
 871         }
 872         return '';
 873     }
 874 }
 875
 876 =head2 Metadata
 877
 878
 879 =head2 Meta
 880
 881 =cut
 882
 883 sub Meta {
 884     return $META{ $_[1] };
 885 }
 886
 887 sub Sections {
 888     my $self = shift;
 889     my %seen;
 890     return sort
 891         grep !$seen{$_}++,
 892         map $_->{'Section'} || 'General',
 893         values %META;
 894 }
 895
 896 sub Options {
 897     my $self = shift;
 898     my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
 899     my @res  = keys %META;
 900
 901     @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
 902         @res
 903     ) if defined $args{'Section'};
 904
 905     if ( defined $args{'Overridable'} ) {
 906         @res
 907             = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
 908             @res );
 909     }
 910
 911     if ( $args{'Sorted'} ) {
 912         @res = sort {
 913             ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
 914             || $a cmp $b
 915         } @res;
 916     } else {
 917         @res = sort { $a cmp $b } @res;
 918     }
 919     return @res;
 920 }
 921
 922 eval "require RT::Config_Vendor";
 923 if ($@ && $@ !~ qr{^Can't locate RT/Config_Vendor.pm}) {
 924     die $@;
 925 };
 926
 927 eval "require RT::Config_Local";
 928 if ($@ && $@ !~ qr{^Can't locate RT/Config_Local.pm}) {
 929     die $@;
 930 };
 931
 932 1;