WWW::Velib - Download account information from the Velib website

  use WWW::Velib;

  my $v = WWW::Velib->new(login => '0000123456', password => '1234');
  $v->get_month;
  for my $trip ($v->trips) {
    print $trip->date, ' from ', $trip->from,
        ' to ', $trip->to, "\n";
  }

# Velib.pm - WWW::Velib
#
# Copyright (c) 2007 David Landgren
# All rights reserved

package WWW::Velib;
use strict;

use vars qw/$VERSION/;
$VERSION = '0.05';

use WWW::Mechanize;
use WWW::Velib::Trip;

use constant HOST      => 'https://abo-paris.cyclocity.fr/';
use constant LOGIN_URL => HOST . 'service/login';
use constant ACCT_URL  => HOST . 'service/myaccount';
use constant MONTH_URL => HOST . 'service/myaccount/month';

sub new {
    my $class = shift;
    my $self  = {};

    pop @_ if @_ % 2; # discard last odd garbage element so we can hashify
    my %arg = @_;

    if (@_ == 2) {
        for (1..2) {
            my $value = shift;
            $value =~ /\A(\d{10})\z/ and $self->{login} = $1;
            $value =~ /\A(\d{4})\z/  and $self->{pin}   = $1;
        }
    }

    exists $arg{login} and $self->{login} = delete $arg{login};
    exists $arg{defer} and $self->{defer} = delete $arg{defer};
    exists $arg{cache_dir} and $self->{cache_dir} = delete $arg{cache_dir};

    # pin takes priority over password as a named param
    exists $arg{password} and $self->{pin} = delete $arg{password};
    exists $arg{pin}      and $self->{pin} = delete $arg{pin};

    for my $key (qw(login pin)) {
        exists $self->{$key} or $self->{defer} or do {
            require Carp;
            Carp::croak("No $key parameter specified in new()\n");
        };
    }
    $self->{mech} = WWW::Mechanize->new or do {
        require Carp;
        Carp::croak("Failed to build WWW::Mechanizer object\n");
    };
    $self->{mech}->env_proxy();
    $self->{connected} = 0;

    bless $self, $class;
    if ($self->{defer}) {
        $arg{myaccount} and $self->myaccount(delete $arg{myaccount});
        $arg{month}     and $self->get_month(delete $arg{month});
    }
    else {
        $self->_connect();
    }

    return $self;
}

sub _slurp {
    my $file = shift;
    local $/ = undef;
    open IN, $file or do {
        require Carp;
        Carp::croak("Cannot open $file for input: $!\n");
    };
    my $contents = <IN>;
    close IN;
    return $contents;
}

{
    my $timestamp;
    sub _out {
        my $html      = shift;
        my $cache_dir = shift;
        my $prefix    = shift;
        $timestamp  ||= sub {sprintf "%04d%02d%02d-%02d%02d%02d",
            $_[5]+1900, $_[4]+1, reverse(@_[0..3])}->(localtime);
        my $file = "$cache_dir/$prefix.$timestamp";
        open my $out, '>', $file;
        if ($out) {
            print $out $html;
            close $out;
        }
    }
}

sub _connect {
    my $self = shift;
    my $m = $self->{mech};

    $m->get(HOST . '/service/login');
    $self->{html}{initial} = $m->content;
    $self->{connected}     = 1;

    $m->form_number(4);
    $m->current_form->value('Login', $self->{login});
    $m->current_form->value('Password', $self->{pin});
    $m->click('LoginButton');

    $m->get(HOST . '/service/myaccount');
    $self->{html}{myaccount} = $m->content;
    if ($self->{cache_dir} and -d $self->{cache_dir}) {
        _out($self->{html}{myaccount}, $self->{cache_dir}, 'myaccount');
    }

    $self->_myaccount_parse;
}

sub get_month {
    my $self = shift;
    if (defined(my $file = shift)) {
        $self->{html}{month} = _slurp($file);
    }
    else {
        my $m = $self->{mech};
        $self->_connect unless $self->{connected};
        $m->get(MONTH_URL);
        $self->{html}{month} = $m->content;
        if ($self->{cache_dir} and -d $self->{cache_dir}) {
            _out($self->{html}{month}, $self->{cache_dir}, 'month');
        }
    }

    my $month_isolate_re = qr{<table  border="0" class="detail_consommation">
\s*<tr >
\s*<th scope="col"> Date</th>
\s*<th scope="col"> Trajet</th>
\s*<th scope="col"> Durée</th>
\s*<th scope="col"> Montant</th>
\s*</tr>
((?:\s*<tr class="[^"]*">
\s*<td>&nbsp;[^<]+</td>
\s*<td>[^<]+</td>
\s*<td>[^<]+</td>
\s*<td>\S+ &euro;</td>
\s*</tr>)+)};

    my ($month_detail) = ($self->{html}{month} =~ /$month_isolate_re/);
    return unless defined $month_detail;

    my $detail_re = qr{\s*<tr class="[^"]*">
\s*<td>&nbsp;(\d{2}/\d{2}/\d{4})</td>
\s*<td>(.*?) -> ([^<]+)</td>
\s*<td>(\d+)h (\d+)min</td>
\s*<td>(\d+,\d+) &euro;</td>
\s*</tr>};

    if (my @match = $month_detail =~ /$detail_re/g) {
        while (@match) {
            my @trip = splice(@match, 0, 6);
            (my $datestamp = $trip[0]) =~ s{^(\d{2})/(\d{2})/(\d{4})$}{$3$2$1};
            unshift @{$self->{trip}{$datestamp}}, WWW::Velib::Trip->make(@trip);
        }
    }
}

sub myaccount {
    my $self = shift;
    my $file = shift;
    $self->{html}{myaccount} = _slurp($file);
    $self->_myaccount_parse;
}

sub _myaccount_parse {
    my $self = shift;
    my $html = $self->{html}{myaccount};

    my $solde_re = qr{<h3 class="titre_top titre_top_compte">
\s*Mon paiement en ligne</h3>
\s*<div class="breaker"></div>
\s*<div class="info_compte">
\s*<p><span>Solde :</span>(\S+) &euro;</p>};
    if ($html =~ /$solde_re/) {
        $self->{balance} = $1;
        $self->{balance} =~ tr/,/./;
    }

    my $abo_re = qr{<div class="border_vert">
\s*<div class="content">
\s*<h3 class="titre_top titre_top_compte">Mon abonnement</h3>
\s*<div class="breaker"></div>
\s*<div class="info_compte">(?:\s*<p><span>Solde :</span>(\S+) &euro;</p>)?
\s*<p><span>Votre compte prend fin le :</span> ([^<]+)</p>
\s*<p><span>Il vous reste encore (\d+) jours d'abonnement</span></p>
\s*<p><span>\s+Vous (n'avez pas de|avez un) vélo en cours de location\.};

    if ($html =~ /$abo_re/) {
        if (!$self->{balance} and defined $1) {
            $self->{balance} = $1;
            $self->{balance} =~ tr/,/./;
        }
        $self->{end_date} = $2;
        $self->{remain}   = $3;
        $self->{in_use}   = ($4 eq 'avez un') ? 1 : 0;
    }
    else {
        $self->{end_date} = '';
        $self->{remain}   = 0;
        $self->{in_use}   = 0;
    }

    my $conso_re = qr{<h3 class="titre_top titre_top_compte2">Ma consommation en (\S+) (\d+)</h3>
\s*<div class="breaker"></div>
\s*<div class="results">
\s*<table border="0" summary="tableau de consomation">
\s*<tr>
\s*<th scope="col" class="col1">Nbre de trajets</th>
\s*<th scope="col" class="col4">Temps cumulé</th>
\s*<th scope="col" class="col4">Montant</th>
\s*</tr>
\s*<tr class="pyjama">
\s*<td>(\d+)</td>
\s*<td>(?:(\d+)h )?(\d+)min</td>
\s*<td>(\S+) &euro;</td>};

    if ($html =~ /$conso_re/) {
        $self->{conso_month} = $1;
        $self->{conso_year}  = $2;
        $self->{conso_trips} = $3;
        $self->{conso_time}  = ($4 || 0) * 60 + $5;
        $self->{conso_bal}   = $6;
        $self->{conso_bal}   =~ tr/,/./;
    }
    else {
        $self->{conso_month} = '';
        $self->{conso_year}  = 0;
        $self->{conso_trips} = 0;
        $self->{conso_time}  = 0;
        $self->{conso_bal}   = 0;
    }
}

sub end_date {
    my $self = shift;
    return $self->{end_date};
}

sub remain {
    my $self = shift;
    return $self->{remain};
}

sub in_use {
    my $self = shift;
    return $self->{in_use};
}

sub balance {
    my $self = shift;
    return $self->{balance};
}

sub conso_month {
    my $self = shift;
    return $self->{conso_month};
}

sub conso_year {
    my $self = shift;
    return $self->{conso_year};
}

sub conso_trips {
    my $self = shift;
    return $self->{conso_trips};
}

sub conso_time {
    my $self = shift;
    return $self->{conso_time};
}

sub conso_bal {
    my $self = shift;
    return $self->{conso_bal};
}

sub trips {
    my $self = shift;
    return () unless  $self->{trip};
    my @trip;
    push @trip, @{$self->{trip}{$_}} for sort keys %{$self->{trip}};
    return @trip;
}

sub next_trip {
    my $self = shift;
    return unless $self->{trip};

    if (not (exists $self->{trip_day} and exists $self->{trip_day_n})) {
        $self->reset_trip;
        return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
    }

    if (++$self->{trip_day_n} <=  $#{$self->{trip}{$self->{trip_day}[0]}}) {
        return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
    }

    shift @{$self->{trip_day}};
    return unless scalar @{$self->{trip_day}};
    $self->{trip_day_n} = 0;

    return $self->{trip}{$self->{trip_day}[0]}[$self->{trip_day_n}];
}

sub reset_trip {
    my $self = shift;
    return unless $self->{trip};

    $self->{trip_day} = [sort keys %{$self->{trip}}];
    $self->{trip_day_n} = 0;
}

'The Lusty Decadent Delights of Imperial Pompeii';
__END__