Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#!/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';
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.