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