view release on metacpan or  search on metacpan

script/rt  view on Meta::CPAN

#
# 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 }}}
# Designed and implemented for Best Practical Solutions, LLC by
# Abhijit Menon-Sen <ams@wiw.org>

use strict;
use warnings;

if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
    require Pod::Usage;
    print Pod::Usage::pod2usage( { verbose => 2 } );
    exit;
}

# This program is intentionally written to have as few non-core module
# dependencies as possible. It should stay that way.

use Cwd;
use LWP;
use Text::ParseWords;
use HTTP::Request::Common;
use HTTP::Headers;
use Term::ReadLine;
use Time::Local; # used in prettyshow
use File::Temp;

# We derive configuration information from hardwired defaults, dotfiles,
# and the RT* environment variables (in increasing order of precedence).
# Session information is stored in ~/.rt_sessions.

my $VERSION = 0.02;
my $HOME = eval{(getpwuid($<))[7]}
           || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH}
           || ".";
my %config = (
    (
        debug        => 0,
        user         => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
        passwd       => undef,
        server       => 'http://localhost/',
        query        => "Status!='resolved' and Status!='rejected'",
        orderby      => 'id',
        queue        => undef,
# to protect against unlimited searches a better choice would be
#       queue        => 'Unknown_Queue',
        auth         => "rt",
    ),
    config_from_file($ENV{RTCONFIG} || ".rtrc"),
    config_from_env()
);

$config{auth} = "basic" if delete $config{externalauth};

my $session = Session->new("$HOME/.rt_sessions");
my $REST = "$config{server}/REST/1.0";

my $prompt = 'rt> ';

sub whine;
sub DEBUG { warn @_ if $config{debug} >= shift }

# These regexes are used by command handlers to parse arguments.
# (XXX: Ask Autrijus how i18n changes these definitions.)

my $name    = '[\w.-]+';
my $CF_name = '[^,]+?';
my $field   = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
my $label   = '[^,\\/]+';
my $labels  = "(?:$label,)*$label";
my $idlist  = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';

# Our command line looks like this:
#
#     rt <action> [options] [arguments]
#
# We'll parse just enough of it to decide upon an action to perform, and
# leave the rest to per-action handlers to interpret appropriately.

my %handlers = (
#   handler     => [ ...aliases... ],
    version     => ["version", "ver"],
    shell       => ["shell"],
    logout      => ["logout"],
    help        => ["help", "man"],
    show        => ["show", "cat"],
    edit        => ["create", "edit", "new", "ed"],
    list        => ["search", "list", "ls"],
    comment     => ["comment", "correspond"],
    link        => ["link", "ln"],
    merge       => ["merge"],
    grant       => ["grant", "revoke"],
    take        => ["take", "steal", "untake"],
    quit        => ["quit", "exit"],
    setcommand  => ["del", "delete", "give", "res", "resolve",
                    "subject"],
);

my %actions;