--- /dev/null
+#!/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{ <div \s+ id="top_menu" \s* > .*? > ([^<]*) }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;
--- /dev/null
+#!/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;
--- /dev/null
+#!/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)
+ <yamlfile> File to proces [required]
+));
+
+die unless defined $args;
+
+my @data = YAML::LoadFile($args->{'<yamlfile>'});
+
+# 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";
projects / tks.git / commitdiff