#!/usr/bin/env perl
our $VERSION = "0.50"; # $Id$
=head1 NAME
stanford-ticket - respond to a ticket in the leland.helpsu.* hierarchy
=head1 SYNOPSIS
stanford-ticket /tmp/respond-$$
=head1 DESCRIPTION
Responds to a news article that manages a ticket in the Stanford ticketing
system using Your Favorite Mailer (default: mutt), as described at
B. In short, it
takes the message and creates a standard reply, with these headers:
To The 'role' address
Cc The user that started this ticket
From The 'role' address
Subject Keeps its ticket information here
X-Ticket Black magick; defaults to 'close'.
The recipe to use this script from nn with 'T':
map show T (
:unset embedded-header-escape
:!! cat /dev/null > /tmp/respond
save-full "/tmp/respond
:! echo; stanford-ticket /tmp/respond
:!! rm -rf /tmp/respond
:set embedded-header-escape "~"
:redraw
)
=cut
###############################################################################
### User Variables ############################################################
###############################################################################
use vars qw( @PROG );
@PROG = ( "/usr/bin/mutt", "-F", "$ENV{HOME}/.config/mutt/muttrc.news" );
###############################################################################
### main() ####################################################################
###############################################################################
use News::Article;
use News::Article::Clean;
use strict;
use File::Temp qw/ tempfile tempdir /;
my $dir = tempdir( CLEANUP => 1 );
my ($fh, $temp) = tempfile( DIR => $dir );
my $file = shift @ARGV;
die "No such file: $file\n" unless (-r $file);
my $article = News::Article->new($file, 1024 * 1024, 1024 * 64);
die "Couldn't read article: $!\n" unless $article;
my $from = $article->header('from') || "";
$from = $article->clean_from( $from );
my $subject = $article->header('subject') || "(no subject)";
$subject = "Re: $subject";
$subject = $article->clean_subject( $subject );
my $role = "";
foreach my $to ($article->header('to'), $article->header('cc')) {
next unless $to =~ /(\S+)\@(action.*?\.stanford\.edu)\s*$/;
$role = join('@', $1, $2);
}
my $msgid = $article->header('message-id') || "";
my $refs = $article->header('references') || "";
if ($msgid) { $refs = $refs ? "$refs $msgid" : $msgid }
my $respond = $article->header('reply-to') || $article->header('from');
my @users; push @users, $respond;
push @users, "FILLMEIN\@unknown.site.invalid" unless scalar @users;
print $fh "To: $role\n";
print $fh "Cc: ", join(", ", @users), "\n" if @users;
print $fh "From: $role\n" if $role;
print $fh "Newsgroups: ", $article->header('newsgroups'), "\n";
print $fh "In-Reply-To: $msgid\n" if $msgid;
print $fh "References: $refs\n";
print $fh "Subject: $subject\n" if $subject;
print $fh "X-Ticket: close\n"; # can be overriden in mutt
print $fh "\n";
print $fh "$from writes:\n";
foreach ($article->rawheaders) { print $fh "> $_\n"; }
print $fh "\n";
foreach ($article->body) { print $fh "> $_\n"; }
my @cmd = ( @PROG, "-H", $temp );
my $response = system( @cmd );
exit 0;
###############################################################################
### Final Documentation #######################################################
###############################################################################
=head1 NOTES
All of the 'References' stuff fails in mutt, because mutt likes to generate its
own References header and won't let us generate one. That's okay, we'll live.
=head1 REQUIREMENTS
B, B
=head1 AUTHOR
Tim Skirvin
=cut