#! /usr/bin/perl
eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
if 0; # not running under some shell
# ABSTRACT: rtpaste - see your tickets from the command line
=head1 NAME
rtpaste - see your tickets from the command line
=head1 DESCRIPTION
Let's you pipe commands to and from request tracker tickets (L<http://bestpractical.com/rt/>)
This is more designed for colaborative programming, but there is no reason you could not use it
as part of some bigger automation
=head1 USAGE
rtpaste [COMMAND] options
=head1 COMMANDS
=cut
use strict;
use warnings;
our $DEFAULT_RT = 'http://rt.cpan.org/';
use Error qw(:try);
use RT::Client::REST;
use App::Rad; App::Rad->run();
=head2 setup - tell me your rt password
A good place to start if you've not used rtpaste before
You will be asked to do setup automatically if you have not already,
you just need to provide the url, username and password for request tracker
=cut
sub configure : Help('tell me your rt password') {
my $c=shift;
my $choice = shift;
use Term::UI;
use Term::ReadLine;
my $term = Term::ReadLine->new('brand');
my $DONE; # re-ask until doen
ASK: {
my %from_here;
@from_here {
my @choices = (
( (defined $c->config->{host} and defined $c->config->{user})
? (sprintf "Change user info (currently '%s' as %s)",
$c->config->{host},
$c->config->{user},
)
: 'Enter your details'
),
"Test user info",
my $default = (sprintf 'Write changes to %s', $c->stash->{rcfile}),
"Write config file elsewhere ...",
"leave configuration menu"
)
} = (
sub {
$c->config->{host} = $term->get_reply(
prompt => 'What is the url of your RT instance? ',
default => defined $c->config->{host} ? $c->config->{host} : $DEFAULT_RT,
print_me =>
"Where can I find request tracker?
http://rt.example.com - when rt is on the root of a domain
http://example.com/rt/ - ... or isn't
https://httpuser:httppass\@example.com/rt/
- when there is http authentication involved
"
);
$c->config->{user} = $term->get_reply(
prompt => 'What is your username? ',
default => $c->config->{user},
);
# use IO::Prompt; $c->config->{pass} = prompt('What is your password? ', -e => '*');
# use Term::ReadKey; ReadMode 'noecho'; my $password = ReadLine; # Corrected ReadMode 'normal'; chomp $password;
$term->get_reply( prompt => 'What is your password? ', default => $c->config->{pass},);
},
sub {
local $| =1;
print "Connecting to your rt...";
# "connect" to RT ...
my $rt = RT::Client::REST->new(
server => $c->config->{host},
timeout => 30,
);
try {
$rt->login(
username => $c->config->{user},
password => $c->config->{pass}
);
print "success!\n";
local $@;
my $me = eval {
$rt->show(type => 'user', id => $c->config->{user})
};
if (! $@) {
printf "You are: %s aka %s <%s> (id=%s)\n",
map defined $_? $_ : '', @{ $me }{ qw[ Name RealName EmailAddress id] };
}
} catch Exception::Class::Base with {
printf "problem logging in: %s\n", shift->message;
};
},
sub { eval { $c->write_config($c->stash->{rcfile}) } },
sub {
eval { $c->write_config(
$term->get_reply(
prompt => (
sprintf "Would you like me to write this new information to %s?",
$c->stash->{rcfile},
)
)
)
}
},
sub { $DONE =1; 'Thanks for playing.' }
);
WHAT_NOW: {
if (defined $choice) {
$from_here{ $choice }->();
undef $choice;
}
my $reply = $term->get_reply(
prompt => 'what now?',
choices => \@choices,
default => $default,
);
$from_here{ $reply }->();
redo ASK unless $DONE;
}
}
''
}
# I'm nearly a plugin
sub App::Rad::write_config {
my $c = shift;
my $path = shift;
open my $fh, '>', $path or die "can't open $path for writing: $!";
print $fh "# sorry for messing up the order of your config file ...\n";
print $fh $_, "=", $c->config->{$_}, "\n" for keys %{ $c->config };
}
# load config, sainity test it, and force the user to provide
# the details we need to be useful
sub pre_process {
my $c = shift;
# we don't need $c->stash->{rt} for setup
return if $c->cmd eq 'setup';
print <<"EO_WELCOME"
Hi there,
I'm $0, pleased to meet you!
I'm going to keep all the things you tell me in:
@{[ $c->stash->{rcfile} ]}
If you're confused, you can also check
perldoc $0
although I'll do my best to explain what happened if anything goes wrong...
ok, first thing's first
EO_WELCOME
# so, we'll go to configure, then come back and pick up where we left off
and configure($c, 'Enter your details')
# we definately need these ...
if grep {not exists $c->config->{$_}} qw[ host user pass ];
#
# settings for how a search will look by default
#
# list of column names, in order, separated by,
$c->stash->{result_columns} = [
split /,/,
( defined $c->config->{default_columns} )
? $c->config->{default_columns}
: 'id,Owner,Subject,Status,Requestors,LastUpdated'
];
# format to be used if a search doesn't have its own
$c->stash->{result_format} = expand (
( defined $c->config->{default_format} )
? $c->config->{default_format}
: '%-6s (%s) %s [%s]\n %s %s\n'
);
#
# load searches from the config...
#
# since the config parser that comes with App::Rad is simple, we just
# use _'s in the keys to specify which part of the search it is...
#
# the %s will be used as the name of the search
#
# search_%s - the conditions
# format_%s - the printf string
# columns_%s - comma list of columns to display
#
# example: to see all the tickets belonging to Acme::Meow on rt.cpan.org:
#
# search_Acme-Meow = Queue='Acme-Meow'
# columns_Acme-Meow= id,Owner,Subject,Status,Requestors,LastUpdated
# format_Acme-Meow = %-6s (%s) %s [%s]\n %s %s\n
#
# host: http://rt.cpan.org
# user: FOOLISH
# pass: toosneaky
#
#
# ./rt-ticket search Acme-Meow
#
# each config item is processed separately so they can mask the existing
# settings. (even parts of the default searches)
for my $name (keys %{ $c->config }) {
if ((my $desc = $name) =~ s/^search_//) {
# stash the query strings, as they came from the file
@{ $c->stash->{queries}->{$desc} }[0,1] = (
"[from rc]$name" => $c->config->{$name}
);
}
if ((my $desc = $name) =~ s/^format_//) {
@{ $c->stash->{queries}->{$desc} }[0,2] = (
"[from rc]$name" => expand($c->config->{$name})
)
}
if ((my $desc = $name) =~ s/^columns_//){
# split the column list and stick it in the query structure
@{ $c->stash->{queries}->{$desc} }[0,2] = (
"[from rc]$name" => [split ' ', $c->config->{$name}]
);
}
}
# "connect" to RT ...
$c->stash->{rt} = RT::Client::REST->new(
server => $c->config->{host} || $DEFAULT_RT,
timeout => 30,
);
# ... and login
try {
$c->stash->{rt}->login(
username => $c->config->{user},
password => $c->config->{pass}
);
} catch Exception::Class::Base with {
die "problem logging in: ", shift->message;
};
}
sub setup {
my $c=shift;
$c->register_commands( qw[ create ticket search get put ] );
$c->register( 'setup', \&configure, 'tell me your rt password' );
# queries contains a list of saved queries you can run against rt
# you can include some in your $c->stash->{rcfile}, they are loaded below
#
# each entry in the hash has 4 parts
# entries from the config file can overwrite the ones here
#
# $name => - this is the name that you use on the command line
# [
# $label - a nice descriptive name for the help
# $query - the tickets to search out (see Tickets > Advanced)
# $format - an sprintf format for each ticket in the result
# (\t and \t are expanded, the rest is literal
# \@columns - which columns from the ticket to pass to the format
# ]
$c->stash->{queries} = {
bookmarked => [
'(rt.cpan.org) bookmarked tickets',
q{ id = '__Bookmarked__' }
],
unowned => [
'Unowned new/open tickets',
q{ Owner = 'Nobody' AND ( Status = 'new' OR Status = 'open') }
],
mine => [
'My tickets',
q{ Owner = '__CurrentUser__'
AND ( Status = 'new' OR Status = 'open' ) }
],
};
use File::Basename ();
use File::Spec::Functions ();
my $script = File::Basename::basename($0);
# where is our rc file?
$c->stash->{rcfile} = $ENV{ (uc $script).'_RC' }
|| File::Spec::Functions::catfile (
$ENV{HOMEPATH}
|| $ENV{HOME}
|| glob ('~'),
".".$script.".rc"
);
$c->load_config( $c->stash->{rcfile} ) if -f $c->stash->{rcfile};
}
=head2 ticket C<< <id> >>
show the current status of a the ticket who's id is passed as the only argument
=cut
sub ticket :Help('Show the attributes of ticket needs one ticket id') {
my $c=shift;
my $rt = $c->stash->{rt};
my ($id) = @ARGV;
try {
# Get ticket #10
my $ticket = $rt->show(type => 'ticket', id => $id);
use Data::Dumper();print Data::Dumper::Dumper $ticket;
} catch RT::Client::REST::Exception with {
return "problem when finding ticket #$id: " . shift->message;
};
}
=head2 search C<< <query-name> >>
Show the results of pre-defined rt ticket searches.
These are specified either directly in the script, or in your C<.rc file>
without arguments, you'll be shown a list of searches
=cut
sub search :Help('Run pre-defined queries'){
my $c=shift;
my $rt = $c->stash->{rt};
my %queries = %{ $c->stash->{queries} };
my ($query_name) = @ARGV;
if (0 == @ARGV or not $queries{$query_name}) {
my $longest = -1;;
$longest = length($_) > $longest ? length($_) : $longest for keys %queries;
return "Pick a query to run $query_name:\n".
(join"",
map {
sprintf "%-${longest}s - %s\n" ,
$_, $queries{$_}[0]
} keys %queries
)
}
my ($query_desc, $query, $format, $cols) = @{ $queries{ $query_name } };
try {
# search only gives back ticket numbers, so we'll grab the tickets too
my @tickets = map {
$rt->show(type => 'ticket', id => $_)
} $rt->search(type => 'ticket', query => $query );
# print Data::Dumper::Dumper \@tickets;
for (@tickets){
printf +($format || $c->stash->{result_format}),
@{$_}{ @{ $cols || $c->stash->{result_columns} } }
}
print "All done, nice work!\n" unless @tickets;
''
} catch RT::Client::REST::Exception with {
return "failed when searching '$query': ". shift->message;
''
};
}
=head2 put
an alias of ...
=cut
sub put :Help('Alias of create') {goto &create};
=head2 create C<< --queue=I<QueueName> >> C<< --subject=I<some stuff> >> [C<< --message=I<stuff> >>] < file
creates a ticket in RT, takes
C<< --queue=I<QueueName> >> the name of the queue to create the ticket in
C<< --subject=I<some stuff> >> the subject line for your ticket
Ideally you'd start this with C<[patch]> becasue you're being super helpful
and submitting fixes for the stuff you're having trouble with
optionally C<< --message=I<stuff> >> the body of the ticket
if you don't specify this, the ticket body will be read from C<STDIN>
=cut
sub create :Help('create a ticket, requires --queue, --subject and --message') {
my $c = shift;
my $rt = $c->stash->{rt};
my $queue = $c->options->{queue};
my $subject = $c->options->{subject};
my $message = $c->options->{message};
if (not exists $c->options->{message} or $message eq '') {
warn "reading ticket contents from stdin";
$message = do { local $/; <STDIN> }
}
if ( not defined $queue or $queue eq '' ) {
$?=3; return "I need a queue to create the ticket in.";
}
if ( not defined $message or $message eq '' ) {
$?=3; return "What would you like to put in the ticket?";
}
if ( not defined $subject or $subject eq '' ) {
$?=3; return "What would you like as the subject?";
}
$rt->create(
type => 'ticket',
set => {
Queue => $queue,
Subject => $subject
},
text => $message
);
}
=head2 get C<< <id> >>
retreive the contents of the transaction that create the ticket who's id you pass
(will make some attempt to get an C<id> from a url)
=cut
sub get :Help('print the body of the message that created the ticket. needs a ticket number') {
my $c=shift;
my $rt = $c->stash->{rt};
my ($id) = @ARGV;
return "get needs a ticket id ... $0 get <id>" unless defined $id;
my $host_regex = '^'.quotemeta($c->config->{host});
$host_regex = qr($host_regex);
if ($id =~ $host_regex ) {
# this is on the rt that is in your config...
# this will get confused by https vs http
$id = $1 if $id =~ /id=(\d+)/
}
elsif ( $id =~ qr{^https?://} ) {
die "$id is not a ticket on " . $c->config->{host}
}
if ($id + 0 != $id) {
die "what the fuck is a $id?"
}
try {
my $ticket = $rt->show(type => 'ticket', id => $id);
return $rt->get_transaction (parent_id => $id, id => (
$rt->get_transaction_ids (parent_id=>$id,
transaction_type =>'Create' ,
))[0]
)->{Content};
} catch RT::Client::REST::Exception with {
return "problem when finding ticket #$id: " . shift->message;
}
}
=head1 FILES/ENVIRONMENT
=head2 C<~/.rtpaste.rc>
you can also set C<$RTPASTE_RC> in your environment to point to a config file instead
internally the script's name (C<$0>) is used to determine both the name for the rc file and the environment variable used to override it...
=head2 symlink trickery
for example:
ln -s mycorp-tickets rtpaste
... will lead to C<mycorp-tickets> checking for C<~/.mycorp-tickets.rc> and looking for C<MYCORP-TICKETS_RC> in the environment
This is the least pesky way I could think of to use many differing RT's as the same user,
this can be done in your own C<~/bin> (as long as it's in C<$PATH>) or globally by root...
There is no global config file, although you can replace C<$DEFAULT_RT> in the script ...
=cut
# expand \t, \n and \\ in formats
sub expand {
my ($string) = @_;#@return = @_;
s/(\\[tn\\])/{'\\\\' => '\\','\n' => "\n",'\r' => "\t"}->{$1}/ge
for $string;
$string
}
sub spit {
my $c = shift;
use Data::Dumper ();
delete $c->stash->{rt};
Data::Dumper::Dumper( [$c->config, $c->stash] );
}