d342b64fabd198a286ecf79c1f7e137856c23373
[usit-rt.git] / bin / rt
1 #!/usr/bin/perl -w
2 # BEGIN BPS TAGGED BLOCK {{{
3 #
4 # COPYRIGHT:
5 #
6 # This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
7 #                                          <sales@bestpractical.com>
8 #
9 # (Except where explicitly superseded by other copyright notices)
10 #
11 #
12 # LICENSE:
13 #
14 # This work is made available to you under the terms of Version 2 of
15 # the GNU General Public License. A copy of that license should have
16 # been provided with this software, but in any event can be snarfed
17 # from www.gnu.org.
18 #
19 # This work is distributed in the hope that it will be useful, but
20 # WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
22 # General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
27 # 02110-1301 or visit their web page on the internet at
28 # http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
29 #
30 #
31 # CONTRIBUTION SUBMISSION POLICY:
32 #
33 # (The following paragraph is not intended to limit the rights granted
34 # to you to modify and distribute this software under the terms of
35 # the GNU General Public License and is only of importance to you if
36 # you choose to contribute your changes and enhancements to the
37 # community by submitting them to Best Practical Solutions, LLC.)
38 #
39 # By intentionally submitting any modifications, corrections or
40 # derivatives to this work, or any other work intended for use with
41 # Request Tracker, to Best Practical Solutions, LLC, you confirm that
42 # you are the copyright holder for those contributions and you grant
43 # Best Practical Solutions,  LLC a nonexclusive, worldwide, irrevocable,
44 # royalty-free, perpetual, license to use, copy, create derivative
45 # works based on those contributions, and sublicense and distribute
46 # those contributions and any derivatives thereof.
47 #
48 # END BPS TAGGED BLOCK }}}
49 # Designed and implemented for Best Practical Solutions, LLC by
50 # Abhijit Menon-Sen <ams@wiw.org>
51
52 use strict;
53 use warnings;
54
55 if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
56     require Pod::Usage;
57     print Pod::Usage::pod2usage( { verbose => 2 } );
58     exit;
59 }
60
61 # This program is intentionally written to have as few non-core module
62 # dependencies as possible. It should stay that way.
63
64 use Cwd;
65 use LWP;
66 use Text::ParseWords;
67 use HTTP::Request::Common;
68 use HTTP::Headers;
69 use Term::ReadLine;
70 use Time::Local; # used in prettyshow
71 use File::Temp;
72
73 # strong (GSSAPI based) authentication is supported if the server does provide
74 # it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
75 # it can be suppressed by setting externalauth=0 (default is undef)
76 eval { require GSSAPI };
77 my $no_strong_auth = 'missing perl module GSSAPI';
78 if ( ! $@ ) {
79     eval {require LWP::Authen::Negotiate};
80     $no_strong_auth = $@ ? 'missing perl module LWP::Authen::Negotiate' : 0;
81 }
82
83 # We derive configuration information from hardwired defaults, dotfiles,
84 # and the RT* environment variables (in increasing order of precedence).
85 # Session information is stored in ~/.rt_sessions.
86
87 my $VERSION = 0.02;
88 my $HOME = eval{(getpwuid($<))[7]}
89            || $ENV{HOME} || $ENV{LOGDIR} || $ENV{HOMEPATH}
90            || ".";
91 my %config = (
92     (
93         debug        => 0,
94         user         => eval{(getpwuid($<))[0]} || $ENV{USER} || $ENV{USERNAME},
95         passwd       => undef,
96         server       => 'http://localhost/',
97         query        => "Status!='resolved' and Status!='rejected'",
98         orderby      => 'id',
99         queue        => undef,
100 # to protect against unlimited searches a better choice would be
101 #       queue        => 'Unknown_Queue',
102 # setting externalauth => undef will try GSSAPI auth if the corresponding perl
103 # modules are installed, externalauth => 0 is the backward compatible choice 
104         externalauth => 0,
105     ),
106     config_from_file($ENV{RTCONFIG} || ".rtrc"),
107     config_from_env()
108 );
109 my $session = Session->new("$HOME/.rt_sessions");
110 my $REST = "$config{server}/REST/1.0";
111 $no_strong_auth = 'switched off by externalauth=0'
112     if defined $config{externalauth};
113
114
115 my $prompt = 'rt> ';
116
117 sub whine;
118 sub DEBUG { warn @_ if $config{debug} >= shift }
119
120 # These regexes are used by command handlers to parse arguments.
121 # (XXX: Ask Autrijus how i18n changes these definitions.)
122
123 my $name    = '[\w.-]+';
124 my $CF_name = '[^,]+?';
125 my $field   = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
126 my $label   = '[^,\\/]+';
127 my $labels  = "(?:$label,)*$label";
128 my $idlist  = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
129
130 # Our command line looks like this:
131 #
132 #     rt <action> [options] [arguments]
133 #
134 # We'll parse just enough of it to decide upon an action to perform, and
135 # leave the rest to per-action handlers to interpret appropriately.
136
137 my %handlers = (
138 #   handler     => [ ...aliases... ],
139     version     => ["version", "ver"],
140     shell       => ["shell"],
141     logout      => ["logout"],
142     help        => ["help", "man"],
143     show        => ["show", "cat"],
144     edit        => ["create", "edit", "new", "ed"],
145     list        => ["search", "list", "ls"],
146     comment     => ["comment", "correspond"],
147     link        => ["link", "ln"],
148     merge       => ["merge"],
149     grant       => ["grant", "revoke"],
150     take        => ["take", "steal", "untake"],
151     quit        => ["quit", "exit"],
152     setcommand  => ["del", "delete", "give", "res", "resolve",
153                     "subject"],
154 );
155
156 my %actions;
157 foreach my $fn (keys %handlers) {
158     foreach my $alias (@{ $handlers{$fn} }) {
159         $actions{$alias} = \&{"$fn"};
160     }
161 }
162
163 # Once we find and call an appropriate handler, we're done.
164
165 sub handler {
166     my $action;
167
168     push @ARGV, 'shell' if (!@ARGV);    # default to shell mode
169     shift @ARGV if ($ARGV[0] eq 'rt');    # ignore a leading 'rt'
170     if (@ARGV && exists $actions{$ARGV[0]}) {
171         $action = shift @ARGV;
172         return $actions{$action}->($action);
173     }
174     else {
175         print STDERR "rt: Unknown command '@ARGV'.\n";
176         print STDERR "rt: For help, run 'rt help'.\n";
177         return 1;
178     }
179 }
180
181 exit handler();
182
183 # Handler functions.
184 # ------------------
185 #
186 # The following subs are handlers for each entry in %actions.
187
188 sub shell {
189     $|=1;
190     my $term = Term::ReadLine->new('RT CLI');
191     while ( defined ($_ = $term->readline($prompt)) ) {
192         next if /^#/ || /^\s*$/;
193
194         @ARGV = shellwords($_);
195         handler();
196     }
197 }
198
199 sub version {
200     print "rt $VERSION\n";
201     return 0;
202 }
203
204 sub logout {
205     submit("$REST/logout") if defined $session->cookie;
206     return 0;
207 }
208
209 sub quit {
210     logout();
211     exit;
212 }
213
214 my %help;
215 sub help {
216     my ($action, $type, $rv) = @_;
217     $rv = defined $rv ? $rv : 0;
218     my $key;
219
220     # What help topics do we know about?
221     if (!%help) {
222         local $/ = undef;
223         foreach my $item (@{ Form::parse(<DATA>) }) {
224             my $title = $item->[2]{Title};
225             my @titles = ref $title eq 'ARRAY' ? @$title : $title;
226
227             foreach $title (grep $_, @titles) {
228                 $help{$title} = $item->[2]{Text};
229             }
230         }
231     }
232
233     # What does the user want help with?
234     undef $action if ($action && $actions{$action} eq \&help);
235     unless ($action || $type) {
236         # If we don't know, we'll look for clues in @ARGV.
237         foreach (@ARGV) {
238             if (exists $help{$_}) { $key = $_; last; }
239         }
240         unless ($key) {
241             # Tolerate possibly plural words.
242             foreach (@ARGV) {
243                 if ($_ =~ s/s$// && exists $help{$_}) { $key = $_; last; }
244             }
245         }
246     }
247
248     if ($type && $action) {
249         $key = "$type.$action";
250     }
251     $key ||= $type || $action || "introduction";
252
253     # Find a suitable topic to display.
254     while (!exists $help{$key}) {
255         if ($type && $action) {
256             if ($key eq "$type.$action") { $key = $action;        }
257             elsif ($key eq $action)      { $key = $type;          }
258             else                         { $key = "introduction"; }
259         }
260         else {
261             $key = "introduction";
262         }
263     }
264
265     print STDERR $help{$key}, "\n\n";
266     return $rv;
267 }
268
269 # Displays a list of objects that match some specified condition.
270
271 sub list {
272     my ($q, $type, %data);
273     my $orderby = $config{orderby};
274     
275     if ($config{orderby}) {
276          $data{orderby} = $config{orderby};
277     } 
278     my $bad = 0;
279     my $rawprint = 0;
280     my $reverse_sort = 0;
281     my $queue = $config{queue};
282
283     while (@ARGV) {
284         $_ = shift @ARGV;
285
286         if (/^-t$/) {
287             $bad = 1, last unless defined($type = get_type_argument());
288         }
289         elsif (/^-S$/) {
290             $bad = 1, last unless get_var_argument(\%data);
291         }
292         elsif (/^-o$/) {
293             $data{'orderby'} = shift @ARGV;
294         }
295         elsif (/^-([isl])$/) {
296             $data{format} = $1;
297             $rawprint = 1;
298         }
299         elsif (/^-q$/) {
300             $queue = shift @ARGV;
301         }
302         elsif (/^-r$/) {
303             $reverse_sort = 1;
304         }
305         elsif (/^-f$/) {
306             if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
307                 whine "No valid field list in '-f $ARGV[0]'.";
308                 $bad = 1; last;
309             }
310             $data{fields} = shift @ARGV;
311             $data{format} = 's' if ! $data{format};
312             $rawprint = 1;
313         }
314         elsif (!defined $q && !/^-/) {
315             $q = $_;
316         }
317         else {
318             my $datum = /^-/ ? "option" : "argument";
319             whine "Unrecognised $datum '$_'.";
320             $bad = 1; last;
321         }
322     }
323     if ( ! $rawprint and ! exists $data{format} ) {
324         $data{format} = 'l';
325     }
326     if ( $reverse_sort and $data{orderby} =~ /^-/ ) {
327         $data{orderby} =~ s/^-/+/;
328     } elsif ($reverse_sort) {
329         $data{orderby} =~ s/^\+?(.*)/-$1/;
330     }
331
332     $type ||= "ticket";
333
334     if (!defined $q ) {
335         if ( $type eq 'ticket' ) {
336             $q = $config{query};
337         }
338         else {
339             $q = '';
340         }
341     }
342
343     if ( $type ne 'ticket' ) {
344         $rawprint = 1;
345     }
346
347     unless (defined $q) {
348         my $item = $type ? "query string" : "object type";
349         whine "No $item specified.";
350         $bad = 1;
351     }
352
353     $q =~ s/^#//; # get rid of leading hash
354     if ( $type eq 'ticket' ) {
355         if ( $q =~ /^\d+$/ ) {
356
357             # only digits, must be an id, formulate a correct query
358             $q = "id=$q" if $q =~ /^\d+$/;
359         }
360         else {
361
362           # a string only, take it as an owner or requestor (quoting done later)
363             $q = "(Owner=$q or Requestor like $q) and $config{query}"
364               if $q =~ /^[\w\-]+$/;
365
366            # always add a query for a specific queue or (comma separated) queues
367             $queue =~ s/,/ or Queue=/g if $queue;
368             $q .= " and (Queue=$queue)"
369               if $queue
370                   and $q
371                   and $q !~ /Queue\s*=/i
372                   and $q !~ /id\s*=/i;
373         }
374
375         # correctly quote strings in a query
376         $q =~ s/(=|like\s)\s*([^'\d\s]\S*)\b/$1\'$2\'/g;
377     }
378
379     #return help("list", $type) if $bad;
380     return suggest_help("list", $type, $bad) if $bad;
381
382     print "Query:$q\n" if ! $rawprint;
383     my $r = submit("$REST/search/$type", { query => $q, %data });
384     if ( $rawprint ) {
385         print $r->content;
386     } else {
387         my $forms = Form::parse($r->content);
388         prettylist ($forms);
389     }
390     return 0;
391 }
392
393 # Displays selected information about a single object.
394
395 sub show {
396     my ($type, @objects, %data);
397     my $slurped = 0;
398     my $bad = 0;
399     my $rawprint = 0;
400     my $histspec;
401
402     while (@ARGV) {
403         $_ = shift @ARGV;
404         s/^#// if /^#\d+/; # get rid of leading hash
405         if (/^-t$/) {
406             $bad = 1, last unless defined($type = get_type_argument());
407         }
408         elsif (/^-S$/) {
409             $bad = 1, last unless get_var_argument(\%data);
410         }
411         elsif (/^-([isl])$/) {
412             $data{format} = $1;
413             $rawprint = 1;
414         }
415         elsif (/^-$/ && !$slurped) {
416             chomp(my @lines = <STDIN>);
417             foreach (@lines) {
418                 unless (is_object_spec($_, $type)) {
419                     whine "Invalid object on STDIN: '$_'.";
420                     $bad = 1; last;
421                 }
422                 push @objects, $_;
423             }
424             $slurped = 1;
425         }
426         elsif (/^-f$/) {
427             if ($ARGV[0] !~ /^(?:(?:$field,)*$field)$/) {
428                 whine "No valid field list in '-f $ARGV[0]'.";
429                 $bad = 1; last;
430             }
431             $data{fields} = shift @ARGV;
432             # option f requires short raw listing format
433             $data{format} = 's';
434             $rawprint = 1;
435         }
436         elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
437             push @objects, $spc2;
438             $histspec = is_object_spec("ticket/$_/history", $type);
439         }
440         elsif (/^\d+\// and my $spc3 = is_object_spec("ticket/$_", $type)) {
441             push @objects, $spc3;
442             $rawprint = 1 if $_ =~ /\/content$/;
443         }
444         elsif (my $spec = is_object_spec($_, $type)) {
445             push @objects, $spec;
446             $rawprint = 1 if $_ =~ /\/content$/ or $_ =~ /\/links/ or $_ !~ /^ticket/;
447         }
448         else {
449             my $datum = /^-/ ? "option" : "argument";
450             whine "Unrecognised $datum '$_'.";
451             $bad = 1; last;
452         }
453     }
454     if ( ! $rawprint ) {
455         push @objects, $histspec if $histspec;
456         $data{format} = 'l' if ! exists $data{format};
457     }
458
459     unless (@objects) {
460         whine "No objects specified.";
461         $bad = 1;
462     }
463     #return help("show", $type) if $bad;
464     return suggest_help("show", $type, $bad) if $bad;
465
466     my $r = submit("$REST/show", { id => \@objects, %data });
467     my $c = $r->content;
468     # if this isn't a text reply, remove the trailing newline so we
469     # don't corrupt things like tarballs when people do
470     # show ticket/id/attachments/id/content > foo.tar.gz
471     if ($r->content_type !~ /^text\//) {
472         chomp($c);
473         $rawprint = 1;
474     }
475     if ( $rawprint ) {
476         print $c;
477     } else {
478         # I do not know how to get more than one form correctly returned
479         $c =~ s!^RT/[\d\.]+ 200 Ok$!--!mg;
480         my $forms = Form::parse($c);
481         prettyshow ($forms);
482     }
483     return 0;
484 }
485
486 # To create a new object, we ask the server for a form with the defaults
487 # filled in, allow the user to edit it, and send the form back.
488 #
489 # To edit an object, we must ask the server for a form representing that
490 # object, make changes requested by the user (either on the command line
491 # or interactively via $EDITOR), and send the form back.
492
493 sub edit {
494     my ($action) = @_;
495     my (%data, $type, @objects);
496     my ($cl, $text, $edit, $input, $output, $content_type);
497
498     use vars qw(%set %add %del);
499     %set = %add = %del = ();
500     my $slurped = 0;
501     my $bad = 0;
502     
503     while (@ARGV) {
504         $_ = shift @ARGV;
505         s/^#// if /^#\d+/; # get rid of leading hash
506
507         if    (/^-e$/) { $edit = 1 }
508         elsif (/^-i$/) { $input = 1 }
509         elsif (/^-o$/) { $output = 1 }
510         elsif (/^-ct$/) { $content_type = shift @ARGV }
511         elsif (/^-t$/) {
512             $bad = 1, last unless defined($type = get_type_argument());
513         }
514         elsif (/^-S$/) {
515             $bad = 1, last unless get_var_argument(\%data);
516         }
517         elsif (/^-$/ && !($slurped || $input)) {
518             chomp(my @lines = <STDIN>);
519             foreach (@lines) {
520                 unless (is_object_spec($_, $type)) {
521                     whine "Invalid object on STDIN: '$_'.";
522                     $bad = 1; last;
523                 }
524                 push @objects, $_;
525             }
526             $slurped = 1;
527         }
528         elsif (/^set$/i) {
529             my $vars = 0;
530
531             while (@ARGV && $ARGV[0] =~ /^($field)([+-]?=)(.*)$/s) {
532                 my ($key, $op, $val) = ($1, $2, $3);
533                 my $hash = ($op eq '=') ? \%set : ($op =~ /^\+/) ? \%add : \%del;
534
535                 vpush($hash, lc $key, $val);
536                 shift @ARGV;
537                 $vars++;
538             }
539             unless ($vars) {
540                 whine "No variables to set.";
541                 $bad = 1; last;
542             }
543             $cl = $vars;
544         }
545         elsif (/^(?:add|del)$/i) {
546             my $vars = 0;
547             my $hash = ($_ eq "add") ? \%add : \%del;
548
549             while (@ARGV && $ARGV[0] =~ /^($field)=(.*)$/s) {
550                 my ($key, $val) = ($1, $2);
551
552                 vpush($hash, lc $key, $val);
553                 shift @ARGV;
554                 $vars++;
555             }
556             unless ($vars) {
557                 whine "No variables to set.";
558                 $bad = 1; last;
559             }
560             $cl = $vars;
561         }
562         elsif (/^\d+$/ and my $spc2 = is_object_spec("ticket/$_", $type)) {
563             push @objects, $spc2;
564         }
565         elsif (my $spec = is_object_spec($_, $type)) {
566             push @objects, $spec;
567         }
568         else {
569             my $datum = /^-/ ? "option" : "argument";
570             whine "Unrecognised $datum '$_'.";
571             $bad = 1; last;
572         }
573     }
574
575     if ($action =~ /^ed(?:it)?$/) {
576         unless (@objects) {
577             whine "No objects specified.";
578             $bad = 1;
579         }
580     }
581     else {
582         if (@objects) {
583             whine "You shouldn't specify objects as arguments to $action.";
584             $bad = 1;
585         }
586         unless ($type) {
587             whine "What type of object do you want to create?";
588             $bad = 1;
589         }
590         @objects = ("$type/new") if defined($type);
591     }
592     #return help($action, $type) if $bad;
593     return suggest_help($action, $type, $bad) if $bad;
594
595     # We need a form to make changes to. We usually ask the server for
596     # one, but we can avoid that if we are fed one on STDIN, or if the
597     # user doesn't want to edit the form by hand, and the command line
598     # specifies only simple variable assignments.  We *should* get a
599     # form if we're creating a new ticket, so that the default values
600     # get filled in properly.
601
602     my @new_objects = grep /\/new$/, @objects;
603
604     if ($input) {
605         local $/ = undef;
606         $text = <STDIN>;
607     }
608     elsif ($edit || %add || %del || !$cl || @new_objects) {
609         my $r = submit("$REST/show", { id => \@objects, format => 'l' });
610         $text = $r->content;
611     }
612
613     # If any changes were specified on the command line, apply them.
614     if ($cl) {
615         if ($text) {
616             # We're updating forms from the server.
617             my $forms = Form::parse($text);
618
619             foreach my $form (@$forms) {
620                 my ($c, $o, $k, $e) = @$form;
621                 my ($key, $val);
622
623                 next if ($e || !@$o);
624
625                 local %add = %add;
626                 local %del = %del;
627                 local %set = %set;
628
629                 # Make changes to existing fields.
630                 foreach $key (@$o) {
631                     if (exists $add{lc $key}) {
632                         $val = delete $add{lc $key};
633                         vpush($k, $key, $val);
634                         $k->{$key} = vsplit($k->{$key}) if $val =~ /[,\n]/;
635                     }
636                     if (exists $del{lc $key}) {
637                         $val = delete $del{lc $key};
638                         my %val = map {$_=>1} @{ vsplit($val) };
639                         $k->{$key} = vsplit($k->{$key});
640                         @{$k->{$key}} = grep {!exists $val{$_}} @{$k->{$key}};
641                     }
642                     if (exists $set{lc $key}) {
643                         $k->{$key} = delete $set{lc $key};
644                     }
645                 }
646                 
647                 # Then update the others.
648                 foreach $key (keys %set) { vpush($k, $key, $set{$key}) }
649                 foreach $key (keys %add) {
650                     vpush($k, $key, $add{$key});
651                     $k->{$key} = vsplit($k->{$key});
652                 }
653                 push @$o, (keys %add, keys %set);
654             }
655
656             $text = Form::compose($forms);
657         }
658         else {
659             # We're rolling our own set of forms.
660             my @forms;
661             foreach (@objects) {
662                 my ($type, $ids, $args) =
663                     m{^($name)/($idlist|$labels)(?:(/.*))?$}o;
664
665                 $args ||= "";
666                 foreach my $obj (expand_list($ids)) {
667                     my %set = (%set, id => "$type/$obj$args");
668                     push @forms, ["", [keys %set], \%set];
669                 }
670             }
671             $text = Form::compose(\@forms);
672         }
673     }
674
675     if ($output) {
676         print $text;
677         return 0;
678     }
679
680     my @files;
681     @files = @{ vsplit($set{'attachment'}) } if exists $set{'attachment'};
682
683     my $synerr = 0;
684
685 EDIT:
686     # We'll let the user edit the form before sending it to the server,
687     # unless we have enough information to submit it non-interactively.
688     if ( $type && $type eq 'ticket' && $text !~ /^Content-Type:/m ) {
689         $text .= "Content-Type: $content_type\n"
690             if $content_type and $content_type ne "text/plain";
691     }
692
693     if ($edit || (!$input && !$cl)) {
694         my ($newtext) = vi_form_while(
695             $text,
696             sub {
697                 my ($text, $form) = @_;
698                 return 1 unless exists $form->[2]{'Attachment'};
699
700                 foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
701                     return (0, "File '$f' doesn't exist") unless -f $f;
702                 }
703                 @files = @{ vsplit($form->[2]{'Attachment'}) };
704                 return 1;
705             },
706         );
707         return $newtext unless $newtext;
708         # We won't resubmit a bad form unless it was changed.
709         $text = ($synerr && $newtext eq $text) ? undef : $newtext;
710     }
711
712     delete @data{ grep /^attachment_\d+$/, keys %data };
713     my $i = 1;
714     foreach my $file (@files) {
715         $data{"attachment_$i"} = bless([ $file ], "Attachment");
716         $i++;
717     }
718
719     if ($text) {
720         my $r = submit("$REST/edit", {content => $text, %data});
721         if ($r->code == 409) {
722             # If we submitted a bad form, we'll give the user a chance
723             # to correct it and resubmit.
724             if ($edit || (!$input && !$cl)) {
725                 my $content = $r->content . "\n";
726                 $content =~ s/^(?!#)/#     /mg;
727                 $text = $content . $text;
728                 $synerr = 1;
729                 goto EDIT;
730             }
731             else {
732                 print $r->content;
733                 return 0;
734             }
735         }
736         print $r->content;
737     }
738     return 0;
739 }
740
741 # handler for special edit commands. A valid edit command is constructed and
742 # further work is delegated to the edit handler
743
744 sub setcommand {
745     my ($action) = @_;
746     my ($id, $bad, $what);
747     if ( @ARGV ) {
748         $_ = shift @ARGV;
749         $id = $1 if (m|^(?:ticket/)?($idlist)$|);
750     }
751     if ( ! $id ) {
752         $bad = 1;
753         whine "No ticket number specified.";
754     }
755     if ( @ARGV ) {
756         if ($action eq 'subject') {
757             my $subject = '"'.join (" ", @ARGV).'"';
758             @ARGV = ();
759             $what = "subject=$subject";
760         } elsif ($action eq 'give') {
761             my $owner = shift @ARGV;
762             $what = "owner=$owner";
763         }
764     } else {
765         if ( $action eq 'delete' or $action eq 'del' ) {
766             $what = "status=deleted";
767         } elsif ($action eq 'resolve' or $action eq 'res' ) {
768             $what = "status=resolved";
769         } elsif ($action eq 'take' ) {
770             $what = "owner=$config{user}";
771         } elsif ($action eq 'untake') {
772             $what = "owner=Nobody";
773         }
774     }
775     if (@ARGV) {
776         $bad = 1;
777         whine "Extraneous arguments for action $action: @ARGV.";
778     }
779     if ( ! $what ) {
780         $bad = 1;
781         whine "unrecognized action $action.";
782     }
783     return help("edit", undef, $bad) if $bad;
784     @ARGV = ( $id, "set", $what );
785     print "Executing: rt edit @ARGV\n";
786     return edit("edit");
787 }
788
789 # We roll "comment" and "correspond" into the same handler.
790
791 sub comment {
792     my ($action) = @_;
793     my (%data, $id, @files, @bcc, @cc, $msg, $content_type, $wtime, $edit);
794     my $bad = 0;
795
796     while (@ARGV) {
797         $_ = shift @ARGV;
798
799         if (/^-e$/) {
800             $edit = 1;
801         }
802         elsif (/^-(?:[abcmw]|ct)$/) {
803             unless (@ARGV) {
804                 whine "No argument specified with $_.";
805                 $bad = 1; last;
806             }
807
808             if (/-a/) {
809                 unless (-f $ARGV[0] && -r $ARGV[0]) {
810                     whine "Cannot read attachment: '$ARGV[0]'.";
811                     return 0;
812                 }
813                 push @files, shift @ARGV;
814             }
815             elsif (/-ct/) {
816                 $content_type = shift @ARGV;
817             }
818             elsif (/-([bc])/) {
819                 my $a = $_ eq "-b" ? \@bcc : \@cc;
820                 @$a = split /\s*,\s*/, shift @ARGV;
821             }
822             elsif (/-m/) {
823                 $msg = shift @ARGV;
824                 if ( $msg =~ /^-$/ ) {
825                     undef $msg;
826                     while (<STDIN>) { $msg .= $_ }
827                 }
828             }
829             elsif (/-w/) { $wtime = shift @ARGV }
830         }
831         elsif (!$id && m|^(?:ticket/)?($idlist)$|) {
832             $id = $1;
833         }
834         else {
835             my $datum = /^-/ ? "option" : "argument";
836             whine "Unrecognised $datum '$_'.";
837             $bad = 1; last;
838         }
839     }
840
841     unless ($id) {
842         whine "No object specified.";
843         $bad = 1;
844     }
845     #return help($action, "ticket") if $bad;
846     return suggest_help($action, "ticket") if $bad;
847
848     my $form = [
849         "",
850         [ "Ticket", "Action", "Cc", "Bcc", "Attachment", "TimeWorked", "Content-Type", "Text" ],
851         {
852             Ticket     => $id,
853             Action     => $action,
854             Cc         => [ @cc ],
855             Bcc        => [ @bcc ],
856             Attachment => [ @files ],
857             TimeWorked => $wtime || '',
858             'Content-Type' => $content_type || 'text/plain',
859             Text       => $msg || '',
860             Status => ''
861         }
862     ];
863
864     my $text = Form::compose([ $form ]);
865
866     if ($edit || !$msg) {
867         my ($tmp) = vi_form_while(
868             $text,
869             sub {
870                 my ($text, $form) = @_;
871                 foreach my $f ( @{ vsplit($form->[2]{'Attachment'}) } ) {
872                     return (0, "File '$f' doesn't exist") unless -f $f;
873                 }
874                 @files = @{ vsplit($form->[2]{'Attachment'}) };
875                 return 1;
876             },
877         );
878         return $tmp unless $tmp;
879         $text = $tmp;
880     }
881
882     my $i = 1;
883     foreach my $file (@files) {
884         $data{"attachment_$i"} = bless([ $file ], "Attachment");
885         $i++;
886     }
887     $data{content} = $text;
888
889     my $r = submit("$REST/ticket/$id/comment", \%data);
890     print $r->content;
891     return 0;
892 }
893
894 # Merge one ticket into another.
895
896 sub merge {
897     my @id;
898     my $bad = 0;
899
900     while (@ARGV) {
901         $_ = shift @ARGV;
902         s/^#// if /^#\d+/; # get rid of leading hash
903
904         if (/^\d+$/) {
905             push @id, $_;
906         }
907         else {
908             whine "Unrecognised argument: '$_'.";
909             $bad = 1; last;
910         }
911     }
912
913     unless (@id == 2) {
914         my $evil = @id > 2 ? "many" : "few";
915         whine "Too $evil arguments specified.";
916         $bad = 1;
917     }
918     #return help("merge", "ticket") if $bad;
919     return suggest_help("merge", "ticket", $bad) if $bad;
920
921     my $r = submit("$REST/ticket/$id[0]/merge/$id[1]");
922     print $r->content;
923     return 0;
924 }
925
926 # Link one ticket to another.
927
928 sub link {
929     my ($bad, $del, %data) = (0, 0, ());
930     my $type;
931
932     my %ltypes = map { lc $_ => $_ } qw(DependsOn DependedOnBy RefersTo
933                                         ReferredToBy HasMember MemberOf);
934
935     while (@ARGV && $ARGV[0] =~ /^-/) {
936         $_ = shift @ARGV;
937
938         if (/^-d$/) {
939             $del = 1;
940         }
941         elsif (/^-t$/) {
942             $bad = 1, last unless defined($type = get_type_argument());
943         }
944         else {
945             whine "Unrecognised option: '$_'.";
946             $bad = 1; last;
947         }
948     }
949     
950     $type = "ticket" unless $type; # default type to tickets
951     
952     if (@ARGV == 3) {
953         my ($from, $rel, $to) = @ARGV;
954         if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
955             whine "Invalid link '$rel' for type $type specified.";
956             $bad = 1;
957         }
958         %data = (id => $from, rel => $rel, to => $to, del => $del);
959     }
960     else {
961         my $bad = @ARGV < 3 ? "few" : "many";
962         whine "Too $bad arguments specified.";
963         $bad = 1;
964     }
965     return suggest_help("link", $type, $bad) if $bad;
966  
967     my $r = submit("$REST/$type/link", \%data);
968     print $r->content;
969     return 0;
970 }
971
972 # Take/steal a ticket
973 sub take {
974     my ($cmd) = @_;
975     my ($bad, %data) = (0, ());
976
977     my $id;
978
979     # get the ticket id
980     if (@ARGV == 1) {
981         ($id) = @ARGV;
982         unless ($id =~ /^\d+$/) {
983             whine "Invalid ticket ID $id specified.";
984             $bad = 1;
985         }
986         my $form = [
987             "",
988             [ "Ticket", "Action" ],
989             {
990                 Ticket => $id,
991                 Action => $cmd,
992                 Status => '',
993             }
994         ];
995
996         my $text = Form::compose([ $form ]);
997         $data{content} = $text;
998     }
999     else {
1000         $bad = @ARGV < 1 ? "few" : "many";
1001         whine "Too $bad arguments specified.";
1002         $bad = 1;
1003     }
1004     return suggest_help("take", "ticket", $bad) if $bad;
1005
1006     my $r = submit("$REST/ticket/$id/take", \%data);
1007     print $r->content;
1008     return 0;
1009 }
1010
1011 # Grant/revoke a user's rights.
1012
1013 sub grant {
1014     my ($cmd) = @_;
1015
1016     whine "$cmd is unimplemented.";
1017     return 1;
1018 }
1019
1020 # Client <-> Server communication.
1021 # --------------------------------
1022 #
1023 # This function composes and sends an HTTP request to the RT server, and
1024 # interprets the response. It takes a request URI, and optional request
1025 # data (a string, or a reference to a set of key-value pairs).
1026
1027 sub submit {
1028     my ($uri, $content) = @_;
1029     my ($req, $data);
1030     my $ua = LWP::UserAgent->new(agent => "RT/3.0b", env_proxy => 1);
1031     my $h = HTTP::Headers->new;
1032
1033     # Did the caller specify any data to send with the request?
1034     $data = [];
1035     if (defined $content) {
1036         unless (ref $content) {
1037             # If it's just a string, make sure LWP handles it properly.
1038             # (By pretending that it's a file!)
1039             $content = [ content => [undef, "", Content => $content] ];
1040         }
1041         elsif (ref $content eq 'HASH') {
1042             my @data;
1043             foreach my $k (keys %$content) {
1044                 if (ref $content->{$k} eq 'ARRAY') {
1045                     foreach my $v (@{ $content->{$k} }) {
1046                         push @data, $k, $v;
1047                     }
1048                 }
1049                 else { push @data, $k, $content->{$k} }
1050             }
1051             $content = \@data;
1052         }
1053         $data = $content;
1054     }
1055
1056     # Should we send authentication information to start a new session?
1057     my $how = $config{server} =~ /^https/ ? 'over SSL' : 'unencrypted';
1058     (my $server = $config{server}) =~ s/^.*\/\/([^\/]+)\/?/$1/;
1059     if ($config{externalauth}) {
1060         $h->authorization_basic($config{user}, $config{passwd} || read_passwd() );
1061         print "   Password will be sent to $server $how\n",
1062               "   Press CTRL-C now if you do not want to continue\n"
1063             if ! $config{passwd};
1064     } elsif ( $no_strong_auth ) {
1065         if (!defined $session->cookie) {
1066             print "   Strong encryption not available, $no_strong_auth\n",
1067                   "   Password will be sent to $server $how\n",
1068                   "   Press CTRL-C now if you do not want to continue\n"
1069                 if ! $config{passwd};
1070             push @$data, ( user => $config{user} );
1071             push @$data, ( pass => $config{passwd} || read_passwd() );
1072         }
1073     }
1074
1075     # Now, we construct the request.
1076     if (@$data) {
1077         $req = POST($uri, $data, Content_Type => 'form-data');
1078     }
1079     else {
1080         $req = GET($uri);
1081     }
1082     $session->add_cookie_header($req);
1083     if ($config{externalauth}) {
1084         $req->header(%$h);
1085     }
1086
1087     # Then we send the request and parse the response.
1088     DEBUG(3, $req->as_string);
1089     my $res = $ua->request($req);
1090     DEBUG(3, $res->as_string);
1091
1092     if ($res->is_success) {
1093         # The content of the response we get from the RT server consists
1094         # of an HTTP-like status line followed by optional header lines,
1095         # a blank line, and arbitrary text.
1096
1097         my ($head, $text) = split /\n\n/, $res->content, 2;
1098         my ($status, @headers) = split /\n/, $head;
1099         $text =~ s/\n*$/\n/ if ($text);
1100
1101         # "RT/3.0.1 401 Credentials required"
1102         if ($status !~ m#^RT/\d+(?:\S+) (\d+) ([\w\s]+)$#) {
1103             warn "rt: Malformed RT response from $config{server}.\n";
1104             warn "(Rerun with RTDEBUG=3 for details.)\n" if $config{debug} < 3;
1105             exit -1;
1106         }
1107
1108         # Our caller can pretend that the server returned a custom HTTP
1109         # response code and message. (Doing that directly is apparently
1110         # not sufficiently portable and uncomplicated.)
1111         $res->code($1);
1112         $res->message($2);
1113         $res->content($text);
1114         $session->update($res) if ($res->is_success || $res->code != 401);
1115
1116         if (!$res->is_success) {
1117             # We can deal with authentication failures ourselves. Either
1118             # we sent invalid credentials, or our session has expired.
1119             if ($res->code == 401) {
1120                 my %d = @$data;
1121                 if (exists $d{user}) {
1122                     warn "rt: Incorrect username or password.\n";
1123                     exit -1;
1124                 }
1125                 elsif ($req->header("Cookie")) {
1126                     # We'll retry the request with credentials, unless
1127                     # we only wanted to logout in the first place.
1128                     $session->delete;
1129                     return submit(@_) unless $uri eq "$REST/logout";
1130                 }
1131             }
1132             # Conflicts should be dealt with by the handler and user.
1133             # For anything else, we just die.
1134             elsif ($res->code != 409) {
1135                 warn "rt: ", $res->content;
1136                 #exit;
1137             }
1138         }
1139     }
1140     else {
1141         warn "rt: Server error: ", $res->message, " (", $res->code, ")\n";
1142         exit -1;
1143     }
1144
1145     return $res;
1146 }
1147
1148 # Session management.
1149 # -------------------
1150 #
1151 # Maintains a list of active sessions in the ~/.rt_sessions file.
1152 {
1153     package Session;
1154     my ($s, $u);
1155
1156     # Initialises the session cache.
1157     sub new {
1158         my ($class, $file) = @_;
1159         my $self = {
1160             file => $file || "$HOME/.rt_sessions",
1161             sids => { }
1162         };
1163        
1164         # The current session is identified by the currently configured
1165         # server and user.
1166         ($s, $u) = @config{"server", "user"};
1167
1168         bless $self, $class;
1169         $self->load();
1170
1171         return $self;
1172     }
1173
1174     # Returns the current session cookie.
1175     sub cookie {
1176         my ($self) = @_;
1177         my $cookie = $self->{sids}{$s}{$u};
1178         return defined $cookie ? "RT_SID_$cookie" : undef;
1179     }
1180
1181     # Deletes the current session cookie.
1182     sub delete {
1183         my ($self) = @_;
1184         delete $self->{sids}{$s}{$u};
1185     }
1186
1187     # Adds a Cookie header to an outgoing HTTP request.
1188     sub add_cookie_header {
1189         my ($self, $request) = @_;
1190         my $cookie = $self->cookie();
1191
1192         $request->header(Cookie => $cookie) if defined $cookie;
1193     }
1194
1195     # Extracts the Set-Cookie header from an HTTP response, and updates
1196     # session information accordingly.
1197     sub update {
1198         my ($self, $response) = @_;
1199         my $cookie = $response->header("Set-Cookie");
1200
1201         if (defined $cookie && $cookie =~ /^RT_SID_(.[^;,\s]+=[0-9A-Fa-f]+);/) {
1202             $self->{sids}{$s}{$u} = $1;
1203         }
1204     }
1205
1206     # Loads the session cache from the specified file.
1207     sub load {
1208         my ($self, $file) = @_;
1209         $file ||= $self->{file};
1210
1211         open( my $handle, '<', $file ) or return 0;
1212
1213         $self->{file} = $file;
1214         my $sids = $self->{sids} = {};
1215         while (<$handle>) {
1216             chomp;
1217             next if /^$/ || /^#/;
1218             next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
1219             my ($server, $user, $cookie) = split / /, $_;
1220             $sids->{$server}{$user} = $cookie;
1221         }
1222         return 1;
1223     }
1224
1225     # Writes the current session cache to the specified file.
1226     sub save {
1227         my ($self, $file) = shift;
1228         $file ||= $self->{file};
1229
1230         open( my $handle, '>', "$file" ) or return 0;
1231
1232         my $sids = $self->{sids};
1233         foreach my $server (keys %$sids) {
1234             foreach my $user (keys %{ $sids->{$server} }) {
1235                 my $sid = $sids->{$server}{$user};
1236                 if (defined $sid) {
1237                     print $handle "$server $user $sid\n";
1238                 }
1239             }
1240         }
1241         close($handle);
1242         chmod 0600, $file;
1243         return 1;
1244     }
1245
1246     sub DESTROY {
1247         my $self = shift;
1248         $self->save;
1249     }
1250 }
1251
1252 # Form handling.
1253 # --------------
1254 #
1255 # Forms are RFC822-style sets of (field, value) specifications with some
1256 # initial comments and interspersed blank lines allowed for convenience.
1257 # Sets of forms are separated by --\n (in a cheap parody of MIME).
1258 #
1259 # Each form is parsed into an array with four elements: commented text
1260 # at the start of the form, an array with the order of keys, a hash with
1261 # key/value pairs, and optional error text if the form syntax was wrong.
1262
1263 # Returns a reference to an array of parsed forms.
1264 sub Form::parse {
1265     my $state = 0;
1266     my @forms = ();
1267     my @lines = split /\n/, $_[0] if $_[0];
1268     my ($c, $o, $k, $e) = ("", [], {}, "");
1269
1270     LINE:
1271     while (@lines) {
1272         my $line = shift @lines;
1273
1274         next LINE if $line eq '';
1275
1276         if ($line eq '--') {
1277             # We reached the end of one form. We'll ignore it if it was
1278             # empty, and store it otherwise, errors and all.
1279             if ($e || $c || @$o) {
1280                 push @forms, [ $c, $o, $k, $e ];
1281                 $c = ""; $o = []; $k = {}; $e = "";
1282             }
1283             $state = 0;
1284         }
1285         elsif ($state != -1) {
1286             if ($state == 0 && $line =~ /^#/) {
1287                 # Read an optional block of comments (only) at the start
1288                 # of the form.
1289                 $state = 1;
1290                 $c = $line;
1291                 while (@lines && $lines[0] =~ /^#/) {
1292                     $c .= "\n".shift @lines;
1293                 }
1294                 $c .= "\n";
1295             }
1296             elsif ($state <= 1 && $line =~ /^($field):(?:\s+(.*))?$/) {
1297                 # Read a field: value specification.
1298                 my $f  = $1;
1299                 my @v  = ($2 || ());
1300
1301                 # Read continuation lines, if any.
1302                 while (@lines && ($lines[0] eq '' || $lines[0] =~ /^\s+/)) {
1303                     push @v, shift @lines;
1304                 }
1305                 pop @v while (@v && $v[-1] eq '');
1306
1307                 # Strip longest common leading indent from text.
1308                 my $ws = "";
1309                 foreach my $ls (map {/^(\s+)/} @v[1..$#v]) {
1310                     $ws = $ls if (!$ws || length($ls) < length($ws));
1311                 }
1312                 s/^$ws// foreach @v;
1313
1314                 push(@$o, $f) unless exists $k->{$f};
1315                 vpush($k, $f, join("\n", @v));
1316
1317                 $state = 1;
1318             }
1319             elsif ($line !~ /^#/) {
1320                 # We've found a syntax error, so we'll reconstruct the
1321                 # form parsed thus far, and add an error marker. (>>)
1322                 $state = -1;
1323                 $e = Form::compose([[ "", $o, $k, "" ]]);
1324                 $e.= $line =~ /^>>/ ? "$line\n" : ">> $line\n";
1325             }
1326         }
1327         else {
1328             # We saw a syntax error earlier, so we'll accumulate the
1329             # contents of this form until the end.
1330             $e .= "$line\n";
1331         }
1332     }
1333     push(@forms, [ $c, $o, $k, $e ]) if ($e || $c || @$o);
1334
1335     foreach my $l (keys %$k) {
1336         $k->{$l} = vsplit($k->{$l}) if (ref $k->{$l} eq 'ARRAY');
1337     }
1338
1339     return \@forms;
1340 }
1341
1342 # Returns text representing a set of forms.
1343 sub Form::compose {
1344     my ($forms) = @_;
1345     my @text;
1346
1347     foreach my $form (@$forms) {
1348         my ($c, $o, $k, $e) = @$form;
1349         my $text = "";
1350
1351         if ($c) {
1352             $c =~ s/\n*$/\n/;
1353             $text = "$c\n";
1354         }
1355         if ($e) {
1356             $text .= $e;
1357         }
1358         elsif ($o) {
1359             my @lines;
1360
1361             foreach my $key (@$o) {
1362                 my ($line, $sp);
1363                 my $v = $k->{$key};
1364                 my @values = ref $v eq 'ARRAY' ? @$v : $v;
1365
1366                 $sp = " "x(length("$key: "));
1367                 $sp = " "x4 if length($sp) > 16;
1368
1369                 foreach $v (@values) {
1370                     if ($v =~ /\n/) {
1371                         $v =~ s/^/$sp/gm;
1372                         $v =~ s/^$sp//;
1373
1374                         if ($line) {
1375                             push @lines, "$line\n\n";
1376                             $line = "";
1377                         }
1378                         elsif (@lines && $lines[-1] !~ /\n\n$/) {
1379                             $lines[-1] .= "\n";
1380                         }
1381                         push @lines, "$key: $v\n\n";
1382                     }
1383                     elsif ($line &&
1384                            length($line)+length($v)-rindex($line, "\n") >= 70)
1385                     {
1386                         $line .= ",\n$sp$v";
1387                     }
1388                     else {
1389                         $line = $line ? "$line,$v" : "$key: $v";
1390                     }
1391                 }
1392
1393                 $line = "$key:" unless @values;
1394                 if ($line) {
1395                     if ($line =~ /\n/) {
1396                         if (@lines && $lines[-1] !~ /\n\n$/) {
1397                             $lines[-1] .= "\n";
1398                         }
1399                         $line .= "\n";
1400                     }
1401                     push @lines, "$line\n";
1402                 }
1403             }
1404
1405             $text .= join "", @lines;
1406         }
1407         else {
1408             chomp $text;
1409         }
1410         push @text, $text;
1411     }
1412
1413     return join "\n--\n\n", @text;
1414 }
1415
1416 # Configuration.
1417 # --------------
1418
1419 # Returns configuration information from the environment.
1420 sub config_from_env {
1421     my %env;
1422
1423     foreach my $k (qw(EXTERNALAUTH DEBUG USER PASSWD SERVER QUERY ORDERBY)) {
1424
1425         if (exists $ENV{"RT$k"}) {
1426             $env{lc $k} = $ENV{"RT$k"};
1427         }
1428     }
1429
1430     return %env;
1431 }
1432
1433 # Finds a suitable configuration file and returns information from it.
1434 sub config_from_file {
1435     my ($rc) = @_;
1436
1437     if ($rc =~ m#^/#) {
1438         # We'll use an absolute path if we were given one.
1439         return parse_config_file($rc);
1440     }
1441     else {
1442         # Otherwise we'll use the first file we can find in the current
1443         # directory, or in one of its (increasingly distant) ancestors.
1444
1445         my @dirs = split /\//, cwd;
1446         while (@dirs) {
1447             my $file = join('/', @dirs, $rc);
1448             if (-r $file) {
1449                 return parse_config_file($file);
1450             }
1451
1452             # Remove the last directory component each time.
1453             pop @dirs;
1454         }
1455
1456         # Still nothing? We'll fall back to some likely defaults.
1457         for ("$HOME/$rc", "local/etc/rt.conf", "/etc/rt.conf") {
1458             return parse_config_file($_) if (-r $_);
1459         }
1460     }
1461
1462     return ();
1463 }
1464
1465 # Makes a hash of the specified configuration file.
1466 sub parse_config_file {
1467     my %cfg;
1468     my ($file) = @_;
1469     local $_; # $_ may be aliased to a constant, from line 1163
1470
1471     open( my $handle, '<', $file ) or return;
1472
1473     while (<$handle>) {
1474         chomp;
1475         next if (/^#/ || /^\s*$/);
1476
1477         if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
1478             $cfg{$1} = $2;
1479         }
1480         else {
1481             die "rt: $file:$.: unknown configuration directive.\n";
1482         }
1483     }
1484
1485     return %cfg;
1486 }
1487
1488 # Helper functions.
1489 # -----------------
1490
1491 sub whine {
1492     my $sub = (caller(1))[3];
1493     $sub =~ s/^main:://;
1494     warn "rt: $sub: @_\n";
1495     return 0;
1496 }
1497
1498 sub read_passwd {
1499     eval 'require Term::ReadKey';
1500     if ($@) {
1501         die "No password specified (and Term::ReadKey not installed).\n";
1502     }
1503
1504     print "Password: ";
1505     Term::ReadKey::ReadMode('noecho');
1506     chomp(my $passwd = Term::ReadKey::ReadLine(0));
1507     Term::ReadKey::ReadMode('restore');
1508     print "\n";
1509
1510     return $passwd;
1511 }
1512
1513 sub vi_form_while {
1514     my $text = shift;
1515     my $cb = shift;
1516
1517     my $error = 0;
1518     my ($c, $o, $k, $e);
1519     do {
1520         my $ntext = vi($text);
1521         return undef if ($error && $ntext eq $text);
1522
1523         $text = $ntext;
1524
1525         my $form = Form::parse($text);
1526         $error = 0;
1527         ($c, $o, $k, $e) = @{ $form->[0] };
1528         if ( $e ) {
1529             $error = 1;
1530             $c = "# Syntax error.";
1531             goto NEXT;
1532         }
1533         elsif (!@$o) {
1534             return 0;
1535         }
1536
1537         my ($status, $msg) = $cb->( $text, [$c, $o, $k, $e] );
1538         unless ( $status ) {
1539             $error = 1;
1540             $c = "# $msg";
1541         }
1542
1543     NEXT:
1544         $text = Form::compose([[$c, $o, $k, $e]]);
1545     } while ($error);
1546
1547     return $text;
1548 }
1549
1550 sub vi {
1551     my ($text) = @_;
1552     my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
1553
1554     local $/ = undef;
1555
1556     my $handle = File::Temp->new;
1557     print $handle $text;
1558     close($handle);
1559
1560     system($editor, $handle->filename) && die "Couldn't run $editor.\n";
1561
1562     open( $handle, '<', $handle->filename ) or die "$handle: $!\n";
1563     $text = <$handle>;
1564     close($handle);
1565
1566     return $text;
1567 }
1568
1569 # Add a value to a (possibly multi-valued) hash key.
1570 sub vpush {
1571     my ($hash, $key, $val) = @_;
1572     my @val = ref $val eq 'ARRAY' ? @$val : $val;
1573
1574     if (exists $hash->{$key}) {
1575         unless (ref $hash->{$key} eq 'ARRAY') {
1576             my @v = $hash->{$key} ne '' ? $hash->{$key} : ();
1577             $hash->{$key} = \@v;
1578         }
1579         push @{ $hash->{$key} }, @val;
1580     }
1581     else {
1582         $hash->{$key} = $val;
1583     }
1584 }
1585
1586 # "Normalise" a hash key that's known to be multi-valued.
1587 sub vsplit {
1588     my ($val) = @_;
1589     my ($word, @words);
1590     my @values = ref $val eq 'ARRAY' ? @$val : $val;
1591
1592     foreach my $line (map {split /\n/} @values) {
1593         # XXX: This should become a real parser, à la Text::ParseWords.
1594         $line =~ s/^\s+//;
1595         $line =~ s/\s+$//;
1596         my ( $a, $b ) = split /\s*,\s*/, $line, 2;
1597
1598         while ($a) {
1599             no warnings 'uninitialized';
1600             if ( $a =~ /^'/ ) {
1601                 my $s = $a;
1602                 while ( $a !~ /'$/ || (   $a !~ /(\\\\)+'$/
1603                             && $a =~ /(\\)+'$/ )) {
1604                     ( $a, $b ) = split /\s*,\s*/, $b, 2;
1605                     $s .= ',' . $a;
1606                 }
1607                 push @words, $s;
1608             }
1609             elsif ( $a =~ /^q\{/ ) {
1610                 my $s = $a;
1611                 while ( $a !~ /\}$/ ) {
1612                     ( $a, $b ) =
1613                       split /\s*,\s*/, $b, 2;
1614                     $s .= ',' . $a;
1615                 }
1616                 $s =~ s/^q\{/'/;
1617                 $s =~ s/\}/'/;
1618                 push @words, $s;
1619             }
1620             else {
1621                 push @words, $a;
1622             }
1623             ( $a, $b ) = split /\s*,\s*/, $b, 2;
1624         }
1625
1626
1627     }
1628
1629     return \@words;
1630 }
1631
1632 # WARN: this code is duplicated in lib/RT/Interface/REST.pm
1633 # change both functions at once
1634 sub expand_list {
1635     my ($list) = @_;
1636
1637     my @elts;
1638     foreach (split /\s*,\s*/, $list) {
1639         push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
1640     }
1641
1642     return map $_->[0], # schwartzian transform
1643         sort {
1644             defined $a->[1] && defined $b->[1]?
1645                 # both numbers
1646                 $a->[1] <=> $b->[1]
1647                 :!defined $a->[1] && !defined $b->[1]?
1648                     # both letters
1649                     $a->[2] cmp $b->[2]
1650                     # mix, number must be first
1651                     :defined $a->[1]? -1: 1
1652         }
1653         map [ $_, (defined( /^(\d+)$/ )? $1: undef), lc($_) ],
1654         @elts;
1655 }
1656
1657 sub get_type_argument {
1658     my $type;
1659
1660     if (@ARGV) {
1661         $type = shift @ARGV;
1662         unless ($type =~ /^[A-Za-z0-9_.-]+$/) {
1663             # We want whine to mention our caller, not us.
1664             @_ = ("Invalid type '$type' specified.");
1665             goto &whine;
1666         }
1667     }
1668     else {
1669         @_ = ("No type argument specified with -t.");
1670         goto &whine;
1671     }
1672
1673     $type =~ s/s$//; # "Plural". Ugh.
1674     return $type;
1675 }
1676
1677 sub get_var_argument {
1678     my ($data) = @_;
1679
1680     if (@ARGV) {
1681         my $kv = shift @ARGV;
1682         if (my ($k, $v) = $kv =~ /^($field)=(.*)$/) {
1683             push @{ $data->{$k} }, $v;
1684         }
1685         else {
1686             @_ = ("Invalid variable specification: '$kv'.");
1687             goto &whine;
1688         }
1689     }
1690     else {
1691         @_ = ("No variable argument specified with -S.");
1692         goto &whine;
1693     }
1694 }
1695
1696 sub is_object_spec {
1697     my ($spec, $type) = @_;
1698
1699     $spec =~ s|^(?:$type/)?|$type/| if defined $type;
1700     return $spec if ($spec =~ m{^$name/(?:$idlist|$labels)(?:/.*)?$}o);
1701     return 0;
1702 }
1703
1704 sub suggest_help {
1705     my ($action, $type, $rv) = @_;
1706
1707     print STDERR "rt: For help, run 'rt help $action'.\n" if defined $action;
1708     print STDERR "rt: For help, run 'rt help $type'.\n" if defined $type;
1709     return $rv;
1710 }
1711
1712 sub str2time {
1713     # simplified procedure for parsing date, avoid loading Date::Parse
1714     my %month = (Jan => 0, Feb => 1, Mar => 2, Apr => 3, May =>  4, Jun =>  5,
1715                  Jul => 6, Aug => 7, Sep => 8, Oct => 9, Nov => 10, Dec => 11);
1716     $_ = shift;
1717     my ($mon, $day, $hr, $min, $sec, $yr, $monstr);
1718     if ( /(\w{3})\s+(\d\d?)\s+(\d\d):(\d\d):(\d\d)\s+(\d{4})/ ) {
1719         ($monstr, $day, $hr, $min, $sec, $yr) = ($1, $2, $3, $4, $5, $6);
1720         $mon = $month{$monstr} if exists $month{$monstr};
1721     } elsif ( /(\d{4})-(\d\d)-(\d\d)\s+(\d\d):(\d\d):(\d\d)/ ) {
1722         ($yr, $mon, $day, $hr, $min, $sec) = ($1, $2-1, $3, $4, $5, $6);
1723     }
1724     if ( $yr and defined $mon and $day and defined $hr and defined $sec ) {
1725         return timelocal($sec,$min,$hr,$day,$mon,$yr);
1726     } else {
1727         print "Unknown date format in parsedate: $_\n";
1728         return undef;
1729     }
1730 }
1731
1732 sub date_diff {
1733     my ($old, $new) = @_;
1734     $new = time() if ! $new;
1735     $old = str2time($old) if $old !~ /^\d+$/;
1736     $new = str2time($new) if $new !~ /^\d+$/;
1737     return "???" if ! $old or ! $new;
1738
1739     my %seconds = (min => 60,
1740                    hr  => 60*60,
1741                    day => 60*60*24,
1742                    wk  => 60*60*24*7,
1743                    mth => 60*60*24*30,
1744                    yr  => 60*60*24*365);
1745
1746     my $diff = $new - $old;
1747     my $what = 'sec';
1748     my $howmuch = $diff;
1749     for ( sort {$seconds{$a} <=> $seconds{$b}} keys %seconds) {
1750         last if $diff < $seconds{$_};
1751         $what = $_;
1752         $howmuch = int($diff/$seconds{$_});
1753     }
1754     return "$howmuch $what";
1755 }
1756
1757 sub prettyshow {
1758     my $forms = shift;
1759     my ($form) = grep { exists $_->[2]->{Queue} } @$forms;
1760     my $k = $form->[2];
1761     # dates are in local time zone
1762     if ( $k ) {
1763         print "Date: $k->{Created}\n";
1764         print "From: $k->{Requestors}\n";
1765         print "Cc: $k->{Cc}\n" if $k->{Cc};
1766         print "X-AdminCc: $k->{AdminCc}\n" if $k->{AdminCc};
1767         print "X-Queue: $k->{Queue}\n";
1768         print "Subject: [rt #$k->{id}] $k->{Subject}\n\n";
1769     }
1770     # dates in these attributes are in GMT and will be converted
1771     foreach my $form (@$forms) {
1772         my ($c, $o, $k, $e) = @$form;
1773         next if ! $k->{id} or exists $k->{Queue};
1774         if ( exists $k->{Created} ) {
1775             my ($y,$m,$d,$hh,$mm,$ss) = ($k->{Created} =~ /(\d\d\d\d)-(\d\d)-(\d\d) (\d\d):(\d\d):(\d\d)/);
1776             $m--;
1777             my $created = localtime(timegm($ss,$mm,$hh,$d,$m,$y));
1778             if ( exists $k->{Description} ) {
1779                 print "===> $k->{Description} on $created\n";
1780             }
1781         }
1782         print "$k->{Content}\n" if exists $k->{Content} and
1783                                    $k->{Content} !~ /to have no content$/ and
1784                                    ($k->{Type}||'') ne 'EmailRecord';
1785         print "$k->{Attachments}\n" if exists $k->{Attachments} and
1786                                    $k->{Attachments};
1787     }
1788 }
1789
1790 sub prettylist {
1791     my $forms = shift;
1792     my $heading = "Ticket Owner Queue    Age   Told Status Requestor Subject\n";
1793     $heading .= '-' x 80 . "\n";
1794     my (@open, @me);
1795     foreach my $form (@$forms) {
1796         my ($c, $o, $k, $e) = @$form;
1797         next if ! $k->{id};
1798         print $heading if $heading;
1799         $heading = '';
1800         my $id = $k->{id};
1801         $id =~ s!^ticket/!!;
1802         my $owner = $k->{Owner} eq 'Nobody' ? '' : $k->{Owner};
1803         $owner = substr($owner, 0, 5);
1804         my $queue = substr($k->{Queue}, 0, 5);
1805         my $subject = substr($k->{Subject}, 0, 30);
1806         my $age = date_diff($k->{Created});
1807         my $told = $k->{Told} eq 'Not set' ? '' : date_diff($k->{Told});
1808         my $status = substr($k->{Status}, 0, 6);
1809         my $requestor = substr($k->{Requestors}, 0, 9);
1810         my $line = sprintf "%6s %5s %5s %6s %6s %-6s %-9s %-30s\n",
1811             $id, $owner, $queue, $age, $told, $status, $requestor, $subject;
1812         if ( $k->{Owner} eq 'Nobody' ) {
1813             push @open, $line;
1814         } elsif ($k->{Owner} eq $config{user} ) {
1815             push @me, $line;
1816         } else {
1817             print $line;
1818         }
1819     }
1820     print "No matches found\n" if $heading;
1821     printf "========== my %2d open tickets ==========\n", scalar @me if @me;
1822     print @me if @me;
1823     printf "========== %2d unowned tickets ==========\n", scalar @open if @open;
1824     print @open if @open;
1825 }
1826
1827 __DATA__
1828
1829 Title: intro
1830 Title: introduction
1831 Text:
1832
1833     This is a command-line interface to RT 3.0 or newer.
1834
1835     It allows you to interact with an RT server over HTTP, and offers an
1836     interface to RT's functionality that is better-suited to automation
1837     and integration with other tools.
1838
1839     In general, each invocation of this program should specify an action
1840     to perform on one or more objects, and any other arguments required
1841     to complete the desired action.
1842
1843     For more information:
1844
1845         - rt help usage         (syntax information)
1846         - rt help objects       (how to specify objects)
1847         - rt help actions       (a list of possible actions)
1848         - rt help types         (a list of object types)
1849
1850         - rt help config        (configuration details)
1851         - rt help examples      (a few useful examples)
1852         - rt help topics        (a list of help topics)
1853
1854 --
1855
1856 Title: usage
1857 Title: syntax
1858 Text:
1859
1860     Syntax:
1861
1862         rt <action> [options] [arguments]
1863       or
1864         rt shell
1865
1866     Each invocation of this program must specify an action (e.g. "edit",
1867     "create"), options to modify behaviour, and other arguments required
1868     by the specified action. (For example, most actions expect a list of
1869     numeric object IDs to act upon.)
1870
1871     The details of the syntax and arguments for each action are given by
1872     "rt help <action>". Some actions may be referred to by more than one
1873     name ("create" is the same as "new", for example).  
1874
1875     You may also call "rt shell", which will give you an 'rt>' prompt at
1876     which you can issue commands of the form "<action> [options] 
1877     [arguments]".  See "rt help shell" for details.
1878
1879     Objects are identified by a type and an ID (which can be a name or a
1880     number, depending on the type). For some actions, the object type is
1881     implied (you can only comment on tickets); for others, the user must
1882     specify it explicitly. See "rt help objects" for details.
1883
1884     In syntax descriptions, mandatory arguments that must be replaced by
1885     appropriate value are enclosed in <>, and optional arguments are
1886     indicated by [] (for example, <action> and [options] above).
1887
1888     For more information:
1889
1890         - rt help objects       (how to specify objects)
1891         - rt help actions       (a list of actions)
1892         - rt help types         (a list of object types)
1893         - rt help shell         (how to use the shell)
1894
1895 --
1896
1897 Title: conf
1898 Title: config
1899 Title: configuration
1900 Text:
1901
1902     This program has two major sources of configuration information: its
1903     configuration files, and the environment.
1904
1905     The program looks for configuration directives in a file named .rtrc
1906     (or $RTCONFIG; see below) in the current directory, and then in more
1907     distant ancestors, until it reaches /. If no suitable configuration
1908     files are found, it will also check for ~/.rtrc, local/etc/rt.conf
1909     and /etc/rt.conf.
1910
1911     Configuration directives:
1912
1913         The following directives may occur, one per line:
1914
1915         - server <URL>          URL to RT server.
1916         - user <username>       RT username.
1917         - passwd <passwd>       RT user's password.
1918         - query <RT Query>      Default RT Query for list action
1919         - orderby <order>       Default RT order for list action
1920         - queue <queuename>     Default RT Queue for list action
1921         - externalauth <0|1>    Use HTTP Basic authentication
1922          explicitely setting externalauth to 0 inhibits also GSSAPI based
1923          authentication, if LWP::Authen::Negotiate (and GSSAPI) is installed
1924
1925         Blank and #-commented lines are ignored.
1926
1927     Sample configuration file contents:
1928
1929          server  https://rt.somewhere.com/
1930          # more than one queue can be given (by adding a query expression)
1931          queue helpdesk or queue=support
1932          query Status != resolved and Owner=myaccount
1933
1934
1935     Environment variables:
1936
1937         The following environment variables override any corresponding
1938         values defined in configuration files:
1939
1940         - RTUSER
1941         - RTPASSWD
1942         - RTEXTERNALAUTH
1943         - RTSERVER
1944         - RTDEBUG       Numeric debug level. (Set to 3 for full logs.)
1945         - RTCONFIG      Specifies a name other than ".rtrc" for the
1946                         configuration file.
1947         - RTQUERY       Default RT Query for rt list
1948         - RTORDERBY     Default order for rt list
1949
1950 --
1951
1952 Title: objects
1953 Text:
1954
1955     Syntax:
1956
1957         <type>/<id>[/<attributes>]
1958
1959     Every object in RT has a type (e.g. "ticket", "queue") and a numeric
1960     ID. Some types of objects can also be identified by name (like users
1961     and queues). Furthermore, objects may have named attributes (such as
1962     "ticket/1/history").
1963
1964     An object specification is like a path in a virtual filesystem, with
1965     object types as top-level directories, object IDs as subdirectories,
1966     and named attributes as further subdirectories.
1967
1968     A comma-separated list of names, numeric IDs, or numeric ranges can
1969     be used to specify more than one object of the same type. Note that
1970     the list must be a single argument (i.e., no spaces). For example,
1971     "user/root,1-3,5,7-10,ams" is a list of ten users; the same list
1972     can also be written as "user/ams,root,1,2,3,5,7,8-10".
1973     
1974     If just a number is given as object specification it will be
1975     interpreted as ticket/<number>
1976
1977     Examples:
1978
1979         1                   # the same as ticket/1
1980         ticket/1
1981         ticket/1/attachments
1982         ticket/1/attachments/3
1983         ticket/1/attachments/3/content
1984         ticket/1-3/links
1985         ticket/1-3,5-7/history
1986
1987         user/ams
1988
1989     For more information:
1990
1991         - rt help <action>      (action-specific details)
1992         - rt help <type>        (type-specific details)
1993
1994 --
1995
1996 Title: actions
1997 Title: commands
1998 Text:
1999
2000     You can currently perform the following actions on all objects:
2001
2002         - list          (list objects matching some condition)
2003         - show          (display object details)
2004         - edit          (edit object details)
2005         - create        (create a new object)
2006
2007     Each type may define actions specific to itself; these are listed in
2008     the help item about that type.
2009
2010     For more information:
2011
2012         - rt help <action>      (action-specific details)
2013         - rt help types         (a list of possible types)
2014
2015     The following actions on tickets are also possible:
2016
2017         - comment       Add comments to a ticket
2018         - correspond    Add comments to a ticket
2019         - merge         Merge one ticket into another
2020         - link          Link one ticket to another
2021         - take          Take a ticket (steal and untake are possible as well)
2022
2023     For several edit set subcommands that are frequently used abbreviations
2024     have been introduced. These abbreviations are:
2025
2026         - delete or del  delete a ticket           (edit set status=deleted)
2027         - resolve or res resolve a ticket          (edit set status=resolved)
2028         - subject        change subject of ticket  (edit set subject=string)
2029         - give           give a ticket to somebody (edit set owner=user)
2030
2031 --
2032
2033 Title: types
2034 Text:
2035
2036     You can currently operate on the following types of objects:
2037
2038         - tickets
2039         - users
2040         - groups
2041         - queues
2042
2043     For more information:
2044
2045         - rt help <type>        (type-specific details)
2046         - rt help objects       (how to specify objects)
2047         - rt help actions       (a list of possible actions)
2048
2049 --
2050
2051 Title: ticket
2052 Text:
2053
2054     Tickets are identified by a numeric ID.
2055
2056     The following generic operations may be performed upon tickets:
2057
2058         - list
2059         - show
2060         - edit
2061         - create
2062
2063     In addition, the following ticket-specific actions exist:
2064
2065         - link
2066         - merge
2067         - comment
2068         - correspond
2069         - take
2070         - steal
2071         - untake
2072         - give
2073         - resolve
2074         - delete
2075         - subject
2076
2077     Attributes:
2078
2079         The following attributes can be used with "rt show" or "rt edit"
2080         to retrieve or edit other information associated with tickets:
2081
2082         links                      A ticket's relationships with others.
2083         history                    All of a ticket's transactions.
2084         history/type/<type>        Only a particular type of transaction.
2085         history/id/<id>            Only the transaction of the specified id.
2086         attachments                A list of attachments.
2087         attachments/<id>           The metadata for an individual attachment.
2088         attachments/<id>/content   The content of an individual attachment.
2089
2090 --
2091
2092 Title: user
2093 Title: group
2094 Text:
2095
2096     Users and groups are identified by name or numeric ID.
2097
2098     The following generic operations may be performed upon them:
2099
2100         - list
2101         - show
2102         - edit
2103         - create
2104
2105 --
2106
2107 Title: queue
2108 Text:
2109
2110     Queues are identified by name or numeric ID.
2111
2112     Currently, they can be subjected to the following actions:
2113
2114         - show
2115         - edit
2116         - create
2117
2118 --
2119
2120 Title: subject
2121 Text:
2122
2123     Syntax:
2124
2125         rt subject <id> <new subject text>
2126
2127     Change the subject of a ticket whose ticket id is given.
2128
2129 --
2130
2131 Title: give
2132 Text:
2133
2134     Syntax:
2135
2136         rt give <id> <accountname>
2137
2138     Give a ticket whose ticket id is given to another user.
2139
2140 --
2141
2142 Title: steal
2143 Text:
2144
2145         rt steal <id> 
2146
2147     Steal a ticket whose ticket id is given, i.e. set the owner to myself.
2148
2149 --
2150
2151 Title: take
2152 Text:
2153
2154     Syntax:
2155
2156         rt take <id>
2157
2158     Take a ticket whose ticket id is given, i.e. set the owner to myself.
2159
2160 --
2161
2162 Title: untake
2163 Text:
2164
2165     Syntax:
2166
2167         rt untake <id>
2168
2169     Untake a ticket whose ticket id is given, i.e. set the owner to Nobody.
2170
2171 --
2172
2173 Title: resolve
2174 Title: res
2175 Text:
2176
2177     Syntax:
2178
2179         rt resolve <id>
2180
2181     Resolves a ticket whose ticket id is given.
2182
2183 --
2184
2185 Title: delete
2186 Title: del
2187 Text:
2188
2189     Syntax:
2190
2191         rt delete <id>
2192
2193     Deletes a ticket whose ticket id is given.
2194
2195 --
2196
2197 Title: logout
2198 Text:
2199
2200     Syntax:
2201
2202         rt logout
2203
2204     Terminates the currently established login session. You will need to
2205     provide authentication credentials before you can continue using the
2206     server. (See "rt help config" for details about authentication.)
2207
2208 --
2209
2210 Title: ls
2211 Title: list
2212 Title: search
2213 Text:
2214
2215     Syntax:
2216
2217         rt <ls|list|search> [options] "query string"
2218
2219     Displays a list of objects matching the specified conditions.
2220     ("ls", "list", and "search" are synonyms.)
2221
2222     The query string must be supplied as one argument.
2223
2224     if on tickets, query is in the SQL-like syntax used internally by
2225     RT. (For more information, see "rt help query".), otherwise, query
2226     is plain string with format "FIELD OP VALUE", e.g. "Name = General".
2227
2228     if query string is absent, we limit to privileged ones on users and
2229     user defined ones on groups automatically.
2230
2231     Options:
2232
2233         The following options control how much information is displayed
2234         about each matching object:
2235
2236         -i             Numeric IDs only. (Useful for |rt edit -; see examples.)
2237         -s             Short description.
2238         -l             Longer description.
2239         -f <field[s]   Display only the fields listed and the ticket id
2240
2241         In addition,
2242         
2243         -o +/-<field>  Orders the returned list by the specified field.
2244         -r             reversed order (useful if a default was given)
2245         -q queue[s]    restricts the query to the queue[s] given
2246                        multiple queues are separated by comma
2247         -S var=val     Submits the specified variable with the request.
2248         -t type        Specifies the type of object to look for. (The
2249                        default is "ticket".)
2250
2251     Examples:
2252
2253         rt ls "Priority > 5 and Status=new"
2254         rt ls -o +Subject "Priority > 5 and Status=new"
2255         rt ls -o -Created "Priority > 5 and Status=new"
2256         rt ls -i "Priority > 5"|rt edit - set status=resolved
2257         rt ls -t ticket "Subject like '[PATCH]%'"
2258         rt ls -q systems
2259         rt ls -f owner,subject
2260         rt ls -t queue 'Name = General'
2261         rt ls -t user 'EmailAddress like foo@bar.com'
2262         rt ls -t group 'Name like foo'
2263
2264 --
2265
2266 Title: show
2267 Text:
2268
2269     Syntax:
2270
2271         rt show [options] <object-ids>
2272
2273     Displays details of the specified objects.
2274
2275     For some types, object information is further classified into named
2276     attributes (for example, "1-3/links" is a valid ticket specification
2277     that refers to the links for tickets 1-3). Consult "rt help <type>"
2278     and "rt help objects" for further details.
2279
2280     If only a number is given it will be interpreted as the objects
2281     ticket/number and ticket/number/history
2282
2283     This command writes a set of forms representing the requested object
2284     data to STDOUT.
2285
2286     Options:
2287
2288         The following options control how much information is displayed
2289         about each matching object:
2290
2291         Without any formatting options prettyprinted output is generated.
2292         Giving any of the two options below reverts to raw output.
2293         -s      Short description (history and attachments only).
2294         -l      Longer description (history and attachments only).
2295
2296         In addition,
2297         -               Read IDs from STDIN instead of the command-line.
2298         -t type         Specifies object type.
2299         -f a,b,c        Restrict the display to the specified fields.
2300         -S var=val      Submits the specified variable with the request.
2301
2302     Examples:
2303
2304         rt show -t ticket -f id,subject,status 1-3
2305         rt show ticket/3/attachments/29
2306         rt show ticket/3/attachments/29/content
2307         rt show ticket/1-3/links
2308         rt show ticket/3/history
2309         rt show -l ticket/3/history
2310         rt show -t user 2
2311         rt show 2
2312
2313 --
2314
2315 Title: new
2316 Title: edit
2317 Title: create
2318 Text:
2319
2320     Syntax:
2321
2322         rt edit [options] <object-ids> set field=value [field=value] ...
2323                                        add field=value [field=value] ...
2324                                        del field=value [field=value] ...
2325
2326     Edits information corresponding to the specified objects.
2327
2328     A purely numeric object id nnn is translated into ticket/nnn
2329
2330     If, instead of "edit", an action of "new" or "create" is specified,
2331     then a new object is created. In this case, no numeric object IDs
2332     may be specified, but the syntax and behaviour remain otherwise
2333     unchanged.
2334
2335     This command typically starts an editor to allow you to edit object
2336     data in a form for submission. If you specified enough information
2337     on the command-line, however, it will make the submission directly.
2338
2339     The command line may specify field-values in three different ways.
2340     "set" sets the named field to the given value, "add" adds a value
2341     to a multi-valued field, and "del" deletes the corresponding value.
2342     Each "field=value" specification must be given as a single argument.
2343
2344     For some types, object information is further classified into named
2345     attributes (for example, "1-3/links" is a valid ticket specification
2346     that refers to the links for tickets 1-3). These attributes may also
2347     be edited. Consult "rt help <type>" and "rt help object" for further
2348     details.
2349
2350     Options:
2351
2352         -       Read numeric IDs from STDIN instead of the command-line.
2353                 (Useful with rt ls ... | rt edit -; see examples below.)
2354         -i      Read a completed form from STDIN before submitting.
2355         -o      Dump the completed form to STDOUT instead of submitting.
2356         -e      Allows you to edit the form even if the command-line has
2357                 enough information to make a submission directly.
2358         -S var=val
2359                 Submits the specified variable with the request.
2360         -t type Specifies object type.
2361         -ct content-type Specifies content type of message(tickets only).
2362
2363     Examples:
2364
2365         # Interactive (starts $EDITOR with a form).
2366         rt edit ticket/3
2367         rt create -t ticket
2368         rt create -t ticket -ct text/html
2369
2370         # Non-interactive.
2371         rt edit ticket/1-3 add cc=foo@example.com set priority=3 due=tomorrow
2372         rt ls -t tickets -i 'Priority > 5' | rt edit - set status=resolved
2373         rt edit ticket/4 set priority=3 owner=bar@example.com \
2374                          add cc=foo@example.com bcc=quux@example.net
2375         rt create -t ticket set subject='new ticket' priority=10 \
2376                             add cc=foo@example.com
2377
2378 --
2379
2380 Title: comment
2381 Title: correspond
2382 Text:
2383
2384     Syntax:
2385
2386         rt <comment|correspond> [options] <ticket-id>
2387
2388     Adds a comment (or correspondence) to the specified ticket (the only
2389     difference being that comments aren't sent to the requestors.)
2390
2391     This command will typically start an editor and allow you to type a
2392     comment into a form. If, however, you specified all the necessary
2393     information on the command line, it submits the comment directly.
2394
2395     (See "rt help forms" for more information about forms.)
2396
2397     Options:
2398
2399         -m <text>       Specify comment text.
2400         -ct <content-type> Specify content-type of comment text.
2401         -a <file>       Attach a file to the comment. (May be used more
2402                         than once to attach multiple files.)
2403         -c <addrs>      A comma-separated list of Cc addresses.
2404         -b <addrs>      A comma-separated list of Bcc addresses.
2405         -w <time>       Specify the time spent working on this ticket.
2406         -e              Starts an editor before the submission, even if
2407                         arguments from the command line were sufficient.
2408
2409     Examples:
2410
2411         rt comment -m 'Not worth fixing.' -a stddisclaimer.h 23
2412
2413 --
2414
2415 Title: merge
2416 Text:
2417
2418     Syntax:
2419
2420         rt merge <from-id> <to-id>
2421
2422     Merges the first ticket specified into the second ticket specified.
2423
2424 --
2425
2426 Title: link
2427 Text:
2428
2429     Syntax:
2430
2431         rt link [-d] <id-A> <link> <id-B>
2432
2433     Creates (or, with -d, deletes) a link between the specified tickets.
2434     The link can (irrespective of case) be any of:
2435
2436         DependsOn/DependedOnBy:     A depends upon B (or vice versa).
2437         RefersTo/ReferredToBy:      A refers to B (or vice versa).
2438         MemberOf/HasMember:         A is a member of B (or vice versa).
2439
2440     To view a ticket's links, use "rt show ticket/3/links". (See
2441     "rt help ticket" and "rt help show".)
2442
2443     Options:
2444
2445         -d      Deletes the specified link.
2446
2447     Examples:
2448
2449         rt link 2 dependson 3
2450         rt link -d 4 referredtoby 6     # 6 no longer refers to 4
2451
2452 --
2453
2454 Title: query
2455 Text:
2456
2457     RT uses an SQL-like syntax to specify object selection constraints.
2458     See the <RT:...> documentation for details.
2459     
2460     (XXX: I'm going to have to write it, aren't I?)
2461
2462     Until it exists here a short description of important constructs:
2463
2464     The two simple forms of query expressions are the constructs
2465     Attribute like Value and
2466     Attribute = Value or Attribute != Value
2467
2468     Whether attributes can be matched using like or using = is built into RT.
2469     The attributes id, Queue, Owner Priority and Status require the = or !=
2470     tests.
2471
2472     If Value is a string it must be quoted and may contain the wildcard
2473     character %. If the string does not contain white space, the quoting
2474     may however be omitted, it will be added automatically when parsing
2475     the input.
2476
2477     Simple query expressions can be combined using and, or and parentheses
2478     can be used to group expressions.
2479
2480     As a special case a standalone string (which would not form a correct
2481     query) is transformed into (Owner='string' or Requestor like 'string%')
2482     and added to the default query, i.e. the query is narrowed down.
2483
2484     If no Queue=name clause is contained in the query, a default clause
2485     Queue=$config{queue} is added.
2486
2487     Examples:
2488     Status!='resolved' and Status!='rejected'
2489     (Owner='myaccount' or Requestor like 'myaccount%') and Status!='resolved'
2490
2491 --
2492
2493 Title: form
2494 Title: forms
2495 Text:
2496
2497     This program uses RFC822 header-style forms to represent object data
2498     in a form that's suitable for processing both by humans and scripts.
2499
2500     A form is a set of (field, value) specifications, with some initial
2501     commented text and interspersed blank lines allowed for convenience.
2502     Field names may appear more than once in a form; a comma-separated
2503     list of multiple field values may also be specified directly.
2504     
2505     Field values can be wrapped as in RFC822, with leading whitespace.
2506     The longest sequence of leading whitespace common to all the lines
2507     is removed (preserving further indentation). There is no limit on
2508     the length of a value.
2509
2510     Multiple forms are separated by a line containing only "--\n".
2511
2512     (XXX: A more detailed specification will be provided soon. For now,
2513     the server-side syntax checking will suffice.)
2514
2515 --
2516
2517 Title: topics
2518 Text:
2519
2520     Syntax:
2521
2522         rt help <topic>
2523
2524     Get help on any of the following subjects:
2525
2526         - tickets, users, groups, queues.
2527         - show, edit, ls/list/search, new/create.
2528
2529         - query                                 (search query syntax)
2530         - forms                                 (form specification)
2531
2532         - objects                               (how to specify objects)
2533         - types                                 (a list of object types)
2534         - actions/commands                      (a list of actions)
2535         - usage/syntax                          (syntax details)
2536         - conf/config/configuration             (configuration details)
2537         - examples                              (a few useful examples)
2538
2539 --
2540
2541 Title: example
2542 Title: examples
2543 Text:
2544
2545     some useful examples
2546
2547     All the following list requests will be restricted to the default queue.
2548     That can be changed by adding the option -q queuename
2549
2550     List all tickets that are not rejected/resolved
2551         rt ls
2552     List all tickets that are new and do not have an owner
2553         rt ls "status=new and owner=nobody"
2554     List all tickets which I have sent or of which I am the owner
2555         rt ls myaccount
2556     List all attributes for the ticket 6977 (ls -l instead of ls)
2557         rt ls -l 6977
2558     Show the content of ticket 6977
2559         rt show 6977
2560     Show all attributes in the ticket and in the history of the ticket
2561         rt show -l 6977
2562     Comment a ticket (mail is sent to all queue watchers, i.e. AdminCc's)
2563         rt comment 6977
2564         This will open an editor and lets you add text (attribute Text:)
2565         Other attributes may be changed as well, but usually don't do that.
2566     Correspond a ticket (like comment, but mail is also sent to requestors)
2567         rt correspond 6977
2568     Edit a ticket (generic change, interactive using the editor)
2569         rt edit 6977
2570     Change the owner of a ticket non interactively
2571         rt edit 6977 set owner=myaccount
2572         or
2573         rt give 6977 account
2574         or
2575         rt take 6977
2576     Change the status of a ticket
2577         rt edit 6977 set status=resolved
2578         or
2579         rt resolve 6977
2580     Change the status of all tickets I own to resolved !!!
2581         rt ls -i owner=myaccount | rt edit - set status=resolved
2582
2583 --
2584
2585 Title: shell
2586 Text:
2587
2588     Syntax:
2589
2590         rt shell
2591
2592     Opens an interactive shell, at which you can issue commands of 
2593     the form "<action> [options] [arguments]".
2594
2595     To exit the shell, type "quit" or "exit".
2596
2597     Commands can be given at the shell in the same form as they would 
2598     be given at the command line without the leading 'rt' invocation.
2599
2600     Example:
2601         $ rt shell
2602         rt> create -t ticket set subject='new' add cc=foo@example.com
2603         # Ticket 8 created.
2604         rt> quit
2605         $
2606
2607 --
2608
2609 Title: take
2610 Title: untake
2611 Title: steal
2612 Text:
2613
2614     Syntax:
2615
2616         rt <take|untake|steal> <ticket-id>
2617
2618     Sets the owner of the specified ticket to the current user, 
2619     assuming said user has the bits to do so, or releases the 
2620     ticket.  
2621     
2622     'Take' is used on tickets which are not currently owned 
2623     (Owner: Nobody), 'steal' is used on tickets which *are* 
2624     currently owned, and 'untake' is used to "release" a ticket 
2625     (reset its Owner to Nobody).  'Take' cannot be used on
2626     tickets which are currently owned.
2627
2628     Example:
2629         alice$ rt create -t ticket set subject="New ticket"
2630         # Ticket 7 created.
2631         alice$ rt take 7
2632         # Owner changed from Nobody to alice
2633         alice$ su bob
2634         bob$ rt steal 7
2635         # Owner changed from alice to bob
2636         bob$ rt untake 7
2637         # Owner changed from bob to Nobody
2638
2639 --
2640
2641 Title: quit
2642 Title: exit
2643 Text:
2644
2645     Use "quit" or "exit" to leave the shell.  Only valid within shell 
2646     mode.
2647
2648     Example:
2649         $ rt shell
2650         rt> quit
2651         $
2652
2653 __END__
2654
2655 =head1 NAME
2656
2657 rt - command-line interface to RT 3.0 or newer
2658
2659 =head1 SYNOPSIS
2660
2661     rt help
2662
2663 =head1 DESCRIPTION
2664
2665 This script allows you to interact with an RT server over HTTP, and offers an
2666 interface to RT's functionality that is better-suited to automation and
2667 integration with other tools.
2668
2669 In general, each invocation of this program should specify an action to
2670 perform on one or more objects, and any other arguments required to complete
2671 the desired action.
2672