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