From f541244184bf763517d5e79755773a0747a28bce Mon Sep 17 00:00:00 2001 From: Martyn Smith Date: Fri, 2 Nov 2007 11:34:06 +1300 Subject: [PATCH] Initial commit --- .gitignore | 2 + config.sample.yml | 9 ++ lib/WRMS.pm | 235 ++++++++++++++++++++++++++++++++++++++++++++++ lib/WRMS/WR.pm | 73 ++++++++++++++ timesheet.pl | 67 +++++++++++++ 5 files changed, 386 insertions(+) create mode 100644 .gitignore create mode 100644 config.sample.yml create mode 100644 lib/WRMS.pm create mode 100644 lib/WRMS/WR.pm create mode 100755 timesheet.pl diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..74c95b2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +config.yml +.*.swp diff --git a/config.sample.yml b/config.sample.yml new file mode 100644 index 0000000..11756c4 --- /dev/null +++ b/config.sample.yml @@ -0,0 +1,9 @@ +# copy this file to config.yml and edit +--- +username: yourwrmsusername +password: yourwrmspassword +site: https://wrms.catalyst.net.nz +wrmap: + project1meetings: 40650 + project1dev: 39905 + project2: 807 diff --git a/lib/WRMS.pm b/lib/WRMS.pm new file mode 100644 index 0000000..c360b2e --- /dev/null +++ b/lib/WRMS.pm @@ -0,0 +1,235 @@ +#!/usr/bin/perl + +package WRMS; + +use strict; +use warnings; +use Carp; +use XML::LibXML; +use WWW::Mechanize; +use WRMS::WR; +# TODO: remove Data::Dumper; +use Data::Dumper; +use File::Slurp; + +# TODO: documentation +# need to specify site +# optionally specify username/password (otherwise will be prompted) +sub new { + my ($class, $options) = @_; + + my $self = {}; + bless $self, $class; + + foreach my $key (qw(username password site login timeout)) { + $self->{$key} = $options->{$key} if exists $options->{$key}; + } + + $self->{_loggedin} = 0; + $self->{mech} = WWW::Mechanize->new(); + $self->{parser} = XML::LibXML->new(); + $self->{parser}->recover(1); + $self->{timeout} ||= 300; + + if ($self->{login}) { + $self->login(); + } + + return $self; +} + +=head2 login + + +=cut + +sub login { + my ($self, $username, $password) = @_; + + return if $self->{_loggedin}; + + $username ||= $self->{username}; + $password ||= $self->{password}; + + unless ( defined $username and defined $password ) { + $self->{_error} = qq{No username/password specified}; + return $self->{_error}; + } + + my $mech = $self->{mech}; + + $mech->get($self->{site}); + + unless ( + defined $mech->current_form() + and defined $mech->current_form()->find_input('username') + and defined $mech->current_form()->find_input('password') + ) { + $self->{_error} = qq{Couldn't find WRMS login form at $self->{site}. HTTP status was } . $self->{mech}->status; + return $self->{_error}; + } + + $mech->submit_form( + fields => { + username => $self->{username}, + password => $self->{password}, + }, + ); + + if ( $mech->response()->content() =~ m{ invalid .* username .* password }xmsi ) { + $self->{_error} = qq{Invalid username or password}; + return $self->{_error}; + } + + unless ( $mech->content() =~ m{
.*? > ([^<]*) }xms ) { + $self->{_error} = q{Couldn't determine "realname" for this WRMS instance}; + return $self->{_error}; + } + + $self->{realname} = $1; + + # get a list of saved searches + $self->{_savedsearches} = {}; + my $dom = $self->parse_page(); + foreach my $link ( $dom->findnodes('//a') ) { + if ( $link->getAttribute('href') =~ m{ style=plain .* saved_query= ( .* ) }xms ) { + my $param = $1; + map { $link->removeChild($_) } $link->findnodes('./b'); + my $name = $link->textContent; + $self->{_savedsearches}{$link->textContent} = { + param => $param, + refresh => 0, + wrlist => undef, + } + } + } + + $self->{_loggedin} = 1; + + return; +} + +sub saved_searches { + my $self = shift; + + return keys %{$self->{_savedsearches}}; +} + +sub saved_search_list { + my ($self, $search) = @_; + + unless ( exists $self->{_savedsearches}{$search} ) { + croak 'Invalid search'; + } + + $search = $self->{_savedsearches}{$search}; + + if ( defined $search->{wrlist} and (time - $search->{refresh}) < $self->{timeout} ) { + return @{$search->{wrlist}}; + } + + $search->{wrlist} = []; + + #print '/wrsearch.php?style=plain&saved_query=' + $search->{param}, ; + $self->{mech}->get('/wrsearch.php?style=plain&saved_query=' . $search->{param}); + + my $dom = $self->parse_page(); + + my ($table) = $dom->findnodes('//table/tr/th[@class="cols"]/../..'); + + if ($table) { + my $headings = []; + my $clean_sub = sub { + my $text = $_->textContent; + $text =~ s/^\s*(.*?)\s*$/$1/ms; + $text =~ s/\xa0/ /g; + return $text; + }; + + foreach my $row ( $table->findnodes('./tr/th/..') ) { + @{$headings} = map { &{$clean_sub}($_) } $row->findnodes('./th'); + } + foreach my $row ( $table->findnodes('./tr') ) { + my %data; + @data{@{$headings}} = map { &{$clean_sub}($_) } $row->findnodes('./td'); + #return unless ( exists $data{'WR #'} and $data{'WR #'} =~ /\S/ ); + next unless ( exists $data{'WR #'} and defined $data{'WR #'} ); + push @{$search->{wrlist}}, WRMS::WR->new($self, $data{'WR #'}, { brief => $data{'Description'} }); + } + } + + return @{$search->{wrlist}}; +} + + +sub add_time { + my ($self, $wr, $date, $comment, $hours) = @_; + + $self->{mech}->get('/wr.php?request_id=' . $wr . '&edit=1'); + + write_file('WRMS.html', $self->{mech}->response->content); + + $self->{mech}->submit_form( + with_fields => { + work_on => $date, + work_quantity => $hours, + work_description => $comment, + submit => 'Update', + }, + button => 'submit', + ); +} + +sub get_time { + my ($self, $wr, $justme) = @_; + + croak qq{WR '$wr' isn't a number} unless ( defined $wr and $wr =~ m{ \A \d+ \z }xms ); + + $self->{mech}->get('/wr.php?request_id=' . $wr); + + croak qq{Request '$wr' is unavailable} if ( $self->{mech}->content() =~ m{ Request .* unavailable }x ); + + my $dom = $self->parse_page(); + + my $work_data = []; + + foreach my $tr ( $dom->findnodes('//table/tr[count(td)=9]') ) { + my $data = {}; + @{$data}{qw(doneby doneon quantity rate description invoicedby charged invoicenumber chargeamount)} = map { $_->findvalue('.') } $tr->findnodes('./td'); + + if ( defined $data->{charged} and $data->{charged} =~ m{ \A (\d\d) - (\d\d) - (\d\d\d\d) \z }xms ) { + $data->{charged} = "$3-$2-$1"; + } + + if ( defined $data->{doneon} and $data->{doneon} =~ m{ \A (\d\d) - (\d\d) - (\d\d\d\d) \z }xms ) { + $data->{doneon} = "$3-$2-$1"; + push @{$work_data}, $data if ( not defined $justme or $data->{doneby} eq $self->{realname} ); + } + } + + return $work_data; +}; + +sub parse_page { + my ($self) = @_; + + my $dom; + { + local *STDERR; + open STDERR, '>', '/dev/null'; + + $dom = $self->{parser}->parse_html_string($self->{mech}->content()); + } + + return $dom if defined $dom; + + croak q{Couldn't parse '} . $self->{mech}->uri() . q{'}; +} + +sub last_error { + my ($self) = @_; + + return $self->{_error}; +} + +1; diff --git a/lib/WRMS/WR.pm b/lib/WRMS/WR.pm new file mode 100644 index 0000000..110242f --- /dev/null +++ b/lib/WRMS/WR.pm @@ -0,0 +1,73 @@ +#!/usr/bin/perl + +package WRMS::WR; + +use strict; +use warnings; +use Carp; +use XML::LibXML; +# TODO: remove Data::Dumper; +use Data::Dumper; + +my $KEYS = [qw(wr brief status detail organisation system urgency importance)]; + +# TODO: documentation +sub new { + my ($class, $wrms, $wr, $options) = @_; + + my $self = {}; + bless $self, $class; + + unless (defined $wrms and ref $wrms eq 'WRMS') { + croak 'First param must be an instance of WRMS'; + } + + unless (defined $wr and $wr =~ /^\d+$/) { + croak 'Second param must be a work request number'; + } + + foreach my $key ( @{$KEYS} ) { + $self->{data}{$key} = $options->{$key} if exists $options->{$key}; + } + + $self->{wrms} = $wrms; + $self->{data}{wr} = $wr; + + return $self; +} + +sub get { + my ($self, $key) = @_; + + croak "Unknown key '$key'" unless grep { $_ eq $key } @{$KEYS}; + + $self->fetch_data() unless defined $self->{data}{$key}; + + return $self->{data}{$key}; +} + +sub fetch_data { + my $self = shift; + + $self->{wrms}{mech}->get('/wr.php?request_id=' . $self->{data}{wr}); + + my $dom = $self->{wrms}->parse_page(); + + foreach my $tr ( $dom->findnodes('//tr/th[@class="prompt"]/..') ) { + my $key = $tr->findnodes('./th[@class="prompt"]')->[0]->textContent; + my $value = eval { $tr->findnodes('./td[@class="entry"]')->[0]->textContent; }; + + if ( $key eq 'W/R #' and $value =~ m{ Status: \s* (.*) }xms ) { + $self->{data}{status} = $1; + } + $self->{data}{brief} = $value if ( $key eq 'Brief' ); + $self->{data}{detail} = $value if ( $key eq 'Details' ); + $self->{data}{organisation} = $value if ( $key eq 'Organisation' ); + $self->{data}{system} = $value if ( $key eq 'System' ); + $self->{data}{urgency} = $value if ( $key eq 'Urgency' ); + $self->{data}{importance} = $value if ( $key eq 'Importance' ); + + } +} + +1; diff --git a/timesheet.pl b/timesheet.pl new file mode 100755 index 0000000..2c99050 --- /dev/null +++ b/timesheet.pl @@ -0,0 +1,67 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use FindBin; +use lib $FindBin::Bin . '/lib'; +use Getopt::Declare; +use YAML; +use WRMS; + +my $config = YAML::LoadFile($FindBin::Bin . '/config.yml'); + +my $args = Getopt::Declare->new(q( + [strict] + -c Write data to WRMS (by default just prints what _would_ happen) + File to proces [required] +)); + +die unless defined $args; + +my @data = YAML::LoadFile($args->{''}); + +# connect to wrms +my $wrms = WRMS->new({ + username => $config->{username}, + password => $config->{password}, + site => $config->{site}, + login => 1, +}); + +# map of textual representations for WRs +my $wrmap = $config->{wrmap}; + +my $total_time = 0; + +# loop over yaml data +foreach my $entry ( @data ) { + # don't want data with no wr + next unless defined $entry->{wr}; + + # if the wr is in the map, substitute + $entry->{wr} = $wrmap->{$entry->{wr}} if exists $wrmap->{$entry->{wr}}; + + # unless we have something that looks like a wr, skip + unless ( $entry->{wr} =~ m{ \A \d+ \z }xms ) { + warn "Invalid WR: $entry->{wr}"; + next; + } + + # unless we have some time + next unless defined $entry->{time} and $entry->{time} =~ m{ \d }xms; + + $total_time += $entry->{time}; + print $entry->{date}, " - ", $entry->{wr}, " - ", $entry->{time}, "\n"; + + next unless $args->{'-c'}; + + # add the time to wrms + $wrms->add_time( + $entry->{wr}, + $entry->{date}, + $entry->{comment}, + $entry->{time}, + ); +} + +print "Total time: $total_time\n"; -- 2.39.5