#!/usr/bin/perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2026 Best Practical Solutions, LLC
#                                          <sales@bestpractical.com>
#
# (Except where explicitly superseded by other copyright notices)
#
#
# LICENSE:
#
# This work is made available to you under the terms of Version 2 of
# the GNU General Public License. A copy of that license should have
# been provided with this software, but in any event can be snarfed
# from www.gnu.org.
#
# This work is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
# 02110-1301 or visit their web page on the internet at
# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
#
#
# CONTRIBUTION SUBMISSION POLICY:
#
# (The following paragraph is not intended to limit the rights granted
# to you to modify and distribute this software under the terms of
# the GNU General Public License and is only of importance to you if
# you choose to contribute your changes and enhancements to the
# community by submitting them to Best Practical Solutions, LLC.)
#
# By intentionally submitting any modifications, corrections or
# derivatives to this work, or any other work intended for use with
# Request Tracker, to Best Practical Solutions, LLC, you confirm that
# you are the copyright holder for those contributions and you grant
# Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
# royalty-free, perpetual, license to use, copy, create derivative
# works based on those contributions, and sublicense and distribute
# those contributions and any derivatives thereof.
#
# END BPS TAGGED BLOCK }}}
use strict;
use warnings;

# fix lib paths, some may be relative
BEGIN {
    require File::Spec;
    my @libs = ( "/usr/local/libdata/perl5/site_perl", "/usr/local/libdata/perl5/site_perl" );
    my $bin_path;

    for my $lib (@libs) {
        unless ( File::Spec->file_name_is_absolute($lib) ) {
            unless ($bin_path) {
                if ( File::Spec->file_name_is_absolute(__FILE__) ) {
                    $bin_path = ( File::Spec->splitpath(__FILE__) )[1];
                }
                else {
                    require FindBin;
                    no warnings "once";
                    $bin_path = $FindBin::Bin;
                }
            }
            $lib = File::Spec->catfile( $bin_path, File::Spec->updir, $lib );
        }
        unshift @INC, $lib;
    }

}

use RT::Interface::CLI qw/Init loc/;
use 5.26.3;
use Encode;

my %opt = ();
Init( \%opt, 'value=s', 'format=s' );

my $action      = shift @ARGV or RT::Interface::CLI->ShowHelp( Message => loc('Missing action.'), ExitValue => 1 );
my $config_name = shift @ARGV
    or RT::Interface::CLI->ShowHelp( Message => loc('Missing configuration name.'), ExitValue => 1 );

if ( $action eq 'show' ) {
    no warnings 'once';
    unless ( $RT::Config::META{$config_name} ) {
        say STDERR encode( 'UTF-8', loc( "No such configuration option: [_1]", $config_name ) );
        exit 1;
    }

    my $format = lc( $opt{format} || 'perl' );
    if ( $format ne 'perl' && $format ne 'json' ) {
        say STDERR encode( 'UTF-8', loc( "Invalid format [_1]. Valid formats are: perl, json.", $format ) );
        exit 1;
    }

    my $value = RT->Config->Get($config_name);
    if ( ref $value ) {
        if ( $format eq 'json' ) {
            eval { print encode( 'UTF-8', json($value) ) };    # json output has newline already
            if ($@) {
                say STDERR encode( 'UTF-8',
                    loc( "[_1] can not be formatted as json, switching to perl", $config_name ) );
            }
            else {
                exit 0;
            }
        }

        no warnings 'once';
        require Data::Dumper;
        local $Data::Dumper::Terse    = 1;
        local $Data::Dumper::Indent   = 2;
        local $Data::Dumper::Sortkeys = 1;
        local $Data::Dumper::Deparse  = 1;
        print Data::Dumper::Dumper($value);    # Dumper output has newline already.
    }
    elsif ( defined $value ) {
        say encode( 'UTF-8', $value );
    }
    else {
        say encode( 'UTF-8', loc('Not defined') );
    }
}
elsif ( $action eq 'edit' ) {
    no warnings 'once';
    if ( my $meta = $RT::Config::META{$config_name} ) {
        if ( $meta->{Immutable} || $meta->{Obfuscate} ) {
            say STDERR encode( 'UTF-8', loc( "[_1] can be modified only in config file.", $config_name ) );
            exit 1;
        }
        else {
            my $type  = $meta->{Type} || 'SCALAR';
            my $value = $opt{value};
            if ( defined $value ) {
                $value = decode( 'UTF-8', $value );
                if ( $type ne 'SCALAR' ) {
                    require JSON;
                    eval { $value = JSON::from_json($value) };
                    if ( my $error = $@ ) {
                        say STDERR encode( 'UTF-8', loc( "Invalid JSON for [_1]: [_2]", $config_name, $error ) );
                        exit 1;
                    }
                }
            }
            else {
                my $old_value = RT->Config->Get($config_name);
                my $text = ref $old_value ? json($old_value) : $old_value;
                while (1) {
                    chomp( $value = edit($text) );
                    if ( $type ne 'SCALAR' ) {
                        require JSON;
                        eval { $value = JSON::from_json($value) };
                        if ( my $error = $@ ) {
                            say STDERR encode( 'UTF-8', loc( "Invalid JSON for [_1]: [_2]", $config_name, $error ) );
                            print STDERR encode( 'UTF-8', loc("Press Enter to re-edit, or Ctrl-C to cancel:") . ' ' );
                            <STDIN>;
                            $text = $value;
                            next;
                        }
                    }
                    last;
                }
            }

            my $old_value = RT->Config->Get($config_name);
            my $old_str   = ref $old_value ? RT::Configuration->_SerializeContent($old_value) : $old_value;
            my $new_str   = ref $value     ? RT::Configuration->_SerializeContent($value)     : $value;
            if ( ( $old_str // '' ) eq ( $new_str // '' ) ) {
                say encode( 'UTF-8', loc('Nothing changed.') );
                exit 0;
            }

            my $config = RT::Configuration->new( RT->SystemUser );
            $config->LoadByCols( Name => $config_name, Disabled => 0 );
            my ( $ret, $msg );
            if ( $config->Id ) {
                ( $ret, $msg ) = $config->SetContent($value);
            }
            else {
                ( $ret, $msg ) = $config->Create(
                    Name    => $config_name,
                    Content => $value,
                );
            }

            if ($ret) {
                say encode( 'UTF-8', $msg );
            }
            else {
                say STDERR encode( 'UTF-8', $msg );
                exit 1;
            }
        }
    }
    else {
        say STDERR encode( 'UTF-8', loc( 'No metadata found for [_1].', $config_name ) );
        exit 1;
    }
}
elsif ( $action eq 'reset' ) {
    my $config = RT::Configuration->new( RT->SystemUser );
    $config->LoadByCols( Name => $config_name, Disabled => 0 );
    if ( $config->Id ) {
        my ( $ret, $msg ) = $config->Delete;
        if ($ret) {
            say encode( 'UTF-8', $msg );
        }
        else {
            say STDERR encode( 'UTF-8', $msg );
            exit 1;
        }
    }
    else {
        say STDERR encode( 'UTF-8', loc( '[_1] is not set in database.', $config_name ) );
        exit 1;
    }
}
else {
    RT::Interface::CLI->ShowHelp( Message => loc( 'Invalid action [_1].', $action ), ExitValue => 1 );
}

sub json {
    my $value = shift;
    require JSON;
    state $JSON = JSON->new->pretty->canonical;
    return $JSON->encode($value);
}

sub edit {
    my ($text) = @_;
    my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";

    local $/ = undef;

    require File::Temp;
    my $handle = File::Temp->new;
    binmode $handle, ':encoding(UTF-8)';
    print $handle $text;
    close($handle);

    system( $editor, $handle->filename ) && die "Couldn't run $editor.\n";

    open( $handle, '<:encoding(UTF-8)', $handle->filename ) or die "$handle: $!\n";
    $text = <$handle>;
    close($handle);

    return $text;
}

__END__

=head1 NAME

rt-config - Manage RT configurations

=head1 SYNOPSIS

    rt-config show DefaultQueue
    rt-config show PriorityAsString
    rt-config show PriorityAsString --format perl
    rt-config show PriorityAsString --format json

    # Update configs in Database
    rt-config edit DefaultQueue     # Invoke default editor to set the new value
    rt-config edit PriorityAsString --value '{"Default": {"High": 100, "Low": 0, "Medium": 50}}'

    # Revert config changes to the file version
    rt-config reset DefaultQueue
    rt-config reset PriorityAsString

=head1 DESCRIPTION

RT stores configuration in two layers: config files (F<RT_SiteConfig.pm>
and related files) and the database. Database-stored values override
file-based values and can be changed at runtime without restarting the
server.

B<rt-config> lets you view, edit, and reset database-stored configuration
from the command line.

=over

=item B<show>

Display the effective value of a configuration option, whether it comes
from a config file or the database.

=item B<edit>

Set a configuration option in the database. If C<--value> is not
provided, your default editor is opened with the current value.
Only options that are not marked as immutable or obfuscated can be
edited.

=item B<reset>

Remove a database-stored override so the config file value takes effect
again.

=back

=head1 OPTIONS

=over

=item B<--value>

For C<edit> only, you can specify the new value using this option.
Reference values must be encoded as C<json>.

=item B<--format>

For C<show> only. This is used to format reference values. Available options
are C<perl> and C<json>. By default, it prefers C<perl> and also falls back
to C<perl> when C<json> is not applicable.

=back

=cut
