Skip to content

Instantly share code, notes, and snippets.

@scottwalters scottwalters/iob.pl
Created Aug 2, 2011

Embed
What would you like to do?
#!/usr/bin/env perl
#-------------------------------------------------------------------
# WebGUI is Copyright 2011 Plain Black Corporation.
#-------------------------------------------------------------------
# Please read the legal notices (docs/legal.txt) and the license
# (docs/license.txt) that came with this distribution before using
# this software.
#-------------------------------------------------------------------
# http://www.plainblack.com info@plainblack.com
#-------------------------------------------------------------------
=head1 NAME
iob.pl - Update the in/out board from the command line
=head1 SYNOPSIS
iob.pl --username --password --in --message "Good morning!"
iob.pl --username --password --out --message "Everyone, go home already"
=head1 DESCRIPTION
Clock in or out.
=head1 ARGUMENTS
=head2 --in
=head2 --out
=head2 --home
=head2 --lunch
=head2 --message
Text string.
=head2 --username
=head2 --password
This thing will remember your username and un-obscured password in your home directory.
=head2 --image
=head1 AUTHOR
Scott Walters; Copyright 2011 Plain Black Corporation.
=cut
use strict;
use warnings;
use IO::Handle;
use LWP::Simple 'get';
use Data::Dumper;
use HTTP::Cookies;
use WWW::Mechanize;
use Web::Scraper;
use List::MoreUtils 'zip';
use URI;
use Pod::Usage;
use Getopt::Long;
use Acme::State 'main';
use POSIX;
use MIME::Base64;
STDOUT->autoflush(1);
#
# init
#
# Get parameters here, including $help
GetOptions(
'help' => \my $help,
'man' => \my $man,
'username=s' => \our $username,
'password=s' => \our $password,
'in' => \my $in,
'out' => \my $out,
'home' => \my $home,
'lunch' => \my $lunch,
'message=s' => \my $message,
'image=s', => \my $image,
);
pod2usage( verbose => 1 ) if $help;
pod2usage( verbose => 2 ) if $man;
my $iob = 'http://www.plainblack.com/iob';
my $uriob = URI->new($iob) or die;
my $base_url = $uriob->scheme . '://' . $uriob->host; $base_url .= ':' . $uriob->port if $uriob->port ne '80';
warn "using url: ``$iob'' base_url: ``$base_url''";
$LWP::Simple::ua->cookie_jar( {} );
my $mech = WWW::Mechanize->new( cookie_jar => $LWP::Simple::ua->cookie_jar() );
my $response;
my $request;
my $form;
#
our %hours_by_day;
our $last_clockin;
#
# login
#
$response = $mech->get($base_url) or die;
$form = $mech->form_with_fields('username', 'identifier') or blurp( $response->decoded_content, "couldn't find login form" );
warn "username: $username password: $password";
$form->value( username => $username );
$form->value( identifier => $password );
$response = $LWP::Simple::ua->request( $request = $form->click );
$mech->_update_page($request, $response);
# just a 302 Found
# die $response->status_line if ! $response->is_success;
# warn $response->decoded_content;
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 = $LWP::Simple::ua->get( $url );
$response->code =~ m/^4/ and die $response->decoded_content;
$mech->_update_page($request, $response);
}
$response->decoded_content =~ m/Hello / or blurp($response->decoded_content, "login didn't seem to have worked" );
# didn't get redirect back to /iob so fetch there again
$response = $mech->get($iob) or die "fetch iob failed";
$mech->_update_page($request, $response);
# for my $form ($mech->forms) { warn Data::Dumper::Dumper $form }; # XXX
$message ||= ''; $message .= image($image) if $image;
$form = $mech->form_with_fields('status', 'message') or blurp( $response->decoded_content, "couldn't find iob form" );
$form->value( status => 'in' ) if $in;
$form->value( status => 'out' ) if $out;
$form->value( status => 'home' ) if $home;
$form->value( status => 'lunch' ) if $lunch;
$form->value( message => $message ) if $message;
$response = $LWP::Simple::ua->request( $request = $form->click );
$mech->_update_page($request, $response); # stuff our non-mech request/response back into mech
#
my $statuses = scraper {
process 'span', 'names[]' => scraper {
process 'span', 'inout' => '@class';
process 'div.nameBlock' => 'users[]' => scraper {
process 'div.user', 'name' => 'TEXT';
process 'div.message', 'message' => 'TEXT';
result 'name', 'message';
};
result 'users', 'inout';
};
result 'names';
}->scrape($response->decoded_content);
for my $status ( @$statuses ) {
next unless $status->{inout};
print $status->{inout}, " ------------------------\n";
for my $user ( @{ $status->{users} } ) {
printf "%-30s %-70s\n", $user->{name}, $user->{message}||'';
}
}
#
print "------------------------------------------------\n";
my $day_identifier = strftime "%Y%m%d", localtime;
if( $last_clockin and ($home or $lunch or $out) ) {
$hours_by_day{$day_identifier} += time - $last_clockin;
$last_clockin = undef;
} elsif ( $in and ! $last_clockin ) {
$last_clockin = time;
}
my @dates = sort { $b <=> $a } keys %hours_by_day;
@dates = @dates[0 .. 20] if @dates > 20;
for my $date (@dates) {
printf "%8d: %2.2f hours\n", $date, $hours_by_day{ $date } / 3600;
}
# debug
sub blurp {
my $page = shift;
my $message = shift;
warn $message if $message;
open my $outf, '>', '/tmp/debug.html' or die $!;
$outf->print($page) or die $!;
$outf->close or die $!;
# system 'lynx', '/tmp/debug.html';
}
# hullo
sub image {
my $fn = shift;
open my $fh, '<', $fn or die "reading image $fn: $!";
read $fh, my $imgdata, -s $fh;
my $excerpt = substr $imgdata, 0, 32;
my $type;
$type = 'image/gif' if $excerpt =~ m/GIF/;
$type = 'image/png' if $excerpt =~ m/PNG/;
$type = 'image/jpeg' if $excerpt =~ m/JFIF/;
$type or die "Sorry, can't figure out what type of image that is or I got no data or no image data back.";
my $str = qq{data:$type;base64,} . encode_base64($imgdata, '');
$str =~ s{(.{80})}{$1 }g;
return qq{<img src="$str">};
}
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.