#!/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<https://www.stanford.edu/dept/its/group/unix/staff/ticket/>.  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<News::Article>, B<News::Article::Clean>

=head1 AUTHOR

Tim Skirvin <tskirvin@stanford.edu>

=cut
