File Coverage

script/rt

Criterion	Covered	Total	%
statement	192	937	20.4
branch	68	594	11.4
condition	34	272	12.5
subroutine	21	58	36.2
pod			n/a
total	315	1861	16.9

#!/usr/bin/env perl
# BEGIN BPS TAGGED BLOCK {{{
#
# COPYRIGHT:
#
# This software is Copyright (c) 1996-2025 Best Practical Solutions, LLC
#
#
# (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 }}}
# Designed and implemented for Best Practical Solutions, LLC by
# Abhijit Menon-Sen

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  [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;
foreach my $fn (keys %handlers) {
    foreach my $alias (@{ $handlers{$fn} }) {
        $actions{$alias} = \&{"$fn"};
    }
}

# Once we find and call an appropriate handler, we're done.

sub handler {
    my $action;

    push @ARGV, 'shell' if (!@ARGV);    # default to shell mode
    shift @ARGV if ($ARGV[0] eq 'rt');    # ignore a leading 'rt'
    if (@ARGV && exists $actions{$ARGV[0]}) {
        $action = shift @ARGV;
        return $actions{$action}->($action);
    }
    else {
        print STDERR "rt: Unknown command '@ARGV'.\n";
        print STDERR "rt: For help, run 'rt help'.\n";
        return 1;
    }
}

exit handler();

# Handler functions.
# ------------------
#
# The following subs are handlers for each entry in %actions.

sub shell {
    $|=1;
    my $term = Term::ReadLine->new('RT CLI');
    while ( defined ($_ = $term->readline($prompt)) ) {
        next if /^#/ || /^\s*$/;

        @ARGV = shellwords($_);
        handler();
    }
}

sub version {
    print "rt $VERSION\n";
    return 0;
}

sub logout {
    submit("$REST/logout") if defined $session->cookie;
    return 0;
}

sub quit {
    logout();
    exit;
}

my %help;
sub help {
    my ($action, $type, $rv) = @_;
    $rv = defined $rv ? $rv : 0;
    my $key;

    # What help topics do we know about?
    if (!%help) {
        local $/ = undef;
        foreach my $item (@{ Form::parse() }) {
            my $title = $item->[2]{Title};
            my @titles = ref $title eq 'ARRAY' ? @$title : $title;

            foreach $title (grep $_, @titles) {
                $help{$title} = $item->[2]{Text};
            }
        }
    }

    # What does the user want help with?
    undef $action if ($action && $actions{$action} eq \&help);
    unless ($action || $type) {
        # If we don't know, we'll look for clues in @ARGV.
        foreach (@ARGV) {
            if (exists $help{$_}) { $key = $_; last; }
        }
        unless ($key) {
            # Tolerate possibly plural words.
            foreach (@ARGV) {
                if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; }
            }
        }
    }

    if ($type && $action) {
        $key = "$type.$action";
    }
    $key ||= $type || $action || "introduction";

    # Find a suitable topic to display.
    while (!exists $help{$key}) {
        if ($type && $action) {
            if ($key eq "$type.$action") { $key = $action;        }
            elsif ($key eq $action)      { $key = $type;          }
            else                         { $key = "introduction"; }
        }
        else {
            $key = "introduction";
        }
    }

    print STDERR $help{$key}, "\n\n";
    return $rv;
}

# Displays a list of objects that match some specified condition.

sub list {
    my ($q, $type, %data);
    my $orderby = $config{orderby};

    if ($config{orderby}) {
         $data{orderby} = $config{orderby};
    }
    my $bad = 0;
    my $rawprint = 0;
    my $reverse_sort = 0;
    my $queue = $config{queue};

    while (@ARGV) {
        $_ = shift @ARGV;

        if (/^-t$/) {
            $bad = 1, last unless defined($type = get_type_argument());
        }
        elsif (/^-S$/) {
            $bad = 1, last unless get_var_argument(\%data);
        }
        elsif (/^-o$/) {
            $data{'orderby'} = shift @ARGV;
        }
        elsif (/^-([isl])$/) {
            $data{format} = $1;
            $rawprint = 1;
        }
        elsif (/^-q$/) {
            $queue = shift @ARGV;
        }
        elsif (/^-r$/) {
            $reverse_sort = 1;
        }
        elsif (/^-f$/) {
            if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
                whine "No valid field list in '-f $ARGV[0]'.";
                $bad = 1; last;
            }
            $data{fields} = shift @ARGV;
            $data{format} = 's' if ! $data{format};
            $rawprint = 1;
        }
        elsif (!defined $q && !/^-/) {
            $q = $_;
        }
        else {
            my $datum = /^-/ ? "option" : "argument";
            whine "Unrecognised $datum '$_'.";
            $bad = 1; last;
        }
    }
    if ( ! $rawprint and ! exists $data{format} ) {
        $data{format} = 'l';
        $data{fields} = 'subject,status,queue,created,told,owner,requestors';
    }
    if ( $reverse_sort and $data{orderby} =~ /^-/ ) {
        $data{orderby} =~ s/^-/+/;
    } elsif ($reverse_sort) {
        $data{orderby} =~ s/^\+?(.*)/-$1/;
    }

    $type ||= "ticket";

    if (!defined $q ) {
        if ( $type eq 'ticket' ) {
            $q = $config{query};
        }
        else {
            $q = '';
        }
    }

    if ( $type ne 'ticket' ) {
        $rawprint = 1;
    }

    unless (defined $q) {
        my $item = $type ? "query string" : "object type";
        whine "No $item specified.";
        $bad = 1;
    }

    $q =~ s/^#//; # get rid of leading hash
    if ( $type eq 'ticket' ) {
        if ( $q =~ /^\d+$/ ) {

            # only digits, must be an id, formulate a correct query
            $q = "id=$q" if $q =~ /^\d+$/;
        }
        else {

          # a string only, take it as an owner or requestor (quoting done later)
            $q = "(Owner=$q or Requestor like $q) and $config{query}"
              if $q =~ /^[\w\-]+$/;

           # always add a query for a specific queue or (comma separated) queues
            $queue =~ s/,/ or Queue=/g if $queue;
            $q .= " and (Queue=$queue)"
              if $queue
                  and $q
                  and $q !~ /Queue\s*=/i
                  and $q !~ /id\s*=/i;
        }

        # correctly quote strings in a query
        $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g;
    }

    #return help("list", $type) if $bad;
    return suggest_help("list", $type, $bad) if $bad;

    print "Query:$q\n" if ! $rawprint;
    my $r = submit("$REST/search/$type", { query => $q, %data });
    if ( $rawprint ) {
        print $r->content;
    } else {
        my $forms = Form::parse($r->content);
        prettylist ($forms);
    }
    return 0;
}

# Displays selected information about a single object.

sub show {
    my ($type, @objects, %data);
    my $slurped = 0;
    my $bad = 0;
    my $rawprint = 0;
    my $histspec;

    while (@ARGV) {
        $_ = shift @ARGV;
        s/^#// if /^#\d+/; # get rid of leading hash
        if (/^-t$/) {
            $bad = 1, last unless defined($type = get_type_argument());
        }
        elsif (/^-S$/) {
            $bad = 1, last unless get_var_argument(\%data);
        }
        elsif (/^-([isl])$/) {
            $data{format} = $1;
            $rawprint = 1;
        }
        elsif (/^-$/ && !$slurped) {
            chomp(my @lines = );
            foreach (@lines) {
                unless (is_object_spec($_, $type)) {
                    whine "Invalid object on STDIN: '$_'.";
                    $bad = 1; last;
                }
                push @objects, $_;
            }
            $slurped = 1;
        }
        elsif (/^-f$/) {
            if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
                whine "No valid field list in '-f $ARGV[0]'.";
                $bad = 1; last;
            }
            $data{fields} = shift @ARGV;
            # option f requires short raw listing format
            $data{format} = 's';
            $rawprint = 1;
        }
        elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
            push @objects, $spc2;
            $histspec = is_object_spec("ticket/$_/history", $type);
        }
        elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) {
            push @objects, $spc3;
            $rawprint = 1 if $_ =~ /\/content$/;
        }
        elsif (my $spec = is_object_spec($_, $type)) {
            push @objects, $spec;
            $rawprint = 1 if $_ =~ /\/content$/ or $_ =~ /\/links/ or $_ !~ /^ticket/;
        }
        else {
            my $datum = /^-/ ? "option" : "argument";
            whine "Unrecognised $datum '$_'.";
            $bad = 1; last;
        }
    }
    if ( ! $rawprint ) {
        push @objects, $histspec if $histspec;
        $data{format} = 'l' if ! exists $data{format};
    }

    unless (@objects) {
        whine "No objects specified.";
        $bad = 1;
    }
    #return help("show", $type) if $bad;
    return suggest_help("show", $type, $bad) if $bad;

    my $r = submit("$REST/show", { id => \@objects, %data });
    my $c = $r->content;
    # if this isn't a text reply, remove the trailing newline so we
    # don't corrupt things like tarballs when people do
    # show ticket/id/attachments/id/content > foo.tar.gz
    if ($r->content_type !~ /^text\//) {
        chomp($c);
        $rawprint = 1;
    }
    if ( $rawprint ) {
        print $c;
    } else {
        # I do not know how to get more than one form correctly returned
        $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg;
        my $forms = Form::parse($c);
        prettyshow ($forms);
    }
    return 0;
}

# To create a new object, we ask the server for a form with the defaults
# filled in, allow the user to edit it, and send the form back.
#
# To edit an object, we must ask the server for a form representing that
# object, make changes requested by the user (either on the command line
# or interactively via $EDITOR), and send the form back.

sub edit {
    my ($action) = @_;
    my (%data, $type, @objects);
    my ($cl, $text, $edit, $input, $output, $content_type);

    use vars qw(%set %add %del);
    %set = %add = %del = ();
    my $slurped = 0;
    my $bad = 0;

    while (@ARGV) {
        $_ = shift @ARGV;
        s/^#// if /^#\d+/; # get rid of leading hash

        if    (/^-e$/) { $edit = 1 }
        elsif (/^-i$/) { $input = 1 }
        elsif (/^-o$/) { $output = 1 }
        elsif (/^-ct$/) { $content_type = shift @ARGV }
        elsif (/^-t$/) {
            $bad = 1, last unless defined($type = get_type_argument());
        }
        elsif (/^-S$/) {
            $bad = 1, last unless get_var_argument(\%data);
        }
        elsif (/^-$/ && !($slurped || $input)) {
            chomp(my @lines = );
            foreach (@lines) {
                unless (is_object_spec($_, $type)) {
                    whine "Invalid object on STDIN: '$_'.";
                    $bad = 1; last;
                }
                push @objects, $_;
            }
            $slurped = 1;
        }
        elsif (/^set$/i) {
            my $vars = 0;

            while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) {
                my ($key, $op, $val) = ($1, $2, $3);
                my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;

                vpush($hash, lc $key, $val);
                shift @ARGV;
                $vars++;
            }
            unless ($vars) {
                whine "No variables to set.";
                $bad = 1; last;
            }
            $cl = $vars;
        }
        elsif (/^(?:add|del)$/i) {
            my $vars = 0;
            my $hash = ($_ eq "add") ? \%add : \%del;

            while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) {
                my ($key, $val) = ($1, $2);

                vpush($hash, lc $key, $val);
                shift @ARGV;
                $vars++;
            }
            unless ($vars) {
                whine "No variables to set.";
                $bad = 1; last;
            }
            $cl = $vars;
        }
        elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
            push @objects, $spc2;
        }
        elsif (my $spec = is_object_spec($_, $type)) {
            push @objects, $spec;
        }
        else {
            my $datum = /^-/ ? "option" : "argument";
            whine "Unrecognised $datum '$_'.";
            $bad = 1; last;
        }
    }

    if ($action =~ /^ed(?:it)?$/) {
        unless (@objects) {
            whine "No objects specified.";
            $bad = 1;
        }
    }
    else {
        if (@objects) {
            whine "You shouldn't specify objects as arguments to $action.";
            $bad = 1;
        }
        unless ($type) {
            whine "What type of object do you want to create?";
            $bad = 1;
        }
        @objects = ("$type/new") if defined($type);
    }
    #return help($action, $type) if $bad;
    return suggest_help($action, $type, $bad) if $bad;

    # We need a form to make changes to. We usually ask the server for
    # one, but we can avoid that if we are fed one on STDIN, or if the
    # user doesn't want to edit the form by hand, and the command line
    # specifies only simple variable assignments.  We *should* get a
    # form if we're creating a new ticket, so that the default values
    # get filled in properly.

    my @new_objects = grep /\/new$/, @objects;

    if ($input) {
        local $/ = undef;
        $text = ;
    }
    elsif ($edit || %add || %del || !$cl || @new_objects) {
        my $r = submit("$REST/show", { id => \@objects, format => 'l' });
        $text = $r->content;
    }

    # If any changes were specified on the command line, apply them.
    if ($cl) {
        if ($text) {
            # We're updating forms from the server.
            my $forms = Form::parse($text);

            foreach my $form (@$forms) {
                my ($c, $o, $k, $e) = @$form;
                my ($key, $val);

                next if ($e || !@$o);

                local %add = %add;
                local %del = %del;
                local %set = %set;

                # Make changes to existing fields.
                foreach $key (@$o) {
                    if (exists $add{lc $key}) {
                        $val = delete $add{lc $key};
                        vpush($k, $key, $val);
                        $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/;
                    }
                    if (exists $del{lc $key}) {
                        $val = delete $del{lc $key};
                        my %val = map {$_=>1} @{ vsplit($val) };
                        $k->{$key} = vsplit($k->{$key});
                        @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}};
                    }
                    if (exists $set{lc $key}) {
                        $k->{$key} = delete $set{lc $key};
                    }
                }

                # Then update the others.
                foreach $key (keys %set) { vpush($k, $key, $set{$key}) }
                foreach $key (keys %add) {
                    vpush($k, $key, $add{$key});
                    $k->{$key} = vsplit($k->{$key});
                }
                push @$o, (keys %add, keys %set);
            }

            $text = Form::compose($forms);
        }
        else {
            # We're rolling our own set of forms.
            my @forms;
            foreach (@objects) {
                my ($type, $ids, $args) =
                    m{^($name)/($idlist|$labels)(?:(/.*))?$}o;

                $args ||= "";
                foreach my $obj (expand_list($ids)) {
                    my %set = (%set, id => "$type/$obj$args");
                    push @forms, ["", [keys %set], \%set];
                }
            }
            $text = Form::compose(\@forms);
        }
    }

    if ($output) {
        print $text;
        return 0;
    }

    my @files;
    @files = @{ vsplit($set{'attachment'}) } if exists $set{'attachment'};

    my $synerr = 0;

EDIT:
    # We'll let the user edit the form before sending it to the server,
    # unless we have enough information to submit it non-interactively.
    if ( $type && $type eq 'ticket' && $text !~ /^Content-Type:/m ) {
        $text .= "Content-Type: $content_type\n"
            if $content_type and $content_type ne "text/plain";
    }

    if ($edit || (!$input && !$cl)) {
        my ($newtext) = vi_form_while(
            $text,
            sub {
                my ($text, $form) = @_;
                return 1 unless exists $form->[2]{'Attachment'};

                foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
                    return (0, "File '$f' doesn't exist") unless -f $f;
                }
                @files = @{ vsplit($form->[2]{'Attachment'}) };
                return 1;
            },
        );
        return $newtext unless $newtext;
        # We won't resubmit a bad form unless it was changed.
        $text = ($synerr && $newtext eq $text) ? undef : $newtext;
    }

    delete @data{ grep /^attachment_\d+$/, keys %data };
    my $i = 1;
    foreach my $file (@files) {
        $data{"attachment_$i"} = bless([ $file ], "Attachment");
        $i++;
    }

    if ($text) {
        my $r = submit("$REST/edit", {content => $text, %data});
        if ($r->code == 409) {
            # If we submitted a bad form, we'll give the user a chance
            # to correct it and resubmit.
            if ($edit || (!$input && !$cl)) {
                my $content = $r->content . "\n";
                $content =~ s/^(?!#)/#     /mg;
                $text = $content . $text;
                $synerr = 1;
                goto EDIT;
            }
            else {
                print $r->content;
                return 0;
            }
        }
        print $r->content;
    }
    return 0;
}

# handler for special edit commands. A valid edit command is constructed and
# further work is delegated to the edit handler

sub setcommand {
    my ($action) = @_;
    my ($id, $bad, $what);
    if ( @ARGV ) {
        $_ = shift @ARGV;
        $id = $1 if (m|^(?:ticket/)?($idlist)$|);
    }
    if ( ! $id ) {
        $bad = 1;
        whine "No ticket number specified.";
    }
    if ( @ARGV ) {
        if ($action eq 'subject') {
            my $subject = '"'.join (" ", @ARGV).'"';
            @ARGV = ();
            $what = "subject=$subject";
        } elsif ($action eq 'give') {
            my $owner = shift @ARGV;
            $what = "owner=$owner";
        }
    } else {
        if ( $action eq 'delete' or $action eq 'del' ) {
            $what = "status=deleted";
        } elsif ($action eq 'resolve' or $action eq 'res' ) {
            $what = "status=resolved";
        } elsif ($action eq 'take' ) {
            $what = "owner=$config{user}";
        } elsif ($action eq 'untake') {
            $what = "owner=Nobody";
        }
    }
    if (@ARGV) {
        $bad = 1;
        whine "Extraneous arguments for action $action: @ARGV.";
    }
    if ( ! $what ) {
        $bad = 1;
        whine "unrecognized action $action.";
    }
    return help("edit", undef, $bad) if $bad;
    @ARGV = ( $id, "set", $what );
    print "Executing: rt edit @ARGV\n";
    return edit("edit");
}

# We roll "comment" and "correspond" into the same handler.

sub comment {
    my ($action) = @_;
    my (%data, $id, @files, @bcc, @cc, $msg, $content_type, $wtime, $edit);
    my $bad = 0;
    my $status = '';

    while (@ARGV) {
        $_ = shift @ARGV;

        if (/^-e$/) {
            $edit = 1;
        }
        elsif (/^-(?:[abcmws]|ct)$/) {
            unless (@ARGV) {
                whine "No argument specified with $_.";
                $bad = 1; last;
            }

            if (/-a/) {
                unless (-f $ARGV[0] && -r $ARGV[0]) {
                    whine "Cannot read attachment: '$ARGV[0]'.";
                    return 0;
                }
                push @files, shift @ARGV;
            }
            elsif (/-ct/) {
                $content_type = shift @ARGV;
            }
            elsif (/-s/) {
                $status = shift @ARGV;
            }
            elsif (/-([bc])/) {
                my $a = $_ eq "-b" ? \@bcc : \@cc;
                @$a = split /\s*,\s*/, shift @ARGV;
            }
            elsif (/-m/) {
                $msg = shift @ARGV;
                if ( $msg =~ /^-$/ ) {
                    undef $msg;
                    while () { $msg .= $_ }
                }
            }
            elsif (/-w/) { $wtime = shift @ARGV }
        }
        elsif (!$id && m|^(?:ticket/)?($idlist)$|) {
            $id = $1;
        }
        else {
            my $datum = /^-/ ? "option" : "argument";
            whine "Unrecognised $datum '$_'.";
            $bad = 1; last;
        }
    }

    unless ($id) {
        whine "No object specified.";
        $bad = 1;
    }
    #return help($action, "ticket") if $bad;
    return suggest_help($action, "ticket") if $bad;

    my $form = [
        "",
        [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Content-Type", "Text" ],
        {
            Ticket     => $id,
            Action     => $action,
            Cc         => [ @cc ],
            Bcc        => [ @bcc ],
            Attachment => [ @files ],
            TimeWorked => $wtime || '',
            'Content-Type' => $content_type || 'text/plain',
            Text       => $msg || '',
            Status => $status
        }
    ];
    if ($status ne '') {
      push(@{$form->[1]}, "Status");
    }

    my $text = Form::compose([ $form ]);

    if ($edit || !$msg) {
        my ($tmp) = vi_form_while(
            $text,
            sub {
                my ($text, $form) = @_;
                foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
                    return (0, "File '$f' doesn't exist") unless -f $f;
                }
                @files = @{ vsplit($form->[2]{'Attachment'}) };
                return 1;
            },
        );
        return $tmp unless $tmp;
        $text = $tmp;
    }

    my $i = 1;
    foreach my $file (@files) {
        $data{"attachment_$i"} = bless([ $file ], "Attachment");
        $i++;
    }
    $data{content} = $text;

    my $r = submit("$REST/ticket/$id/comment", \%data);
    print $r->content;
    return 0;
}

# Merge one ticket into another.

sub merge {
    my @id;
    my $bad = 0;

    while (@ARGV) {
        $_ = shift @ARGV;
        s/^#// if /^#\d+/; # get rid of leading hash

        if (/^\d+$/) {
            push @id, $_;
        }
        else {
            whine "Unrecognised argument: '$_'.";
            $bad = 1; last;
        }
    }

    unless (@id == 2) {
        my $evil = @id > 2 ? "many" : "few";
        whine "Too $evil arguments specified.";
        $bad = 1;
    }
    #return help("merge", "ticket") if $bad;
    return suggest_help("merge", "ticket", $bad) if $bad;

    my $r = submit("$REST/ticket/$id[0]/merge/$id[1]");
    print $r->content;
    return 0;
}

# Link one ticket to another.

sub link {
    my ($bad, $del, %data) = (0, 0, ());
    my $type;

    my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
                                        ReferredToBy HasMember MemberOf);

    while (@ARGV && $ARGV[0] =~ /^-/) {
        $_ = shift @ARGV;

        if (/^-d$/) {
            $del = 1;
        }
        elsif (/^-t$/) {
            $bad = 1, last unless defined($type = get_type_argument());
        }
        else {
            whine "Unrecognised option: '$_'.";
            $bad = 1; last;
        }
    }

    $type = "ticket" unless $type; # default type to tickets

    if (@ARGV == 3) {
        my ($from, $rel, $to) = @ARGV;
        if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
            whine "Invalid link '$rel' for type $type specified.";
            $bad = 1;
        }
        %data = (id => $from, rel => $rel, to => $to, del => $del);
    }
    else {
        my $bad = @ARGV < 3 ? "few" : "many";
        whine "Too $bad arguments specified.";
        $bad = 1;
    }
    return suggest_help("link", $type, $bad) if $bad;

    my $r = submit("$REST/$type/link", \%data);
    print $r->content;
    return 0;
}

# Take/steal a ticket
sub take {
    my ($cmd) = @_;
    my ($bad, %data) = (0, ());

    my $id;

    # get the ticket id
    if (@ARGV == 1) {
        ($id) = @ARGV;
        unless ($id =~ /^\d+$/) {
            whine "Invalid ticket ID $id specified.";
            $bad = 1;
        }
        my $form = [
            "",
            [ "Ticket", "Action" ],
            {
                Ticket => $id,
                Action => $cmd,
                Status => '',
            }
        ];

        my $text = Form::compose([ $form ]);
        $data{content} = $text;
    }
    else {
        $bad = @ARGV < 1 ? "few" : "many";
        whine "Too $bad arguments specified.";
        $bad = 1;
    }
    return suggest_help("take", "ticket", $bad) if $bad;

    my $r = submit("$REST/ticket/$id/take", \%data);
    print $r->content;
    return 0;
}

# Grant/revoke a user's rights.

sub grant {
    my ($cmd) = @_;

    whine "$cmd is unimplemented.";
    return 1;
}

# Client <-> Server communication.
# --------------------------------
#
# This function composes and sends an HTTP request to the RT server, and
# interprets the response. It takes a request URI, and optional request
# data (a string, or a reference to a set of key-value pairs).

sub submit {
    my ($uri, $content) = @_;
    my ($req, $data);
    my $ua = LWP::UserAgent->new(agent => "RT/3.0b", env_proxy => 1);
    my $h = HTTP::Headers->new;

    # Did the caller specify any data to send with the request?
    $data = [];
    if (defined $content) {
        unless (ref $content) {
            # If it's just a string, make sure LWP handles it properly.
            # (By pretending that it's a file!)
            $content = [ content => [undef, "", Content => $content] ];
        }
        elsif (ref $content eq 'HASH') {
            my @data;
            foreach my $k (keys %$content) {
                if (ref $content->{$k} eq 'ARRAY') {
                    foreach my $v (@{ $content->{$k} }) {
                        push @data, $k, $v;
                    }
                }
                else { push @data, $k, $content->{$k} }
            }
            $content = \@data;
        }
        $data = $content;
    }

    # Should we send authentication information to start a new session?
    my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted';
    my($server) = $config{server} =~ m{^.*//([^/]+)};

    if ($config{auth} eq "gssapi") {
        die "GSSAPI support not available; failed to load perl module GSSAPI:\n$@\n"
            unless eval { require GSSAPI; 1 };
        die "GSSAPI support not available; failed to load perl module LWP::Authen::Negotiate:\n$@\n"
            unless eval { require LWP::Authen::Negotiate; 1 };
    } elsif ($config{auth} eq "basic") {
        print "   Password will be sent to $server $how\n",
              "   Press CTRL-C now if you do not want to continue\n"
            if ! $config{passwd};
        $h->authorization_basic($config{user}, $config{passwd} || read_passwd() );
    } elsif ( !defined $session->cookie ) {
        print "   Password will be sent to $server $how\n",
              "   Press CTRL-C now if you do not want to continue\n"
            if ! $config{passwd};
        push @$data, ( user => $config{user} );
        push @$data, ( pass => $config{passwd} || read_passwd() );
    }

    # Now, we construct the request.
    if (@$data) {
        $req = POST($uri, $data, Content_Type => 'form-data');
    }
    else {
        $req = GET($uri);
    }
    $session->add_cookie_header($req);
    $req->header(%$h) if %$h;

    # Then we send the request and parse the response.
    DEBUG(3, $req->as_string);
    my $res = $ua->request($req);
    DEBUG(3, $res->as_string);

    if ($res->is_success) {
        # The content of the response we get from the RT server consists
        # of an HTTP-like status line followed by optional header lines,
        # a blank line, and arbitrary text.

        my ($head, $text) = split /\n\n/, $res->content, 2;
        my ($status, @headers) = split /\n/, $head;
        $text =~ s/\n*$/\n/ if ($text);

        # "RT/3.0.1 401 Credentials required"
        if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
            warn "rt: Malformed RT response from $server.\n";
            warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3;
            exit -1;
        }

        # Our caller can pretend that the server returned a custom HTTP
        # response code and message. (Doing that directly is apparently
        # not sufficiently portable and uncomplicated.)
        $res->code($1);
        $res->message($2);
        $res->content($text);
        $session->update($res) if ($res->is_success || $res->code != 401);

        if (!$res->is_success) {
            # We can deal with authentication failures ourselves. Either
            # we sent invalid credentials, or our session has expired.
            if ($res->code == 401) {
                my %d = @$data;
                if (exists $d{user}) {
                    warn "rt: Incorrect username or password.\n";
                    exit -1;
                }
                elsif ($req->header("Cookie")) {
                    # We'll retry the request with credentials, unless
                    # we only wanted to logout in the first place.
                    $session->delete;
                    return submit(@_) unless $uri eq "$REST/logout";
                }
            }
            # Conflicts should be dealt with by the handler and user.
            # For anything else, we just die.
            elsif ($res->code != 409) {
                warn "rt: ", $res->content;
                #exit;
            }
        }
    }
    else {
        warn "rt: Server error: ", $res->message, " (", $res->code, ")\n";
        exit -1;
    }

    return $res;
}

# Session management.
# -------------------
#
# Maintains a list of active sessions in the ~/.rt_sessions file.
{
    package Session;
    my ($s, $u);

    # Initialises the session cache.
    sub new {
        my ($class, $file) = @_;
        my $self = {
            file => $file || "$HOME/.rt_sessions",
            sids => { }
        };

        # The current session is identified by the currently configured
        # server and user.
        ($s, $u) = @config{"server", "user"};

        bless $self, $class;
        $self->load();

        return $self;
    }

    # Returns the current session cookie.
    sub cookie {
        my ($self) = @_;
        my $cookie = $self->{sids}{$s}{$u};
        return defined $cookie ? "RT_SID_$cookie" : undef;
    }

    # Deletes the current session cookie.
    sub delete {
        my ($self) = @_;
        delete $self->{sids}{$s}{$u};
    }

    # Adds a Cookie header to an outgoing HTTP request.
    sub add_cookie_header {
        my ($self, $request) = @_;
        my $cookie = $self->cookie();

        $request->header(Cookie => $cookie) if defined $cookie;
    }

    # Extracts the Set-Cookie header from an HTTP response, and updates
    # session information accordingly.
    sub update {
        my ($self, $response) = @_;
        my $cookie = $response->header("Set-Cookie");

        if (defined $cookie && $cookie =~ /^RT_SID_(.[^;,\s]+=[0-9A-Fa-f]+);/) {
            $self->{sids}{$s}{$u} = $1;
        }
    }

    # Loads the session cache from the specified file.
    sub load {
        my ($self, $file) = @_;
        $file ||= $self->{file};

        open( my $handle, '<', $file ) or return 0;

        $self->{file} = $file;
        my $sids = $self->{sids} = {};
        while (<$handle>) {
            chomp;
            next if /^$/ || /^#/;
            next unless m#^(https?://[^ ]+) (.+) ([^;,\s]+=[0-9A-Fa-f]+)$#;
            my ($server, $user, $cookie) = ($1, $2, $3);
            $sids->{$server}{$user} = $cookie;
        }
        return 1;
    }

    # Writes the current session cache to the specified file.
    sub save {
        my ($self, $file) = shift;
        $file ||= $self->{file};

        open( my $handle, '>', "$file" ) or return 0;

        my $sids = $self->{sids};
        foreach my $server (keys %$sids) {
            foreach my $user (keys %{ $sids->{$server} }) {
                my $sid = $sids->{$server}{$user};
                if (defined $sid) {
                    print $handle "$server $user $sid\n";
                }
            }
        }
        close($handle);
        chmod 0600, $file;
        return 1;
    }

    sub DESTROY {
        my $self = shift;
        $self->save;
    }
}

# Form handling.
# --------------
#
# Forms are RFC822-style sets of (field, value) specifications with some
# initial comments and interspersed blank lines allowed for convenience.
# Sets of forms are separated by --\n (in a cheap parody of MIME).
#
# Each form is parsed into an array with four elements: commented text
# at the start of the form, an array with the order of keys, a hash with
# key/value pairs, and optional error text if the form syntax was wrong.

# Returns a reference to an array of parsed forms.
sub Form::parse {
    my $state = 0;
    my @forms = ();
    my @lines = split /\n/, $_[0] if $_[0];
    my ($c, $o, $k, $e) = ("", [], {}, "");

    LINE:
    while (@lines) {
        my $line = shift @lines;

        next LINE if $line eq '';

        if ($line eq '--') {
            # We reached the end of one form. We'll ignore it if it was
            # empty, and store it otherwise, errors and all.
            if ($e || $c || @$o) {
                push @forms, [ $c, $o, $k, $e ];
                $c = ""; $o = []; $k = {}; $e = "";
            }
            $state = 0;
        }
        elsif ($state != -1) {
            if ($state == 0 && $line =~ /^#/) {
                # Read an optional block of comments (only) at the start
                # of the form.
                $state = 1;
                $c = $line;
                while (@lines && $lines[0] =~ /^#/) {
                    $c .= "\n".shift @lines;
                }
                $c .= "\n";
            }
            elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) {
                # Read a field: value specification.
                my $f  = $1;
                my @v  = (defined $2 && length $2 ? $2 : ());

                # Read continuation lines, if any.
                while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) {
                    push @v, shift @lines;
                }
                pop @v while (@v && $v[-1] eq '');

                # Strip longest common leading indent from text.
                my $ws = "";
                foreach my $ls (map {/^(\s+)/} @v[1..$#v]) {
                    $ws = $ls if (!$ws || length($ls) < length($ws));
                }
                s/^$ws// foreach @v;

                push(@$o, $f) unless exists $k->{$f};
                vpush($k, $f, join("\n", @v));

                $state = 1;
            }
            elsif ($line !~ /^#/) {
                # We've found a syntax error, so we'll reconstruct the
                # form parsed thus far, and add an error marker. (>>)
                $state = -1;
                $e = Form::compose([[ "", $o, $k, "" ]]);
                $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n";
            }
        }
        else {
            # We saw a syntax error earlier, so we'll accumulate the
            # contents of this form until the end.
            $e .= "$line\n";
        }
    }
    push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o);

    foreach my $l (keys %$k) {
        $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY');
    }

    return \@forms;
}

# Returns text representing a set of forms.
sub Form::compose {
    my ($forms) = @_;
    my @text;

    foreach my $form (@$forms) {
        my ($c, $o, $k, $e) = @$form;
        my $text = "";

        if ($c) {
            $c =~ s/\n*$/\n/;
            $text = "$c\n";
        }
        if ($e) {
            $text .= $e;
        }
        elsif ($o) {
            my @lines;

            foreach my $key (@$o) {
                my ($line, $sp);
                my $v = $k->{$key};
                my @values = ref $v eq 'ARRAY' ? @$v : $v;

                $sp = " "x(length("$key: "));
                $sp = " "x4 if length($sp) > 16;

                foreach $v (@values) {
                    if ($v =~ /\n/) {
                        $v =~ s/^/$sp/gm;
                        $v =~ s/^$sp//;

                        if ($line) {
                            push @lines, "$line\n\n";
                            $line = "";
                        }
                        elsif (@lines && $lines[-1] !~ /\n\n$/) {
                            $lines[-1] .= "\n";
                        }
                        push @lines, "$key: $v\n\n";
                    }
                    elsif ($line &&
                           length($line)+length($v)-rindex($line, "\n") >= 70)
                    {
                        $line .= ",\n$sp$v";
                    }
                    else {
                        $line = $line ? "$line,$v" : "$key: $v";
                    }
                }

                $line = "$key:" unless @values;
                if ($line) {
                    if ($line =~ /\n/) {
                        if (@lines && $lines[-1] !~ /\n\n$/) {
                            $lines[-1] .= "\n";
                        }
                        $line .= "\n";
                    }
                    push @lines, "$line\n";
                }
            }

            $text .= join "", @lines;
        }
        else {
            chomp $text;
        }
        push @text, $text;
    }

    return join "\n--\n\n", @text;
}

# Configuration.
# --------------

# Returns configuration information from the environment.
sub config_from_env {
    my %env;

    foreach my $k (qw(EXTERNALAUTH AUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) {

        if (exists $ENV{"RT$k"}) {
            $env{lc $k} = $ENV{"RT$k"};
        }
    }

    return %env;
}

# Finds a suitable configuration file and returns information from it.
sub config_from_file {
    my ($rc) = @_;

    if ($rc =~ m#^/#) {
        # We'll use an absolute path if we were given one.
        return parse_config_file($rc);
    }
    else {
        # Otherwise we'll use the first file we can find in the current
        # directory, or in one of its (increasingly distant) ancestors.

        my @dirs = split /\//, cwd;
        while (@dirs) {
            my $file = join('/', @dirs, $rc);
            if (-r $file) {
                return parse_config_file($file);
            }

            # Remove the last directory component each time.
            pop @dirs;
        }

        # Still nothing? We'll fall back to some likely defaults.
        for ("$HOME/$rc", "/usr/local/etc/rt.conf", "/etc/rt.conf") {
            return parse_config_file($_) if (-r $_);
        }
    }

    return ();
}

# Makes a hash of the specified configuration file.
sub parse_config_file {
    my %cfg;
    my ($file) = @_;
    local $_; # $_ may be aliased to a constant, from line 1163

    open( my $handle, '<', $file ) or return;

    while (<$handle>) {
        chomp;
        next if (/^#/ || /^\s*$/);

        if (/^(externalauth|auth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
            $cfg{$1} = $2;
        }
        else {
            die "rt: $file:$.: unknown configuration directive.\n";
        }
    }

    return %cfg;
}

# Helper functions.
# -----------------

sub whine {
    my $sub = (caller(1))[3];
    $sub =~ s/^main:://;
    warn "rt: $sub: @_\n";
    return 0;
}

sub read_passwd {
    eval 'require Term::ReadKey';
    if ($@) {
        die "No password specified (and Term::ReadKey not installed).\n";
    }

    print "Password: ";
    Term::ReadKey::ReadMode('noecho');
    chomp(my $passwd = Term::ReadKey::ReadLine(0));
    Term::ReadKey::ReadMode('restore');
    print "\n";

    return $passwd;
}

sub vi_form_while {
    my $text = shift;
    my $cb = shift;

    my $error = 0;
    my ($c, $o, $k, $e);
    do {
        my $ntext = vi($text);
        return undef if ($error && $ntext eq $text);

        $text = $ntext;

        my $form = Form::parse($text);
        $error = 0;
        ($c, $o, $k, $e) = @{ $form->[0] };
        if ( $e ) {
            $error = 1;
            $c = "# Syntax error.";
            goto NEXT;
        }
        elsif (!@$o) {
            return 0;
        }

        my ($status, $msg) = $cb->( $text, [$c, $o, $k, $e] );
        unless ( $status ) {
            $error = 1;
            $c = "# $msg";
        }

    NEXT:
        $text = Form::compose([[$c, $o, $k, $e]]);
    } while ($error);

    return $text;
}

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

    local $/ = undef;

    my $handle = File::Temp->new;
    print $handle $text;
    close($handle);

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

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

    return $text;
}

# Add a value to a (possibly multi-valued) hash key.
sub vpush {
    my ($hash, $key, $val) = @_;
    my @val = ref $val eq 'ARRAY' ? @$val : $val;

    if (exists $hash->{$key}) {
        unless (ref $hash->{$key} eq 'ARRAY') {
            my @v = $hash->{$key} ne '' ? $hash->{$key} : ();
            $hash->{$key} = \@v;
        }
        push @{ $hash->{$key} }, @val;
    }
    else {
        $hash->{$key} = $val;
    }
}

# WARNING: this code is duplicated in lib/RT/Interface/REST.pm
# If you change one, change both functions at once
# "Normalise" a hash key that's known to be multi-valued.
sub vsplit {
    my ($val, $strip) = @_;
    my @words;
    my @values = map {split /\n/} (ref $val eq 'ARRAY' ? @$val : $val);

    foreach my $line (@values) {
        while ($line =~ /\S/) {
            $line =~ s/^
                       \s*   # Trim leading whitespace
                       (?:
                           (")   # Quoted string
                           ((?>[^\\"]*(?:\\.[^\\"]*)*))"
                       |
                           (')   # Single-quoted string
                           ((?>[^\\']*(?:\\.[^\\']*)*))'
                       |
                           q\{(.*?)\} # A perl-ish q{} string; this does
                                      # no paren balancing, however, and
                                      # only exists for back-compat
                       |
                           (.*?)     # Anything else, until the next comma
                       )
                       \s*   # Trim trailing whitespace
                       (?:
                           \Z  # Finish at end-of-line
                       |
                           ,   # Or a comma
                       )
                      //xs or last; # There should be no way this match
                                    # fails, but add a failsafe to
                                    # prevent infinite-looping if it
                                    # somehow does.
            my ($quote, $quoted) = ($1 ? ($1, $2) : $3 ? ($3, $4) : ('', $5 || $6));
            # Only unquote the quote character, or the backslash -- and
            # only if we were originally quoted..
            if ($5) {
                $quoted =~ s/([\\'])/\\$1/g;
                $quote = "'";
            }
            if ($strip) {
                $quoted =~ s/\\([\\$quote])/$1/g if $quote;
                push @words, $quoted;
            } else {
                push @words, "$quote$quoted$quote";
            }
        }
    }
    return \@words;
}

# WARN: this code is duplicated in lib/RT/Interface/REST.pm
# change both functions at once
sub expand_list {
    my ($list) = @_;

    my @elts;
    foreach (split /\s*,\s*/, $list) {
        push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
    }

    return map $_->[0], # schwartzian transform
        sort {
            defined $a->[1] && defined $b->[1]?
                # both numbers
                $a->[1] <=> $b->[1]
                :!defined $a->[1] && !defined $b->[1]?
                    # both letters
                    $a->[2] cmp $b->[2]
                    # mix, number must be first
                    :defined $a->[1]? -1: 1
        }
        map [ $_, (defined( /^(\d+)$/ )? $1: undef), lc($_) ],
        @elts;
}

sub get_type_argument {
    my $type;

    if (@ARGV) {
        $type = shift @ARGV;
        unless ($type =~ /^[A-Za-z0-9_.-]+$/) {
            # We want whine to mention our caller, not us.
            @_ = ("Invalid type '$type' specified.");
            goto &whine;
        }
    }
    else {
        @_ = ("No type argument specified with -t.");
        goto &whine;
    }

    $type =~ s/s$//; # "Plural". Ugh.
    return $type;
}

sub get_var_argument {
    my ($data) = @_;

    if (@ARGV) {
        my $kv = shift @ARGV;
        if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) {
            push @{ $data->{$k} }, $v;
        }
        else {
            @_ = ("Invalid variable specification: '$kv'.");
            goto &whine;
        }
    }
    else {
        @_ = ("No variable argument specified with -S.");
        goto &whine;
    }
}

sub is_object_spec {
    my ($spec, $type) = @_;

    $spec =~ s|^(?:$type/)?|$type/| if defined $type;
    return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
    return 0;
}

sub suggest_help {
    my ($action, $type, $rv) = @_;

    print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action;
    print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type;
    return $rv;
}

sub str2time {
    # simplified procedure for parsing date, avoid loading Date::Parse
    my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May =>  4, Jun =>  5,
                 Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11);
    $_ = shift;
    my ($mon, $day, $hr, $min, $sec, $yr, $monstr);
    if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) {
        ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6);
        $mon = $month{$monstr} if exists $month{$monstr};
    } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) {
        ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
    }
    if ( $yr and defined $mon and $day and defined $hr and defined $sec ) {
        return timelocal($sec,$min,$hr,$day,$mon,$yr);
    } else {
        print "Unknown date format in parsedate: $_\n";
        return undef;
    }
}

sub date_diff {
    my ($old, $new) = @_;
    $new = time() if ! $new;
    $old = str2time($old) if $old !~ /^\d+$/;
    $new = str2time($new) if $new !~ /^\d+$/;
    return "???" if ! $old or ! $new;

    my %seconds = (min => 60,
                   hr  => 60*60,
                   day => 60*60*24,
                   wk  => 60*60*24*7,
                   mth => 60*60*24*30,
                   yr  => 60*60*24*365);

    my $diff = $new - $old;
    my $what = 'sec';
    my $howmuch = $diff;
    for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) {
        last if $diff < $seconds{$_};
        $what = $_;
        $howmuch = int($diff/$seconds{$_});
    }
    return "$howmuch $what";
}

sub prettyshow {
    my $forms = shift;
    my ($form) = grep { exists $_->[2]->{Queue} } @$forms;
    my $k = $form->[2];
    # dates are in local time zone
    if ( $k ) {
        print "Date: $k->{Created}\n";
        print "From: $k->{Requestors}\n";
        print "Cc: $k->{Cc}\n" if $k->{Cc};
        print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc};
        print "X-Queue: $k->{Queue}\n";
        print "Subject: [rt #$k->{id}] $k->{Subject}\n\n";
    }
    # dates in these attributes are in GMT and will be converted
    foreach my $form (@$forms) {
        my ($c, $o, $k, $e) = @$form;
        next if ! $k->{id} or exists $k->{Queue};
        if ( exists $k->{Created} ) {
            my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/);
            $m--;
            my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y));
            if ( exists $k->{Description} ) {
                print "===> $k->{Description} on $created\n";
            }
        }
        print "$k->{Content}\n" if exists $k->{Content} and
                                   $k->{Content} !~ /to have no content$/ and
                                   ($k->{Type}||'') ne 'EmailRecord';
        print "$k->{Attachments}\n" if exists $k->{Attachments} and
                                   $k->{Attachments};
    }
}

sub prettylist {
    my $forms = shift;
    my $heading = "Ticket Owner Queue    Age   Told Status Requestor Subject\n";
    $heading .= '-' x 80 . "\n";
    my (@open, @me);
    foreach my $form (@$forms) {
        my ($c, $o, $k, $e) = @$form;
        next if ! $k->{id};
        print $heading if $heading;
        $heading = '';
        my $id = $k->{id};
        $id =~ s!^ticket/!!;
        my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner};
        $owner = substr($owner, 0, 5);
        my $queue = substr($k->{Queue}, 0, 5);
        my $subject = substr($k->{Subject}, 0, 30);
        my $age = date_diff($k->{Created});
        my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told});
        my $status = substr($k->{Status}, 0, 6);
        my $requestor = substr($k->{Requestors}, 0, 9);
        my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n",
            $id, $owner, $queue, $age, $told, $status, $requestor, $subject;
        if ( $k->{Owner} eq 'Nobody' ) {
            push @open, $line;
        } elsif ($k->{Owner} eq $config{user} ) {
            push @me, $line;
        } else {
            print $line;
        }
    }
    print "No matches found\n" if $heading;
    printf "========== my %2d open tickets ==========\n", scalar @me if @me;
    print @me if @me;
    printf "========== %2d unowned tickets ==========\n", scalar @open if @open;
    print @open if @open;
}

__DATA__