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
 317     # User overridable locale options
 318     DateTimeFormat => {
 319         Section         => 'Locale',                       #loc
 320         Overridable     => 1,
 321         Widget          => '/Widgets/Form/Select',
 322         WidgetArguments => {
 323             Description => 'Date format',                            #loc
 324             Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
 325                               my $date = new RT::Date($HTML::Mason::Commands::session{'CurrentUser'});
 326                               $date->Set;
 327                               foreach my $value ($date->Formatters) {
 328                                  push @{$ret->{Values}}, $value;
 329                                  $ret->{ValuesLabel}{$value} = $date->$value();
 330                               }
 331                               return $ret;
 332             },
 333         },
 334     },
 335
 336     RTAddressRegexp => {
 337         Type    => 'SCALAR',
 338         PostLoadCheck => sub {
 339             my $self = shift;
 340             my $value = $self->Get('RTAddressRegexp');
 341             return if $value;
 342
 343             $RT::Logger->error(
 344                 'The RTAddressRegexp option is not set in the config.'
 345                 .' Not setting this option results in additional SQL queries to'
 346                 .' check whether each address belongs to RT or not.'
 347                 .' It is especially important to set this option if RT recieves'
 348                 .' emails on addresses that are not in the database or config.'
 349             );
 350         },
 351     },
 352     # User overridable mail options
 353     EmailFrequency => {
 354         Section         => 'Mail',                                     #loc
 355         Overridable     => 1,
 356         Default     => 'Individual messages',
 357         Widget          => '/Widgets/Form/Select',
 358         WidgetArguments => {
 359             Description => 'Email delivery',    #loc
 360             Values      => [
 361             'Individual messages',    #loc
 362             'Daily digest',           #loc
 363             'Weekly digest',          #loc
 364             'Suspended'               #loc
 365             ]
 366         }
 367     },
 368     NotifyActor => {
 369         Section         => 'Mail',                                     #loc
 370         Overridable     => 1,
 371         SortOrder       => 2,
 372         Widget          => '/Widgets/Form/Boolean',
 373         WidgetArguments => {
 374             Description => 'Outgoing mail', #loc
 375             Hints => 'Should RT send you mail for ticket updates you make?', #loc
 376         }
 377     },
 378
 379     # this tends to break extensions that stash links in ticket update pages
 380     Organization => {
 381         Type            => 'SCALAR',
 382         PostLoadCheck   => sub {
 383             my ($self,$value) = @_;
 384             $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace.  Please fix this.")
 385                 if $value =~ /\s/;;
 386         },
 387     },
 388
 389     # Internal config options
 390     DisableGraphViz => {
 391         Type            => 'SCALAR',
 392         PostLoadCheck   => sub {
 393             my $self  = shift;
 394             my $value = shift;
 395             return if $value;
 396             return if $INC{'GraphViz.pm'};
 397             local $@;
 398             return if eval {require GraphViz; 1};
 399             $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
 400             $self->Set( DisableGraphViz => 1 );
 401         },
 402     },
 403     DisableGD => {
 404         Type            => 'SCALAR',
 405         PostLoadCheck   => sub {
 406             my $self  = shift;
 407             my $value = shift;
 408             return if $value;
 409             return if $INC{'GD.pm'};
 410             local $@;
 411             return if eval {require GD; 1};
 412             $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
 413             $self->Set( DisableGD => 1 );
 414         },
 415     },
 416     MailPlugins  => { Type => 'ARRAY' },
 417     Plugins      => { Type => 'ARRAY' },
 418     GnuPG        => { Type => 'HASH' },
 419     GnuPGOptions => { Type => 'HASH',
 420         PostLoadCheck => sub {
 421             my $self = shift;
 422             my $gpg = $self->Get('GnuPG');
 423             return unless $gpg->{'Enable'};
 424             my $gpgopts = $self->Get('GnuPGOptions');
 425             unless (-d $gpgopts->{homedir}  && -r _ ) { # no homedir, no gpg
 426                 $RT::Logger->debug(
 427                     "RT's GnuPG libraries couldn't successfully read your".
 428                     " configured GnuPG home directory (".$gpgopts->{homedir}
 429                     ."). PGP support has been disabled");
 430                 $gpg->{'Enable'} = 0;
 431                 return;
 432             }
 433
 434
 435             require RT::Crypt::GnuPG;
 436             unless (RT::Crypt::GnuPG->Probe()) {
 437                 $RT::Logger->debug(
 438                     "RT's GnuPG libraries couldn't successfully execute gpg.".
 439                     " PGP support has been disabled");
 440                 $gpg->{'Enable'} = 0;
 441             }
 442         }
 443     },
 444 );
 445 my %OPTIONS = ();
 446
 447 =head1 METHODS
 448
 449 =head2 new
 450
 451 Object constructor returns new object. Takes no arguments.
 452
 453 =cut
 454
 455 sub new {
 456     my $proto = shift;
 457     my $class = ref($proto) ? ref($proto) : $proto;
 458     my $self  = bless {}, $class;
 459     $self->_Init(@_);
 460     return $self;
 461 }
 462
 463 sub _Init {
 464     return;
 465 }
 466
 467 =head2 InitConfig
 468
 469 Do nothin right now.
 470
 471 =cut
 472
 473 sub InitConfig {
 474     my $self = shift;
 475     my %args = ( File => '', @_ );
 476     $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
 477     return 1;
 478 }
 479
 480 =head2 LoadConfigs
 481
 482 Load all configs. First of all load RT's config then load
 483 extensions' config files in alphabetical order.
 484 Takes no arguments.
 485
 486 =cut
 487
 488 sub LoadConfigs {
 489     my $self    = shift;
 490
 491     $self->InitConfig( File => 'RT_Config.pm' );
 492     $self->LoadConfig( File => 'RT_Config.pm' );
 493
 494     my @configs = $self->Configs;
 495     $self->InitConfig( File => $_ ) foreach @configs;
 496     $self->LoadConfig( File => $_ ) foreach @configs;
 497     return;
 498 }
 499
 500 =head1 LoadConfig
 501
 502 Takes param hash with C<File> field.
 503 First, the site configuration file is loaded, in order to establish
 504 overall site settings like hostname and name of RT instance.
 505 Then, the core configuration file is loaded to set fallback values
 506 for all settings; it bases some values on settings from the site
 507 configuration file.
 508
 509 B<Note> that core config file don't change options if site config
 510 has set them so to add value to some option instead of
 511 overriding you have to copy original value from core config file.
 512
 513 =cut
 514
 515 sub LoadConfig {
 516     my $self = shift;
 517     my %args = ( File => '', @_ );
 518     $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
 519     if ( $args{'File'} eq 'RT_SiteConfig.pm'
 520         and my $site_config = $ENV{RT_SITE_CONFIG} )
 521     {
 522         $self->_LoadConfig( %args, File => $site_config );
 523     } else {
 524         $self->_LoadConfig(%args);
 525     }
 526     $args{'File'} =~ s/Site(?=Config\.pm$)//;
 527     $self->_LoadConfig(%args);
 528     return 1;
 529 }
 530
 531 sub _LoadConfig {
 532     my $self = shift;
 533     my %args = ( File => '', @_ );
 534
 535     my ($is_ext, $is_site);
 536     if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
 537         ($is_ext, $is_site) = ('', 1);
 538     } else {
 539         $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
 540         $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
 541     }
 542
 543     eval {
 544         package RT;
 545         local *Set = sub(\[$@%]@) {
 546             my ( $opt_ref, @args ) = @_;
 547             my ( $pack, $file, $line ) = caller;
 548             return $self->SetFromConfig(
 549                 Option     => $opt_ref,
 550                 Value      => [@args],
 551                 Package    => $pack,
 552                 File       => $file,
 553                 Line       => $line,
 554                 SiteConfig => $is_site,
 555                 Extension  => $is_ext,
 556             );
 557         };
 558         my @etc_dirs = ($RT::LocalEtcPath);
 559         push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
 560         push @etc_dirs, $RT::EtcPath, @INC;
 561         local @INC = @etc_dirs;
 562         require $args{'File'};
 563     };
 564     if ($@) {
 565         return 1 if $is_site && $@ =~ qr{^Can't locate \Q$args{File}};
 566         if ( $is_site || $@ !~ qr{^Can't locate \Q$args{File}} ) {
 567             die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
 568         }
 569
 570         my $username = getpwuid($>);
 571         my $group    = getgrgid($();
 572
 573         my ( $file_path, $fileuid, $filegid );
 574         foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
 575             my $tmp = File::Spec->catfile( $_, $args{File} );
 576             ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
 577             if ( defined $fileuid ) {
 578                 $file_path = $tmp;
 579                 last;
 580             }
 581         }
 582         unless ($file_path) {
 583             die
 584                 qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
 585                 . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
 586         }
 587
 588         my $message = <<EOF;
 589
 590 RT couldn't load RT config file %s as:
 591     user: $username
 592     group: $group
 593
 594 The file is owned by user %s and group %s.
 595
 596 This usually means that the user/group your webserver is running
 597 as cannot read the file.  Be careful not to make the permissions
 598 on this file too liberal, because it contains database passwords.
 599 You may need to put the webserver user in the appropriate group
 600 (%s) or change permissions be able to run succesfully.
 601 EOF
 602
 603         my $fileusername = getpwuid($fileuid);
 604         my $filegroup    = getgrgid($filegid);
 605         my $errormessage = sprintf( $message,
 606             $file_path, $fileusername, $filegroup, $filegroup );
 607         die "$errormessage\n$@";
 608     }
 609     return 1;
 610 }
 611
 612 sub PostLoadCheck {
 613     my $self = shift;
 614     foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
 615         $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
 616     }
 617 }
 618
 619 =head2 Configs
 620
 621 Returns list of config files found in local etc, plugins' etc
 622 and main etc directories.
 623
 624 =cut
 625
 626 sub Configs {
 627     my $self    = shift;
 628
 629     my @configs = ();
 630     foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
 631         my $mask = File::Spec->catfile( $path, "*_Config.pm" );
 632         my @files = glob $mask;
 633         @files = grep !/^RT_Config\.pm$/,
 634             grep $_ && /^\w+_Config\.pm$/,
 635             map { s/^.*[\\\/]//; $_ } @files;
 636         push @configs, sort @files;
 637     }
 638
 639     my %seen;
 640     @configs = grep !$seen{$_}++, @configs;
 641     return @configs;
 642 }
 643
 644 =head2 Get
 645
 646 Takes name of the option as argument and returns its current value.
 647
 648 In the case of a user-overridable option, first checks the user's
 649 preferences before looking for site-wide configuration.
 650
 651 Returns values from RT_SiteConfig, RT_Config and then the %META hash
 652 of configuration variables's "Default" for this config variable,
 653 in that order.
 654
 655 Returns different things in scalar and array contexts. For scalar
 656 options it's not that important, however for arrays and hash it's.
 657 In scalar context returns references to arrays and hashes.
 658
 659 Use C<scalar> perl's op to force context, especially when you use
 660 C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
 661 as perl's '=>' op doesn't change context of the right hand argument to
 662 scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
 663
 664 It's also important for options that have no default value(no default
 665 in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
 666 get empty list and all your named args will be messed up. For example
 667 C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
 668 will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
 669 unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
 670 will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
 671
 672 =cut
 673
 674 sub Get {
 675     my ( $self, $name, $user ) = @_;
 676
 677     my $res;
 678     if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
 679         $user = $user->UserObj if $user->isa('RT::CurrentUser');
 680         my $prefs = $user->Preferences($RT::System);
 681         $res = $prefs->{$name} if $prefs;
 682     }
 683     $res = $OPTIONS{$name}           unless defined $res;
 684     $res = $META{$name}->{'Default'} unless defined $res;
 685     return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
 686 }
 687
 688 =head2 Set
 689
 690 Set option's value to new value. Takes name of the option and new value.
 691 Returns old value.
 692
 693 The new value should be scalar, array or hash depending on type of the option.
 694 If the option is not defined in meta or the default RT config then it is of
 695 scalar type.
 696
 697 =cut
 698
 699 sub Set {
 700     my ( $self, $name ) = ( shift, shift );
 701
 702     my $old = $OPTIONS{$name};
 703     my $type = $META{$name}->{'Type'} || 'SCALAR';
 704     if ( $type eq 'ARRAY' ) {
 705         $OPTIONS{$name} = [@_];
 706         { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
 707     } elsif ( $type eq 'HASH' ) {
 708         $OPTIONS{$name} = {@_};
 709         { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
 710     } else {
 711         $OPTIONS{$name} = shift;
 712         {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
 713     }
 714     $META{$name}->{'Type'} = $type;
 715     return $self->_ReturnValue( $old, $type );
 716 }
 717
 718 sub _ReturnValue {
 719     my ( $self, $res, $type ) = @_;
 720     return $res unless wantarray;
 721
 722     if ( $type eq 'ARRAY' ) {
 723         return @{ $res || [] };
 724     } elsif ( $type eq 'HASH' ) {
 725         return %{ $res || {} };
 726     }
 727     return $res;
 728 }
 729
 730 sub SetFromConfig {
 731     my $self = shift;
 732     my %args = (
 733         Option     => undef,
 734         Value      => [],
 735         Package    => 'RT',
 736         File       => '',
 737         Line       => 0,
 738         SiteConfig => 1,
 739         Extension  => 0,
 740         @_
 741     );
 742
 743     unless ( $args{'File'} ) {
 744         ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
 745     }
 746
 747     my $opt = $args{'Option'};
 748
 749     my $type;
 750     my $name = $self->__GetNameByRef($opt);
 751     if ($name) {
 752         $type = ref $opt;
 753         $name =~ s/.*:://;
 754     } else {
 755         $name = $$opt;
 756         $type = $META{$name}->{'Type'} || 'SCALAR';
 757     }
 758
 759     # if option is already set we have to check where
 760     # it comes from and may be ignore it
 761     if ( exists $OPTIONS{$name} ) {
 762         if ( $args{'SiteConfig'} && $args{'Extension'} ) {
 763             # if it's site config of an extension then it can only
 764             # override options that came from its main config
 765             if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
 766                 my %source = %{ $META{$name}->{'Source'} };
 767                 warn
 768                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 769                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
 770                     ." To overide this option use ". ($source{'Extension'}||'RT')
 771                     ." site config."
 772                 ;
 773                 return 1;
 774             }
 775         } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
 776             # if it's core config then we can override any option that came from another
 777             # core config, but not site config
 778
 779             my %source = %{ $META{$name}->{'Source'} };
 780             if ( $source{'Extension'} ne $args{'Extension'} ) {
 781                 # as a site config is loaded earlier then its base config
 782                 # then we warn only on different extensions, for example
 783                 # RTIR's options is set in main site config or RTFM's
 784                 warn
 785                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 786                     ." It's may be ok, but we want you to be aware."
 787                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
 788                 ;
 789             }
 790
 791             return 1;
 792         }
 793     }
 794
 795     $META{$name}->{'Type'} = $type;
 796     foreach (qw(Package File Line SiteConfig Extension)) {
 797         $META{$name}->{'Source'}->{$_} = $args{$_};
 798     }
 799     $self->Set( $name, @{ $args{'Value'} } );
 800
 801     return 1;
 802 }
 803
 804 {
 805     my $last_pack = '';
 806
 807     sub __GetNameByRef {
 808         my $self = shift;
 809         my $ref  = shift;
 810         my $pack = shift;
 811         if ( !$pack && $last_pack ) {
 812             my $tmp = $self->__GetNameByRef( $ref, $last_pack );
 813             return $tmp if $tmp;
 814         }
 815         $pack ||= 'main::';
 816         $pack .= '::' unless substr( $pack, -2 ) eq '::';
 817
 818         my %ref_sym = (
 819             SCALAR => '$',
 820             ARRAY  => '@',
 821             HASH   => '%',
 822             CODE   => '&',
 823         );
 824         no strict 'refs';
 825         my $name = undef;
 826
 827         # scan $pack's nametable(hash)
 828         foreach my $k ( keys %{$pack} ) {
 829
 830             # hash for main:: has reference on itself
 831             next if $k eq 'main::';
 832
 833             # if entry has trailing '::' then
 834             # it is link to other name space
 835             if ( $k =~ /::$/ ) {
 836                 $name = $self->__GetNameByRef( $ref, $k );
 837                 return $name if $name;
 838             }
 839
 840             # entry of the table with references to
 841             # SCALAR, ARRAY... and other types with
 842             # the same name
 843             my $entry = ${$pack}{$k};
 844             next unless $entry;
 845
 846             # get entry for type we are looking for
 847             # XXX skip references to scalars or other references.
 848             # Otherwie 5.10 goes boom. may be we should skip any
 849             # reference
 850             next if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF';
 851             my $entry_ref = *{$entry}{ ref($ref) };
 852             next unless $entry_ref;
 853
 854             # if references are equal then we've found
 855             if ( $entry_ref == $ref ) {
 856                 $last_pack = $pack;
 857                 return ( $ref_sym{ ref($ref) } || '*' ) . $pack . $k;
 858             }
 859         }
 860         return '';
 861     }
 862 }
 863
 864 =head2 Metadata
 865
 866
 867 =head2 Meta
 868
 869 =cut
 870
 871 sub Meta {
 872     return $META{ $_[1] };
 873 }
 874
 875 sub Sections {
 876     my $self = shift;
 877     my %seen;
 878     return sort
 879         grep !$seen{$_}++,
 880         map $_->{'Section'} || 'General',
 881         values %META;
 882 }
 883
 884 sub Options {
 885     my $self = shift;
 886     my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
 887     my @res  = keys %META;
 888
 889     @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
 890         @res
 891     ) if defined $args{'Section'};
 892
 893     if ( defined $args{'Overridable'} ) {
 894         @res
 895             = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
 896             @res );
 897     }
 898
 899     if ( $args{'Sorted'} ) {
 900         @res = sort {
 901             ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
 902             || $a cmp $b
 903         } @res;
 904     } else {
 905         @res = sort { $a cmp $b } @res;
 906     }
 907     return @res;
 908 }
 909
 910 eval "require RT::Config_Vendor";
 911 if ($@ && $@ !~ qr{^Can't locate RT/Config_Vendor.pm}) {
 912     die $@;
 913 };
 914
 915 eval "require RT::Config_Local";
 916 if ($@ && $@ !~ qr{^Can't locate RT/Config_Local.pm}) {
 917     die $@;
 918 };
 919
 920 1;