add Zebra support to TKS

diff --git a/lib/Zebra.pm b/lib/Zebra.pm
new file mode 100644 (file)
index 0000000..1e6c5df
--- /dev/null
+++ b/lib/Zebra.pm
@@ -0,0 +1,132 @@
+#!/usr/bin/perl
+#
+# Zebra.pm: interface with Zebra time management system
+# Copyright (C) 2009 Liip AG (http://liip.ch)
+#
+# This program is free software: you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+
+package Zebra;
+
+use strict;
+use warnings;
+use Carp;
+use JSON;
+use LWP::UserAgent;
+use HTTP::Request;
+use HTTP::Response;
+#use HTTP::Cookie;
+use Data::Dumper;
+
+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->{ua} = LWP::UserAgent->new;
+    $self->{ua}->agent('TKS Zebra Client');
+    $self->{ua}->cookie_jar( {} );
+
+    $self->{_loggedin} = 0;
+    $self->{timeout} ||= 300;
+
+    if ($self->{login}) {
+        $self->login();
+    }
+
+    return $self;
+}
+
+
+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 $req = HTTP::Request->new(POST => $self->{site} . '/login/user/'. $self->{username} . '.json');
+    $req->content_type('application/x-www-form-urlencoded');
+    $req->content("username=$username&password=$password");
+
+    my $res = $self->{ua}->request($req);
+
+    if ($res->is_error) {
+        $self->{_error} = qq(Login failed');
+        return $self->{_error};
+    }
+
+    # read our headers
+    my $location = $res->header('Location');
+    if ($location =~ /loginfail=True/) {
+        $self->{_error} = qq(Login failed);
+        return $self->{_error};
+    }
+
+    # make another request to get the json data
+    # i can't be bothered figuring out how to make LWP do this
+    $req = HTTP::Request->new(GET => $self->{site} . '/user/'. $self->{username} . '.json');
+    $res = $self->{ua}->request($req);
+
+    my $tmp = eval { return from_json($res->content)->{command}->{userinfo}; };
+    if ($@) {
+        warn Dumper($res->content);
+        $self->{_error} = qq(Login failed);
+        return $self->{_error};
+    }
+    $self->{user} = $tmp;
+    $self->{_loggedin} = 1;
+}
+
+
+sub add_time {
+    my ($self, $wr, $date, $comment, $hours, $review_needed, $subwr) = @_;
+    $subwr ||= 57; # some of them have this standard one
+
+    $date =~ m/^(\d+)\/(\d+)\/(\d+)$/;
+    my ($day, $month, $year) = ($1, $2, $3);
+
+    my $req = HTTP::Request->new(POST => $self->{site} . '/timesheet/create/.json');
+    $req->content_type('application/x-www-form-urlencoded');
+    $req->content("time=$hours&project_id=$wr&activity_id=$subwr&day=$day&month=$month&year=$year&description=$comment&state_id=final");
+
+    my $res = $self->{ua}->request($req);
+
+    if ($res->is_error) {
+        $self->{_error} = qq(Failed to post timesheet data!');
+        return $self->{_error};
+    }
+
+    my $zresponse = from_json($res->content)->{command}{response};
+
+    if ($zresponse && $zresponse->{success} && $zresponse->{success} eq 'false') {
+        $self->{_error} = qq(Failed to post timesheet data!');
+        return $self->{_error};
+    }
+    return 1;
+}
+
+
+1;

diff --git a/tks.pl b/tks.pl
index c16c3b3fe884809d188a537ae1e870df5bfa0b66..4514b301e75f3948e971891e4d3d28fd25736ad3 100755 (executable)
--- a/tks.pl
+++ b/tks.pl
@@ -65,6 +65,13 @@ my $wrmap = $config{'wrmap'};
 foreach my $date ( keys %{$tkdata} ) {
     foreach my $entry ( @{$tkdata->{$date}} ) {
         $entry->{wr} = $wrmap->{$entry->{wr}} if exists $wrmap->{$entry->{wr}};
+        # zebra support
+        if ($entry->{wr} =~ /^([\da-za-z0-9_]+)\/([\da-za-z0-9_]+)$/) {
+            $entry->{wr} = $1;
+            $entry->{subwr} = $2;
+        }
+        $entry->{subwr} = $wrmap->{$entry->{subwr}} if $entry->{subwr} && exists $wrmap->{$entry->{subwr}};
+        # end zebra support
         unless ( $entry->{wr} =~ m{ \A \d+ \z }xms ) {
             warn "Invalid WR '$entry->{wr}'\n";
             # TODO: perhaps interactively add these?
@@ -97,6 +104,7 @@ foreach my $date ( sort keys %{$tkdata} ) {
             $entry->{comment},
             $entry->{time},
             $entry->{review_needed},
+            $entry->{subwr},
         );
 
         # comment it out in the file