rt/lib/RT/Config.pm

   1 # BEGIN BPS TAGGED BLOCK {{{
   2 #
   3 # COPYRIGHT:
   4 #
   5 # This software is Copyright (c) 1996-2011 Best Practical Solutions, LLC
   6 #                                          <sales@bestpractical.com>
   7 #
   8 # (Except where explicitly superseded by other copyright notices)
   9 #
  10 #
  11 # LICENSE:
  12 #
  13 # This work is made available to you under the terms of Version 2 of
  14 # the GNU General Public License. A copy of that license should have
  15 # been provided with this software, but in any event can be snarfed
  16 # from www.gnu.org.
  17 #
  18 # This work is distributed in the hope that it will be useful, but
  19 # WITHOUT ANY WARRANTY; without even the implied warranty of
  20 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  21 # General Public License for more details.
  22 #
  23 # You should have received a copy of the GNU General Public License
  24 # along with this program; if not, write to the Free Software
  25 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  26 # 02110-1301 or visit their web page on the internet at
  27 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
  28 #
  29 #
  30 # CONTRIBUTION SUBMISSION POLICY:
  31 #
  32 # (The following paragraph is not intended to limit the rights granted
  33 # to you to modify and distribute this software under the terms of
  34 # the GNU General Public License and is only of importance to you if
  35 # you choose to contribute your changes and enhancements to the
  36 # community by submitting them to Best Practical Solutions, LLC.)
  37 #
  38 # By intentionally submitting any modifications, corrections or
  39 # derivatives to this work, or any other work intended for use with
  40 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
  41 # you are the copyright holder for those contributions and you grant
  42 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
  43 # royalty-free, perpetual, license to use, copy, create derivative
  44 # works based on those contributions, and sublicense and distribute
  45 # those contributions and any derivatives thereof.
  46 #
  47 # END BPS TAGGED BLOCK }}}
  48
  49 package RT::Config;
  50
  51 use strict;
  52 use warnings;
  53
  54 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     ResolveDefaultUpdateType => {
 235         Section         => 'General',                                      #loc
 236         Overridable     => 1,
 237         SortOrder       => 9,
 238         Widget          => '/Widgets/Form/Select',
 239         WidgetArguments => {
 240             Description => 'Default Update Type when Resolving',           #loc
 241             Values      => [qw(Comment Respond)],
 242             ValuesLabel => {
 243                 Comment => "Comments (Not sent to requestors)",            #loc
 244                 Respond => "Reply to requestors",                          #loc
 245             },
 246         },
 247     },
 248     SuppressAutoOpenOnUpdate => {
 249         Section => 'General',
 250         Overridable => 1,
 251         SortOrder => 10,
 252         Widget => '/Widgets/Form/Boolean',
 253         WidgetArguments => {
 254             Description => 'Suppress automatic new to open status change on ticket update' # loc
 255         }
 256     },
 257
 258     # User overridable options for RT at a glance
 259     DefaultSummaryRows => {
 260         Section         => 'RT at a glance',    #loc
 261         Overridable     => 1,
 262         SortOrder       => 1,
 263         Widget          => '/Widgets/Form/Integer',
 264         WidgetArguments => {
 265             Description => 'Number of search results',    #loc
 266         },
 267     },
 268     HomePageRefreshInterval => {
 269         Section         => 'RT at a glance',                       #loc
 270         Overridable     => 1,
 271         SortOrder       => 2,
 272         Widget          => '/Widgets/Form/Select',
 273         WidgetArguments => {
 274             Description => 'Home page refresh interval',                #loc
 275             Values      => [qw(0 120 300 600 1200 3600 7200)],
 276             ValuesLabel => {
 277                 0 => "Don't refresh home page.",                  #loc
 278                 120 => "Refresh home page every 2 minutes.",      #loc
 279                 300 => "Refresh home page every 5 minutes.",      #loc
 280                 600 => "Refresh home page every 10 minutes.",     #loc
 281                 1200 => "Refresh home page every 20 minutes.",    #loc
 282                 3600 => "Refresh home page every 60 minutes.",    #loc
 283                 7200 => "Refresh home page every 120 minutes.",   #loc
 284             },
 285         },
 286     },
 287
 288     # User overridable options for Ticket displays
 289     MaxInlineBody => {
 290         Section         => 'Ticket display',              #loc
 291         Overridable     => 1,
 292         SortOrder       => 1,
 293         Widget          => '/Widgets/Form/Integer',
 294         WidgetArguments => {
 295             Description => 'Maximum inline message length',    #loc
 296             Hints =>
 297             "Length in characters; Use '0' to show all messages inline, regardless of length" #loc
 298         },
 299     },
 300     OldestTransactionsFirst => {
 301         Section         => 'Ticket display',
 302         Overridable     => 1,
 303         SortOrder       => 2,
 304         Widget          => '/Widgets/Form/Boolean',
 305         WidgetArguments => {
 306             Description => 'Show oldest history first',    #loc
 307         },
 308     },
 309     ShowUnreadMessageNotifications => {
 310         Section         => 'Ticket display',
 311         Overridable     => 1,
 312         SortOrder       => 3,
 313         Widget          => '/Widgets/Form/Boolean',
 314         WidgetArguments => {
 315             Description => 'Notify me of unread messages',    #loc
 316         },
 317
 318     },
 319     PlainTextPre => {
 320         Section         => 'Ticket display',
 321         Overridable     => 1,
 322         SortOrder       => 4,
 323         Widget          => '/Widgets/Form/Boolean',
 324         WidgetArguments => {
 325             Description => 'add <pre> tag around plain text attachments', #loc
 326             Hints       => "Use this to protect the format of plain text" #loc
 327         },
 328     },
 329     PlainTextMono => {
 330         Section         => 'Ticket display',
 331         Overridable     => 1,
 332         SortOrder       => 5,
 333         Widget          => '/Widgets/Form/Boolean',
 334         WidgetArguments => {
 335             Description => 'display wrapped and formatted plain text attachments', #loc
 336             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
 337         },
 338     },
 339     DisplayAfterQuickCreate => {
 340         Section         => 'Ticket display',
 341         Overridable     => 1,
 342         SortOrder       => 6,
 343         Widget          => '/Widgets/Form/Boolean',
 344         WidgetArguments => {
 345             Description => 'On Quick Create, redirect to ticket display', #loc
 346             #Hints => '', #loc
 347         },
 348     },
 349
 350     # User overridable locale options
 351     DateTimeFormat => {
 352         Section         => 'Locale',                       #loc
 353         Overridable     => 1,
 354         Widget          => '/Widgets/Form/Select',
 355         WidgetArguments => {
 356             Description => 'Date format',                            #loc
 357             Callback => sub { my $ret = { Values => [], ValuesLabel => {}};
 358                               my $date = new RT::Date($HTML::Mason::Commands::session{'CurrentUser'});
 359                               $date->Set;
 360                               foreach my $value ($date->Formatters) {
 361                                  push @{$ret->{Values}}, $value;
 362                                  $ret->{ValuesLabel}{$value} = $date->$value();
 363                               }
 364                               return $ret;
 365             },
 366         },
 367     },
 368
 369     RTAddressRegexp => {
 370         Type    => 'SCALAR',
 371         PostLoadCheck => sub {
 372             my $self = shift;
 373             my $value = $self->Get('RTAddressRegexp');
 374             return if $value;
 375
 376             $RT::Logger->debug(
 377                 'The RTAddressRegexp option is not set in the config.'
 378                 .' Not setting this option results in additional SQL queries to'
 379                 .' check whether each address belongs to RT or not.'
 380                 .' It is especially important to set this option if RT recieves'
 381                 .' emails on addresses that are not in the database or config.'
 382             );
 383         },
 384     },
 385     # User overridable mail options
 386     EmailFrequency => {
 387         Section         => 'Mail',                                     #loc
 388         Overridable     => 1,
 389         Default     => 'Individual messages',
 390         Widget          => '/Widgets/Form/Select',
 391         WidgetArguments => {
 392             Description => 'Email delivery',    #loc
 393             Values      => [
 394             'Individual messages',    #loc
 395             'Daily digest',           #loc
 396             'Weekly digest',          #loc
 397             'Suspended'               #loc
 398             ]
 399         }
 400     },
 401     NotifyActor => {
 402         Section         => 'Mail',                                     #loc
 403         Overridable     => 1,
 404         SortOrder       => 2,
 405         Widget          => '/Widgets/Form/Boolean',
 406         WidgetArguments => {
 407             Description => 'Outgoing mail', #loc
 408             Hints => 'Should RT send you mail for ticket updates you make?', #loc
 409         }
 410     },
 411
 412     # this tends to break extensions that stash links in ticket update pages
 413     Organization => {
 414         Type            => 'SCALAR',
 415         PostLoadCheck   => sub {
 416             my ($self,$value) = @_;
 417             $RT::Logger->error("your \$Organization setting ($value) appears to contain whitespace.  Please fix this.")
 418                 if $value =~ /\s/;;
 419         },
 420     },
 421
 422     # Internal config options
 423     DisableGraphViz => {
 424         Type            => 'SCALAR',
 425         PostLoadCheck   => sub {
 426             my $self  = shift;
 427             my $value = shift;
 428             return if $value;
 429             return if $INC{'GraphViz.pm'};
 430             local $@;
 431             return if eval {require GraphViz; 1};
 432             $RT::Logger->debug("You've enabled GraphViz, but we couldn't load the module: $@");
 433             $self->Set( DisableGraphViz => 1 );
 434         },
 435     },
 436     DisableGD => {
 437         Type            => 'SCALAR',
 438         PostLoadCheck   => sub {
 439             my $self  = shift;
 440             my $value = shift;
 441             return if $value;
 442             return if $INC{'GD.pm'};
 443             local $@;
 444             return if eval {require GD; 1};
 445             $RT::Logger->debug("You've enabled GD, but we couldn't load the module: $@");
 446             $self->Set( DisableGD => 1 );
 447         },
 448     },
 449     MailPlugins  => { Type => 'ARRAY' },
 450     Plugins      => { Type => 'ARRAY' },
 451     GnuPG        => { Type => 'HASH' },
 452     GnuPGOptions => { Type => 'HASH',
 453         PostLoadCheck => sub {
 454             my $self = shift;
 455             my $gpg = $self->Get('GnuPG');
 456             return unless $gpg->{'Enable'};
 457             my $gpgopts = $self->Get('GnuPGOptions');
 458             unless (-d $gpgopts->{homedir}  && -r _ ) { # no homedir, no gpg
 459                 $RT::Logger->debug(
 460                     "RT's GnuPG libraries couldn't successfully read your".
 461                     " configured GnuPG home directory (".$gpgopts->{homedir}
 462                     ."). PGP support has been disabled");
 463                 $gpg->{'Enable'} = 0;
 464                 return;
 465             }
 466
 467
 468             require RT::Crypt::GnuPG;
 469             unless (RT::Crypt::GnuPG->Probe()) {
 470                 $RT::Logger->debug(
 471                     "RT's GnuPG libraries couldn't successfully execute gpg.".
 472                     " PGP support has been disabled");
 473                 $gpg->{'Enable'} = 0;
 474             }
 475         }
 476     },
 477 );
 478 my %OPTIONS = ();
 479
 480 =head1 METHODS
 481
 482 =head2 new
 483
 484 Object constructor returns new object. Takes no arguments.
 485
 486 =cut
 487
 488 sub new {
 489     my $proto = shift;
 490     my $class = ref($proto) ? ref($proto) : $proto;
 491     my $self  = bless {}, $class;
 492     $self->_Init(@_);
 493     return $self;
 494 }
 495
 496 sub _Init {
 497     return;
 498 }
 499
 500 =head2 InitConfig
 501
 502 Do nothin right now.
 503
 504 =cut
 505
 506 sub InitConfig {
 507     my $self = shift;
 508     my %args = ( File => '', @_ );
 509     $args{'File'} =~ s/(?<=Config)(?=\.pm$)/Meta/;
 510     return 1;
 511 }
 512
 513 =head2 LoadConfigs
 514
 515 Load all configs. First of all load RT's config then load
 516 extensions' config files in alphabetical order.
 517 Takes no arguments.
 518
 519 =cut
 520
 521 sub LoadConfigs {
 522     my $self    = shift;
 523
 524     $self->InitConfig( File => 'RT_Config.pm' );
 525     $self->LoadConfig( File => 'RT_Config.pm' );
 526
 527     my @configs = $self->Configs;
 528     $self->InitConfig( File => $_ ) foreach @configs;
 529     $self->LoadConfig( File => $_ ) foreach @configs;
 530     return;
 531 }
 532
 533 =head1 LoadConfig
 534
 535 Takes param hash with C<File> field.
 536 First, the site configuration file is loaded, in order to establish
 537 overall site settings like hostname and name of RT instance.
 538 Then, the core configuration file is loaded to set fallback values
 539 for all settings; it bases some values on settings from the site
 540 configuration file.
 541
 542 B<Note> that core config file don't change options if site config
 543 has set them so to add value to some option instead of
 544 overriding you have to copy original value from core config file.
 545
 546 =cut
 547
 548 sub LoadConfig {
 549     my $self = shift;
 550     my %args = ( File => '', @_ );
 551     $args{'File'} =~ s/(?<!Site)(?=Config\.pm$)/Site/;
 552     if ( $args{'File'} eq 'RT_SiteConfig.pm'
 553         and my $site_config = $ENV{RT_SITE_CONFIG} )
 554     {
 555         $self->_LoadConfig( %args, File => $site_config );
 556     } else {
 557         $self->_LoadConfig(%args);
 558     }
 559     $args{'File'} =~ s/Site(?=Config\.pm$)//;
 560     $self->_LoadConfig(%args);
 561     return 1;
 562 }
 563
 564 sub _LoadConfig {
 565     my $self = shift;
 566     my %args = ( File => '', @_ );
 567
 568     my ($is_ext, $is_site);
 569     if ( $args{'File'} eq ($ENV{RT_SITE_CONFIG}||'') ) {
 570         ($is_ext, $is_site) = ('', 1);
 571     } else {
 572         $is_ext = $args{'File'} =~ /^(?!RT_)(?:(.*)_)(?:Site)?Config/ ? $1 : '';
 573         $is_site = $args{'File'} =~ /SiteConfig/ ? 1 : 0;
 574     }
 575
 576     eval {
 577         package RT;
 578         local *Set = sub(\[$@%]@) {
 579             my ( $opt_ref, @args ) = @_;
 580             my ( $pack, $file, $line ) = caller;
 581             return $self->SetFromConfig(
 582                 Option     => $opt_ref,
 583                 Value      => [@args],
 584                 Package    => $pack,
 585                 File       => $file,
 586                 Line       => $line,
 587                 SiteConfig => $is_site,
 588                 Extension  => $is_ext,
 589             );
 590         };
 591         my @etc_dirs = ($RT::LocalEtcPath);
 592         push @etc_dirs, RT->PluginDirs('etc') if $is_ext;
 593         push @etc_dirs, $RT::EtcPath, @INC;
 594         local @INC = @etc_dirs;
 595         require $args{'File'};
 596     };
 597     if ($@) {
 598         return 1 if $is_site && $@ =~ qr{^Can't locate \Q$args{File}};
 599         if ( $is_site || $@ !~ qr{^Can't locate \Q$args{File}} ) {
 600             die qq{Couldn't load RT config file $args{'File'}:\n\n$@};
 601         }
 602
 603         my $username = getpwuid($>);
 604         my $group    = getgrgid($();
 605
 606         my ( $file_path, $fileuid, $filegid );
 607         foreach ( $RT::LocalEtcPath, $RT::EtcPath, @INC ) {
 608             my $tmp = File::Spec->catfile( $_, $args{File} );
 609             ( $fileuid, $filegid ) = ( stat($tmp) )[ 4, 5 ];
 610             if ( defined $fileuid ) {
 611                 $file_path = $tmp;
 612                 last;
 613             }
 614         }
 615         unless ($file_path) {
 616             die
 617                 qq{Couldn't load RT config file $args{'File'} as user $username / group $group.\n}
 618                 . qq{The file couldn't be found in $RT::LocalEtcPath and $RT::EtcPath.\n$@};
 619         }
 620
 621         my $message = <<EOF;
 622
 623 RT couldn't load RT config file %s as:
 624     user: $username
 625     group: $group
 626
 627 The file is owned by user %s and group %s.
 628
 629 This usually means that the user/group your webserver is running
 630 as cannot read the file.  Be careful not to make the permissions
 631 on this file too liberal, because it contains database passwords.
 632 You may need to put the webserver user in the appropriate group
 633 (%s) or change permissions be able to run succesfully.
 634 EOF
 635
 636         my $fileusername = getpwuid($fileuid);
 637         my $filegroup    = getgrgid($filegid);
 638         my $errormessage = sprintf( $message,
 639             $file_path, $fileusername, $filegroup, $filegroup );
 640         die "$errormessage\n$@";
 641     }
 642     return 1;
 643 }
 644
 645 sub PostLoadCheck {
 646     my $self = shift;
 647     foreach my $o ( grep $META{$_}{'PostLoadCheck'}, $self->Options( Overridable => undef ) ) {
 648         $META{$o}->{'PostLoadCheck'}->( $self, $self->Get($o) );
 649     }
 650 }
 651
 652 =head2 Configs
 653
 654 Returns list of config files found in local etc, plugins' etc
 655 and main etc directories.
 656
 657 =cut
 658
 659 sub Configs {
 660     my $self    = shift;
 661
 662     my @configs = ();
 663     foreach my $path ( $RT::LocalEtcPath, RT->PluginDirs('etc'), $RT::EtcPath ) {
 664         my $mask = File::Spec->catfile( $path, "*_Config.pm" );
 665         my @files = glob $mask;
 666         @files = grep !/^RT_Config\.pm$/,
 667             grep $_ && /^\w+_Config\.pm$/,
 668             map { s/^.*[\\\/]//; $_ } @files;
 669         push @configs, sort @files;
 670     }
 671
 672     my %seen;
 673     @configs = grep !$seen{$_}++, @configs;
 674     return @configs;
 675 }
 676
 677 =head2 Get
 678
 679 Takes name of the option as argument and returns its current value.
 680
 681 In the case of a user-overridable option, first checks the user's
 682 preferences before looking for site-wide configuration.
 683
 684 Returns values from RT_SiteConfig, RT_Config and then the %META hash
 685 of configuration variables's "Default" for this config variable,
 686 in that order.
 687
 688 Returns different things in scalar and array contexts. For scalar
 689 options it's not that important, however for arrays and hash it's.
 690 In scalar context returns references to arrays and hashes.
 691
 692 Use C<scalar> perl's op to force context, especially when you use
 693 C<(..., Argument => RT->Config->Get('ArrayOpt'), ...)>
 694 as perl's '=>' op doesn't change context of the right hand argument to
 695 scalar. Instead use C<(..., Argument => scalar RT->Config->Get('ArrayOpt'), ...)>.
 696
 697 It's also important for options that have no default value(no default
 698 in F<etc/RT_Config.pm>). If you don't force scalar context then you'll
 699 get empty list and all your named args will be messed up. For example
 700 C<(arg1 => 1, arg2 => RT->Config->Get('OptionDoesNotExist'), arg3 => 3)>
 701 will result in C<(arg1 => 1, arg2 => 'arg3', 3)> what is most probably
 702 unexpected, or C<(arg1 => 1, arg2 => RT->Config->Get('ArrayOption'), arg3 => 3)>
 703 will result in C<(arg1 => 1, arg2 => 'element of option', 'another_one' => ..., 'arg3', 3)>.
 704
 705 =cut
 706
 707 sub Get {
 708     my ( $self, $name, $user ) = @_;
 709
 710     my $res;
 711     if ( $user && $user->id && $META{$name}->{'Overridable'} ) {
 712         $user = $user->UserObj if $user->isa('RT::CurrentUser');
 713         my $prefs = $user->Preferences($RT::System);
 714         $res = $prefs->{$name} if $prefs;
 715     }
 716     $res = $OPTIONS{$name}           unless defined $res;
 717     $res = $META{$name}->{'Default'} unless defined $res;
 718     return $self->_ReturnValue( $res, $META{$name}->{'Type'} || 'SCALAR' );
 719 }
 720
 721 =head2 Set
 722
 723 Set option's value to new value. Takes name of the option and new value.
 724 Returns old value.
 725
 726 The new value should be scalar, array or hash depending on type of the option.
 727 If the option is not defined in meta or the default RT config then it is of
 728 scalar type.
 729
 730 =cut
 731
 732 sub Set {
 733     my ( $self, $name ) = ( shift, shift );
 734
 735     my $old = $OPTIONS{$name};
 736     my $type = $META{$name}->{'Type'} || 'SCALAR';
 737     if ( $type eq 'ARRAY' ) {
 738         $OPTIONS{$name} = [@_];
 739         { no warnings 'once'; no strict 'refs'; @{"RT::$name"} = (@_); }
 740     } elsif ( $type eq 'HASH' ) {
 741         $OPTIONS{$name} = {@_};
 742         { no warnings 'once'; no strict 'refs'; %{"RT::$name"} = (@_); }
 743     } else {
 744         $OPTIONS{$name} = shift;
 745         {no warnings 'once'; no strict 'refs'; ${"RT::$name"} = $OPTIONS{$name}; }
 746     }
 747     $META{$name}->{'Type'} = $type;
 748     return $self->_ReturnValue( $old, $type );
 749 }
 750
 751 sub _ReturnValue {
 752     my ( $self, $res, $type ) = @_;
 753     return $res unless wantarray;
 754
 755     if ( $type eq 'ARRAY' ) {
 756         return @{ $res || [] };
 757     } elsif ( $type eq 'HASH' ) {
 758         return %{ $res || {} };
 759     }
 760     return $res;
 761 }
 762
 763 sub SetFromConfig {
 764     my $self = shift;
 765     my %args = (
 766         Option     => undef,
 767         Value      => [],
 768         Package    => 'RT',
 769         File       => '',
 770         Line       => 0,
 771         SiteConfig => 1,
 772         Extension  => 0,
 773         @_
 774     );
 775
 776     unless ( $args{'File'} ) {
 777         ( $args{'Package'}, $args{'File'}, $args{'Line'} ) = caller(1);
 778     }
 779
 780     my $opt = $args{'Option'};
 781
 782     my $type;
 783     my $name = $self->__GetNameByRef($opt);
 784     if ($name) {
 785         $type = ref $opt;
 786         $name =~ s/.*:://;
 787     } else {
 788         $name = $$opt;
 789         $type = $META{$name}->{'Type'} || 'SCALAR';
 790     }
 791
 792     # if option is already set we have to check where
 793     # it comes from and may be ignore it
 794     if ( exists $OPTIONS{$name} ) {
 795         if ( $args{'SiteConfig'} && $args{'Extension'} ) {
 796             # if it's site config of an extension then it can only
 797             # override options that came from its main config
 798             if ( $args{'Extension'} ne $META{$name}->{'Source'}{'Extension'} ) {
 799                 my %source = %{ $META{$name}->{'Source'} };
 800                 warn
 801                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 802                     ." This option earlier has been set in $source{'File'} line $source{'Line'}."
 803                     ." To overide this option use ". ($source{'Extension'}||'RT')
 804                     ." site config."
 805                 ;
 806                 return 1;
 807             }
 808         } elsif ( !$args{'SiteConfig'} && $META{$name}->{'Source'}{'SiteConfig'} ) {
 809             # if it's core config then we can override any option that came from another
 810             # core config, but not site config
 811
 812             my %source = %{ $META{$name}->{'Source'} };
 813             if ( $source{'Extension'} ne $args{'Extension'} ) {
 814                 # as a site config is loaded earlier then its base config
 815                 # then we warn only on different extensions, for example
 816                 # RTIR's options is set in main site config or RTFM's
 817                 warn
 818                     "Change of config option '$name' at $args{'File'} line $args{'Line'} has been ignored."
 819                     ." It may be ok, but we want you to be aware."
 820                     ." This option has been set earlier in $source{'File'} line $source{'Line'}."
 821                 ;
 822             }
 823
 824             return 1;
 825         }
 826     }
 827
 828     $META{$name}->{'Type'} = $type;
 829     foreach (qw(Package File Line SiteConfig Extension)) {
 830         $META{$name}->{'Source'}->{$_} = $args{$_};
 831     }
 832     $self->Set( $name, @{ $args{'Value'} } );
 833
 834     return 1;
 835 }
 836
 837 {
 838     my $last_pack = '';
 839
 840     sub __GetNameByRef {
 841         my $self = shift;
 842         my $ref  = shift;
 843         my $pack = shift;
 844         if ( !$pack && $last_pack ) {
 845             my $tmp = $self->__GetNameByRef( $ref, $last_pack );
 846             return $tmp if $tmp;
 847         }
 848         $pack ||= 'main::';
 849         $pack .= '::' unless substr( $pack, -2 ) eq '::';
 850
 851         my %ref_sym = (
 852             SCALAR => '$',
 853             ARRAY  => '@',
 854             HASH   => '%',
 855             CODE   => '&',
 856         );
 857         no strict 'refs';
 858         my $name = undef;
 859
 860         # scan $pack's nametable(hash)
 861         foreach my $k ( keys %{$pack} ) {
 862
 863             # hash for main:: has reference on itself
 864             next if $k eq 'main::';
 865
 866             # if entry has trailing '::' then
 867             # it is link to other name space
 868             if ( $k =~ /::$/ ) {
 869                 $name = $self->__GetNameByRef( $ref, $k );
 870                 return $name if $name;
 871             }
 872
 873             # entry of the table with references to
 874             # SCALAR, ARRAY... and other types with
 875             # the same name
 876             my $entry = ${$pack}{$k};
 877             next unless $entry;
 878
 879             # get entry for type we are looking for
 880             # XXX skip references to scalars or other references.
 881             # Otherwie 5.10 goes boom. maybe we should skip any
 882             # reference
 883             next if ref($entry) eq 'SCALAR' || ref($entry) eq 'REF';
 884             my $entry_ref = *{$entry}{ ref($ref) };
 885             next unless $entry_ref;
 886
 887             # if references are equal then we've found
 888             if ( $entry_ref == $ref ) {
 889                 $last_pack = $pack;
 890                 return ( $ref_sym{ ref($ref) } || '*' ) . $pack . $k;
 891             }
 892         }
 893         return '';
 894     }
 895 }
 896
 897 =head2 Metadata
 898
 899
 900 =head2 Meta
 901
 902 =cut
 903
 904 sub Meta {
 905     return $META{ $_[1] };
 906 }
 907
 908 sub Sections {
 909     my $self = shift;
 910     my %seen;
 911     return sort
 912         grep !$seen{$_}++,
 913         map $_->{'Section'} || 'General',
 914         values %META;
 915 }
 916
 917 sub Options {
 918     my $self = shift;
 919     my %args = ( Section => undef, Overridable => 1, Sorted => 1, @_ );
 920     my @res  = keys %META;
 921
 922     @res = grep( ( $META{$_}->{'Section'} || 'General' ) eq $args{'Section'},
 923         @res
 924     ) if defined $args{'Section'};
 925
 926     if ( defined $args{'Overridable'} ) {
 927         @res
 928             = grep( ( $META{$_}->{'Overridable'} || 0 ) == $args{'Overridable'},
 929             @res );
 930     }
 931
 932     if ( $args{'Sorted'} ) {
 933         @res = sort {
 934             ($META{$a}->{SortOrder}||9999) <=> ($META{$b}->{SortOrder}||9999)
 935             || $a cmp $b
 936         } @res;
 937     } else {
 938         @res = sort { $a cmp $b } @res;
 939     }
 940     return @res;
 941 }
 942
 943 eval "require RT::Config_Vendor";
 944 if ($@ && $@ !~ qr{^Can't locate RT/Config_Vendor.pm}) {
 945     die $@;
 946 };
 947
 948 eval "require RT::Config_Local";
 949 if ($@ && $@ !~ qr{^Can't locate RT/Config_Local.pm}) {
 950     die $@;
 951 };
 952
 953 1;