projects / freeside.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Merge branch 'master' of git.freeside.biz:/home/git/freeside
[freeside.git] / rt / bin / rt.in
diff --git a/rt/bin/rt.in b/rt/bin/rt.in
index aa3ac33..4a3eada 100644 (file)
--- a/rt/bin/rt.in
+++ b/rt/bin/rt.in
@@ -1,41 +1,41 @@
 #!@PERL@ -w
 # BEGIN BPS TAGGED BLOCK {{{
 #!@PERL@ -w
 # BEGIN BPS TAGGED BLOCK {{{
-# 
+#
 # COPYRIGHT:
 # COPYRIGHT:
-# 
-# This software is Copyright (c) 1996-2009 Best Practical Solutions, LLC
-#                                          <jesse@bestpractical.com>
-# 
+#
+# This software is Copyright (c) 1996-2013 Best Practical Solutions, LLC
+#                                          <sales@bestpractical.com>
+#
 # (Except where explicitly superseded by other copyright notices)
 # (Except where explicitly superseded by other copyright notices)
-# 
-# 
+#
+#
 # LICENSE:
 # 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 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.
 # 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.
 # 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:
 # 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.)
 # (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
 # 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
@@ -44,12 +44,19 @@
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
 # royalty-free, perpetual, license to use, copy, create derivative
 # works based on those contributions, and sublicense and distribute
 # those contributions and any derivatives thereof.
-# 
+#
 # END BPS TAGGED BLOCK }}}
 # Designed and implemented for Best Practical Solutions, LLC by
 # Abhijit Menon-Sen <ams@wiw.org>
 
 use strict;
 # END BPS TAGGED BLOCK }}}
 # Designed and implemented for Best Practical Solutions, LLC by
 # Abhijit Menon-Sen <ams@wiw.org>
 
 use strict;
+use warnings;
+
+if ( $ARGV[0] && $ARGV[0] =~ /^(?:--help|-h)$/ ) {
+    require Pod::Usage;
+    print Pod::Usage::pod2usage( { verbose => 2 } );
+    exit;
+}
 
 # This program is intentionally written to have as few non-core module
 # dependencies as possible. It should stay that way.
 
 # This program is intentionally written to have as few non-core module
 # dependencies as possible. It should stay that way.
@@ -61,6 +68,7 @@ use HTTP::Request::Common;
 use HTTP::Headers;
 use Term::ReadLine;
 use Time::Local; # used in prettyshow
 use HTTP::Headers;
 use Term::ReadLine;
 use Time::Local; # used in prettyshow
+use File::Temp;
 
 # strong (GSSAPI based) authentication is supported if the server does provide
 # it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
 
 # strong (GSSAPI based) authentication is supported if the server does provide
 # it and the perl modules GSSAPI and LWP::Authen::Negotiate are installed
@@ -98,7 +106,7 @@ my %config = (
     config_from_file($ENV{RTCONFIG} || ".rtrc"),
     config_from_env()
 );
     config_from_file($ENV{RTCONFIG} || ".rtrc"),
     config_from_env()
 );
-my $session = new Session("$HOME/.rt_sessions");
+my $session = Session->new("$HOME/.rt_sessions");
 my $REST = "$config{server}/REST/1.0";
 $no_strong_auth = 'switched off by externalauth=0'
     if defined $config{externalauth};
 my $REST = "$config{server}/REST/1.0";
 $no_strong_auth = 'switched off by externalauth=0'
     if defined $config{externalauth};
@@ -113,9 +121,9 @@ sub DEBUG { warn @_ if $config{debug} >= shift }
 # (XXX: Ask Autrijus how i18n changes these definitions.)
 
 my $name    = '[\w.-]+';
 # (XXX: Ask Autrijus how i18n changes these definitions.)
 
 my $name    = '[\w.-]+';
-my $CF_name = '[\sa-z0-9_ :()/-]+';
+my $CF_name = '[^,]+?';
 my $field   = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
 my $field   = '(?i:[a-z][a-z0-9_-]*|C(?:ustom)?F(?:ield)?-'.$CF_name.'|CF\.\{'.$CF_name.'\})';
-my $label   = '[a-zA-Z0-9@_.+-]+';
+my $label   = '[^,\\/]+';
 my $labels  = "(?:$label,)*$label";
 my $idlist  = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
 
 my $labels  = "(?:$label,)*$label";
 my $idlist  = '(?:(?:\d+-)?\d+,)*(?:\d+-)?\d+';
 
@@ -179,7 +187,7 @@ exit handler();
 
 sub shell {
     $|=1;
 
 sub shell {
     $|=1;
-    my $term = new Term::ReadLine 'RT CLI';
+    my $term = Term::ReadLine->new('RT CLI');
     while ( defined ($_ = $term->readline($prompt)) ) {
         next if /^#/ || /^\s*$/;
 
     while ( defined ($_ = $term->readline($prompt)) ) {
         next if /^#/ || /^\s*$/;
 
@@ -414,7 +422,7 @@ sub show {
         }
         elsif (my $spec = is_object_spec($_, $type)) {
             push @objects, $spec;
         }
         elsif (my $spec = is_object_spec($_, $type)) {
             push @objects, $spec;
-            $rawprint = 1 if $_ =~ /\/content$/ or $_ !~ /^ticket/;
+            $rawprint = 1 if $_ =~ /\/content$/ or $_ =~ /\/links/ or $_ !~ /^ticket/;
         }
         else {
             my $datum = /^-/ ? "option" : "argument";
         }
         else {
             my $datum = /^-/ ? "option" : "argument";
@@ -899,11 +907,6 @@ sub link {
     
     if (@ARGV == 3) {
         my ($from, $rel, $to) = @ARGV;
     
     if (@ARGV == 3) {
         my ($from, $rel, $to) = @ARGV;
-        if ($from !~ /^\d+$/ || $to !~ /^\d+$/) {
-            my $bad = $from =~ /^\d+$/ ? $to : $from;
-            whine "Invalid $type ID '$bad' specified.";
-            $bad = 1;
-        }
         if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
             whine "Invalid link '$rel' for type $type specified.";
             $bad = 1;
         if (($type eq "ticket") && ( ! exists $ltypes{lc $rel})) {
             whine "Invalid link '$rel' for type $type specified.";
             $bad = 1;
@@ -966,12 +969,8 @@ sub take {
 sub grant {
     my ($cmd) = @_;
 
 sub grant {
     my ($cmd) = @_;
 
-    my $revoke = 0;
-    while (@ARGV) {
-    }
-
-    $revoke = 1 if $cmd->{action} eq 'revoke';
-    return 0;
+    whine "$cmd is unimplemented.";
+    return 1;
 }
 
 # Client <-> Server communication.
 }
 
 # Client <-> Server communication.
@@ -984,7 +983,7 @@ sub grant {
 sub submit {
     my ($uri, $content) = @_;
     my ($req, $data);
 sub submit {
     my ($uri, $content) = @_;
     my ($req, $data);
-    my $ua = new LWP::UserAgent(agent => "RT/3.0b", env_proxy => 1);
+    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?
     my $h = HTTP::Headers->new;
 
     # Did the caller specify any data to send with the request?
@@ -1164,44 +1163,40 @@ sub submit {
     sub load {
         my ($self, $file) = @_;
         $file ||= $self->{file};
     sub load {
         my ($self, $file) = @_;
         $file ||= $self->{file};
-        local *F;
-
-        open(F, $file) && do {
-            $self->{file} = $file;
-            my $sids = $self->{sids} = {};
-            while (<F>) {
-                chomp;
-                next if /^$/ || /^#/;
-                next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
-                my ($server, $user, $cookie) = split / /, $_;
-                $sids->{$server}{$user} = $cookie;
-            }
-            return 1;
-        };
-        return 0;
+
+        open( my $handle, '<', $file ) or return 0;
+
+        $self->{file} = $file;
+        my $sids = $self->{sids} = {};
+        while (<$handle>) {
+            chomp;
+            next if /^$/ || /^#/;
+            next unless m#^https?://[^ ]+ \w+ [^;,\s]+=[0-9A-Fa-f]+$#;
+            my ($server, $user, $cookie) = split / /, $_;
+            $sids->{$server}{$user} = $cookie;
+        }
+        return 1;
     }
 
     # Writes the current session cache to the specified file.
     sub save {
         my ($self, $file) = shift;
         $file ||= $self->{file};
     }
 
     # Writes the current session cache to the specified file.
     sub save {
         my ($self, $file) = shift;
         $file ||= $self->{file};
-        local *F;
-
-        open(F, ">$file") && do {
-            my $sids = $self->{sids};
-            foreach my $server (keys %$sids) {
-                foreach my $user (keys %{ $sids->{$server} }) {
-                    my $sid = $sids->{$server}{$user};
-                    if (defined $sid) {
-                        print F "$server $user $sid\n";
-                    }
+
+        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(F);
-            chmod 0600, $file;
-            return 1;
-        };
-        return 0;
+        }
+        close($handle);
+        chmod 0600, $file;
+        return 1;
     }
 
     sub DESTROY {
     }
 
     sub DESTROY {
@@ -1347,7 +1342,7 @@ sub Form::compose {
                         $line .= ",\n$sp$v";
                     }
                     else {
                         $line .= ",\n$sp$v";
                     }
                     else {
-                        $line = $line ? "$line, $v" : "$key: $v";
+                        $line = $line ? "$line,$v" : "$key: $v";
                     }
                 }
 
                     }
                 }
 
@@ -1415,7 +1410,7 @@ sub config_from_file {
         }
 
         # Still nothing? We'll fall back to some likely defaults.
         }
 
         # Still nothing? We'll fall back to some likely defaults.
-        for ("$HOME/$rc", "/etc/rt.conf") {
+        for ("$HOME/$rc", "@LOCAL_ETC_PATH@/rt.conf", "/etc/rt.conf") {
             return parse_config_file($_) if (-r $_);
         }
     }
             return parse_config_file($_) if (-r $_);
         }
     }
@@ -1429,19 +1424,19 @@ sub parse_config_file {
     my ($file) = @_;
     local $_; # $_ may be aliased to a constant, from line 1163
 
     my ($file) = @_;
     local $_; # $_ may be aliased to a constant, from line 1163
 
-    open(CFG, $file) && do {
-        while (<CFG>) {
-            chomp;
-            next if (/^#/ || /^\s*$/);
+    open( my $handle, '<', $file ) or return;
 
 
-            if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
-                $cfg{$1} = $2;
-            }
-            else {
-                die "rt: $file:$.: unknown configuration directive.\n";
-            }
+    while (<$handle>) {
+        chomp;
+        next if (/^#/ || /^\s*$/);
+
+        if (/^(externalauth|user|passwd|server|query|orderby|queue)\s+(.*)\s?$/) {
+            $cfg{$1} = $2;
         }
         }
-    };
+        else {
+            die "rt: $file:$.: unknown configuration directive.\n";
+        }
+    }
 
     return %cfg;
 }
 
     return %cfg;
 }
@@ -1473,16 +1468,19 @@ sub read_passwd {
 
 sub vi {
     my ($text) = @_;
 
 sub vi {
     my ($text) = @_;
-    my $file = "/tmp/rt.form.$$";
     my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
 
     my $editor = $ENV{EDITOR} || $ENV{VISUAL} || "vi";
 
-    local *F;
     local $/ = undef;
 
     local $/ = undef;
 
-    open(F, ">$file") || die "$file: $!\n"; print F $text; close(F);
-    system($editor, $file) && die "Couldn't run $editor.\n";
-    open(F, $file) || die "$file: $!\n"; $text = <F>; close(F);
-    unlink($file);
+    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;
 }
 
     return $text;
 }
@@ -1514,7 +1512,7 @@ sub vsplit {
         # XXX: This should become a real parser, à la Text::ParseWords.
         $line =~ s/^\s+//;
         $line =~ s/\s+$//;
         # XXX: This should become a real parser, à la Text::ParseWords.
         $line =~ s/^\s+//;
         $line =~ s/\s+$//;
-        my ( $a, $b ) = split /,/, $line, 2;
+        my ( $a, $b ) = split /\s*,\s*/, $line, 2;
 
         while ($a) {
             no warnings 'uninitialized';
 
         while ($a) {
             no warnings 'uninitialized';
@@ -1522,7 +1520,7 @@ sub vsplit {
                 my $s = $a;
                 while ( $a !~ /'$/ || (   $a !~ /(\\\\)+'$/
                             && $a =~ /(\\)+'$/ )) {
                 my $s = $a;
                 while ( $a !~ /'$/ || (   $a !~ /(\\\\)+'$/
                             && $a =~ /(\\)+'$/ )) {
-                    ( $a, $b ) = split /,/, $b, 2;
+                    ( $a, $b ) = split /\s*,\s*/, $b, 2;
                     $s .= ',' . $a;
                 }
                 push @words, $s;
                     $s .= ',' . $a;
                 }
                 push @words, $s;
@@ -1531,7 +1529,7 @@ sub vsplit {
                 my $s = $a;
                 while ( $a !~ /}$/ ) {
                     ( $a, $b ) =
                 my $s = $a;
                 while ( $a !~ /}$/ ) {
                     ( $a, $b ) =
-                      split /,/, $b, 2;
+                      split /\s*,\s*/, $b, 2;
                     $s .= ',' . $a;
                 }
                 $s =~ s/^q{/'/;
                     $s .= ',' . $a;
                 }
                 $s =~ s/^q{/'/;
@@ -1541,7 +1539,7 @@ sub vsplit {
             else {
                 push @words, $a;
             }
             else {
                 push @words, $a;
             }
-            ( $a, $b ) = split /,/, $b, 2;
+            ( $a, $b ) = split /\s*,\s*/, $b, 2;
         }
 
 
         }
 
 
@@ -1556,7 +1554,7 @@ sub expand_list {
     my ($list) = @_;
 
     my @elts;
     my ($list) = @_;
 
     my @elts;
-    foreach (split /,/, $list) {
+    foreach (split /\s*,\s*/, $list) {
         push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
     }
 
         push @elts, /^(\d+)-(\d+)$/? ($1..$2): $_;
     }
 
@@ -1702,7 +1700,7 @@ sub prettyshow {
         }
         print "$k->{Content}\n" if exists $k->{Content} and
                                    $k->{Content} !~ /to have no content$/ and
         }
         print "$k->{Content}\n" if exists $k->{Content} and
                                    $k->{Content} !~ /to have no content$/ and
-                                   $k->{Type} ne 'EmailRecord';
+                                   ($k->{Type}||'') ne 'EmailRecord';
         print "$k->{Attachments}\n" if exists $k->{Attachments} and
                                    $k->{Attachments};
     }
         print "$k->{Attachments}\n" if exists $k->{Attachments} and
                                    $k->{Attachments};
     }
@@ -1751,10 +1749,7 @@ Title: intro
 Title: introduction
 Text:
 
 Title: introduction
 Text:
 
-     ** THIS IS AN UNSUPPORTED PREVIEW RELEASE **
-     ** PLEASE REPORT BUGS TO rt-bugs@bestpractical.com **
-
-    This is a command-line interface to RT 3.0 or newer
+    This is a command-line interface to RT 3.0 or newer.
 
     It allows you to interact with an RT server over HTTP, and offers an
     interface to RT's functionality that is better-suited to automation
 
     It allows you to interact with an RT server over HTTP, and offers an
     interface to RT's functionality that is better-suited to automation
@@ -1829,7 +1824,8 @@ Text:
     The program looks for configuration directives in a file named .rtrc
     (or $RTCONFIG; see below) in the current directory, and then in more
     distant ancestors, until it reaches /. If no suitable configuration
     The program looks for configuration directives in a file named .rtrc
     (or $RTCONFIG; see below) in the current directory, and then in more
     distant ancestors, until it reaches /. If no suitable configuration
-    files are found, it will also check for ~/.rtrc and /etc/rt.conf.
+    files are found, it will also check for ~/.rtrc, @LOCAL_ETC_PATH@/rt.conf
+    and /etc/rt.conf.
 
     Configuration directives:
 
 
     Configuration directives:
 
@@ -1908,8 +1904,6 @@ Text:
         ticket/1-3,5-7/history
 
         user/ams
         ticket/1-3,5-7/history
 
         user/ams
-        user/ams/rights
-        user/ams,rai,1/rights
 
     For more information:
 
 
     For more information:
 
@@ -2027,20 +2021,6 @@ Text:
         - edit
         - create
 
         - edit
         - create
 
-    In addition, the following type-specific actions exist:
-
-        - grant
-        - revoke
-
-    Attributes:
-
-        The following attributes can be used with "rt show" or "rt edit"
-        to retrieve or edit other information associated with users and
-        groups:
-
-        rights                  Global rights granted to this user.
-        rights/<queue>          Queue rights for this user.
-
 --
 
 Title: queue
 --
 
 Title: queue
@@ -2159,7 +2139,7 @@ Text:
     ("ls", "list", and "search" are synonyms.)
 
     Conditions are expressed in the SQL-like syntax used internally by
     ("ls", "list", and "search" are synonyms.)
 
     Conditions are expressed in the SQL-like syntax used internally by
-    RT3. (For more information, see "rt help query".) The query string
+    RT. (For more information, see "rt help query".) The query string
     must be supplied as one argument.
 
     (Right now, the server doesn't support listing anything but tickets.
     must be supplied as one argument.
 
     (Right now, the server doesn't support listing anything but tickets.
@@ -2383,16 +2363,10 @@ Text:
 
 --
 
 
 --
 
-Title: grant
-Title: revoke
-Text:
-
---
-
 Title: query
 Text:
 
 Title: query
 Text:
 
-    RT3 uses an SQL-like syntax to specify object selection constraints.
+    RT uses an SQL-like syntax to specify object selection constraints.
     See the <RT:...> documentation for details.
     
     (XXX: I'm going to have to write it, aren't I?)
     See the <RT:...> documentation for details.
     
     (XXX: I'm going to have to write it, aren't I?)
@@ -2587,3 +2561,24 @@ Text:
         $ rt shell
         rt> quit
         $
         $ rt shell
         rt> quit
         $
+
+__END__
+
+=head1 NAME
+
+rt - command-line interface to RT 3.0 or newer
+
+=head1 SYNOPSIS
+
+    rt help
+
+=head1 DESCRIPTION
+
+This script allows you to interact with an RT server over HTTP, and offers an
+interface to RT's functionality that is better-suited to automation and
+integration with other tools.
+
+In general, each invocation of this program should specify an action to
+perform on one or more objects, and any other arguments required to complete
+the desired action.
+
Freeside billing, trouble ticketing, network monitoring and provisioning