ticket.pl

#!/usr/bin/perl

# creates reports on WebGUI (tm) helpdesks from the command line using $EDITOR
# supposed to automatically close them but doesn't do that yet

# todo:
# o. change ticket status to 'resolved' automatically, optionally
# o. do a git log to find the last hash and commit comment?
# o. <perlDreamer> start with /data/WebGUI/sbin/_utility.skeleton

use strict;
use warnings;

use IO::Handle;
use LWP::Simple '$ua', 'get';
use Data::Dumper;
use HTTP::Cookies;
use WWW::Mechanize;
use Web::Scraper;
use List::MoreUtils 'zip';
use URI;

#
# init
#

sub usage () { "give webgui.org username and password:  $0 <username> <password> [7|8|tracker-url]"  }

my $username = shift @ARGV or die usage;
my $password = shift @ARGV or die usage;
my $tracker = shift @ARGV || 'http://www.webgui.org/use/bugs/tracker?func=add;class=WebGUI::Asset::Ticket';

$tracker = 'http://www.webgui.org/use/bugs/tracker?func=add;class=WebGUI::Asset::Ticket' if $tracker eq '7';
$tracker = 'http://www.webgui.org/community/webgui-8/issues?func=add;class=WebGUI::Asset::Ticket' if $tracker eq '8';

my $uriob = URI->new($tracker) or die;
my $base_url = $uriob->scheme . '://' . $uriob->host;  $base_url .= ':' . $uriob->port if $uriob->port ne '80';

warn "using url: ``$tracker''  base_url: ``$base_url''";

$ua->cookie_jar( {} );

my $mech = WWW::Mechanize->new( cookie_jar => $ua->cookie_jar() );

my $request;
my $response;
my $form;


#
# login
#

$response = $mech->get($base_url) or die;

sub find_form { 
    my $p = shift;
    for my $form ($mech->forms) {
        no warnings 'uninitialized';
        local $_ = $form;
        return $form if $p->($form);
    };
    die "login form not found";
}

# $form = find_form(sub { $_->value('method') eq 'login' }); # this stopped working and it isn't fantastic anyway
$form = $mech->form_with_fields('username', 'identifier') or die "couldn't find login form";
$form->value( username => $username );
$form->value( identifier => $password );

$response = $ua->request( $request = $form->click );
$mech->_update_page($request, $response);

# but we don't get directed back to the page we want anyway

die $response->status_line . "\n" . $response->decoded_content if ! $response->is_success and $response->code != 302;

if($response->code == 302) {
   # XXX I think LWP can be set to automatically follow these redirects
   my $url = $response->header('Location') or die;
   warn "redirected to url $url";
   $response = $ua->get( $url );
   $response->code =~ m/^4/ and die;
}

$response->decoded_content =~ m/Hello / or die "login didn't seem to have worked";

#
# parse out the labels from before the form elements so we can explain these things in plain English
#

$response = $mech->get($tracker) or die;

my $scraped_forms = scraper {
    process 'form', 'forms[]' => scraper {
        process 'tr',                     'input[]' => scraper {
            process 'label',                   'label'  => 'TEXT';
            process 'input, select, textarea', 'name'   => '@name';
            result 'label', 'name';
        };
        result 'forms';
    };
}->scrape($response->decoded_content)->{forms};

my $name_to_label;
my $label_to_name;

for my $form ( @$scraped_forms ) {
    next unless $form->{input};
    for my $input (@{$form->{input}}) {
        no warnings 'uninitialized';
        warn "parsing out labels:  name: ``$input->{name}'' label: ``$input->{label}''";
        $name_to_label->{ $input->{name} } = $input->{label} if defined $input->{label};
        $label_to_name->{ $input->{label} } = $input->{name} if defined $input->{name};
    }
}

#
# write a little temporary file and sic $EDITOR on it
#

my $tempfn = "/tmp/$$.txt";

open my $editmefh, '>', $tempfn or die $!;

$form = find_form(sub { $_[0]->value('func') eq 'editSave' }) or die;

for my $input ($form->inputs) {
    next unless exists $name_to_label->{ $input->name };  # if it doesn't have a label, it isn't interesting to us
    next if $input->name eq '__storageId_action'; # XX not currently uploading from here
    my $default_value = (defined $input->value and length $input->value) ? $input->value : '';
    $editmefh->print( '* ', $name_to_label->{ $input->name }, ": $default_value\n" );
    if(grep $input->type eq $_, qw/option radio checkbox/) {
        $editmefh->print("# options: \n");
        my @labels = $input->possible_values;
        my @descs = $input->value_names;
        while(@labels) {
            my $label = shift @labels;
            my $desc = shift @descs;
            $editmefh->print("# $label ($desc)\n");
        }
    }
    $editmefh->print( "\n" );
}

close $editmefh;

system $ENV{EDITOR}||'vi', $tempfn and die $?;

open $editmefh, '<', $tempfn or die $!;

my $buffer = join '', grep m/^[^#]/, readline $editmefh;

while( $buffer =~ m/\G\* (.*?):\s*(.*?)(?=(?:$)|(?:\* ))/cgs ) {
    (my $key, my $value) = ($1, $2);
    $value =~ s/[\r\n]+$//;  $value .= "\n" if $value =~ m/\n/; # no trailing newlines unless it has newlines in the middle
    my $name = $label_to_name->{$key} or die "key ``$key'' not a label for any of the form fields";
    warn "key: $key field: $name value: $value\n";
    $form->value( $name => $value );
}

#
# create the new ticket
#

warn "posting in 5: \n";
for(reverse 1..5) {
    sleep 1;
    STDERR->print($_, ' '); STDERR->flush;
}

$response = $ua->request( $form->click );

eval {

    #
    # follow the link to the newly created ticket
    #

    $mech->_update_page($form->click, $response);  # stuff our non-mech request/response back into mech

    # Your ticket has been submitted and will be assigned to one of our technical staff shortly. <br /><div style="text-align:center;"><a href="/use/bug +s/tracker">View All Tickets</a>&nbsp;|&nbsp;<a href="/use/bugs/tracker/11765">View Ticket</a></div>. 

    $mech->follow_link( text_regex => qr/View Ticket/i );

    #
    # close the ticket (n'yet)
    #

    # this is currently blowing up inside WWW::Mechanize; don't let that keep us from showing the output, below

    my $close_ticket_url = $response->request->uri;
    warn "close ticket url before munge:  $close_ticket_url";
    $close_ticket_url =~ s/\?func.*//;
    $close_ticket_url .= '?func=saveFormField;fieldId=ticketStatus;value=confirmed';
    # similar to:  /use/bugs/tracker/11735?func=saveFormField;fieldId=ticketStatus;value=confirmed

    warn "close ticket url:  $close_ticket_url";

    # XXX but don't actually do it

};

#
# save and view the result for debugging/status reporting
#

blurp( $response->decoded_content );

sub blurp {
    my $page = shift;
    open my $outf, '>', '/tmp/debug.html' or die $!;
    $outf->print($page) or die $!;
    $outf->close or die $!;
    # system 'lynx', '/tmp/debug.html';
}

__DATA__

    # warn join ' ', $input->name, $input->type, $input->value, $labels_for_form_elements->label($input->name);
    # warn Dumper [ $input->possible_values, $input->value_names ] if $input->type eq 'option' or $input->type eq 'radio' or $input->type eq 'checkbox';