package WWW::LaQuinta::Returns;

use strict;
use warnings;
use Carp;
use WWW::Mechanize;

our $VERSION = '0.02';

=head1 NAME

WWW::LaQuinta::Returns - Scraper for La Quinta Returns site

=head1 SYNOPSIS

  use WWW::LaQuinta::Returns;

  my $lq = WWW::LaQuinta::Returns->new(
     account  => 'W123456',
     password => 'opensesame',
  );

  my $points = $lq->balance;
  print "You have $points La Quinta Returns points";

=head1 DESCRIPTION

This module scrapes the La Quinta Returns website to obtain your reward points balance at the La Quinta hotel chain.

=head1 METHODS

=head2 new

Returns a new WWW::LaQuinta::Returns object.

=cut

sub new
{
    my $class  = shift;
    my %params = @_;
    my $self = \%params;
    bless $self, $class;

    my $mech = WWW::Mechanize->new;
    $self->{mech} = $mech;

    return $self;
}

=head2 balance

Returns your La Quinta Returns points balance.

=cut 

sub balance
{
    my $self    = shift;
    my %params  = @_;
    my $content = $self->_login;
    my $points;

    # Future proofing - support commified and non-commified points balances.
    # Right now LQ uses a mix of the two and this could obviously change in
    # the future.
    my $digit_regex = '([0-9]{1,3},([0-9]{3},)*[0-9]{3}|[0-9]+)';

    # More future proofing - pull the point balance from as many locations
    # as possible. That way, if one disappears, another will be found.
    my @regexes = (
        qq|<strong>$digit_regex<\/strong> points|,
        qq|<span style='color:#9bca14;'><b>$digit_regex<\/b><\/span> <span style='color:#cccccc;font-size:12px;'>points|,
    );

    my @matches;
    for my $regex (@regexes) {
        if ($content =~ /$regex/) {
            my $points = $1;
            if (defined($points)) {
                $points =~ s/\,//g;
                push @matches, $points;
            }
        }
    }

    if ($ENV{WWW_LaQuinta_Returns_DEBUG}) {
        my $match_count = scalar @matches;
        my $regex_count = scalar @regexes;
        if ($regex_count != $match_count) {
            warn "Layout change - $regex_count regexes matched $match_count times";
        }
    }

    my $generic_error = "Please alert the WWW::LaQuinta::Returns maintainer";

    if (@matches) {
        my $first = $matches[0];
        if (grep { $_ != $first } @matches) {
            croak "Getting inconsistent values. $generic_error";
        } else {
            return $first;
        }
    } else {
        croak "Unable to scrape LaQuinta.com. $generic_error";
    }

    return $points;
}

sub _login {
    my $self = shift;
    my $mech = $self->_mech;

    $mech->get('http://www.lq.com/lq/returns/');

    # HACK: Suspend WWW::Mechanize warnings because I don't want to specify a
    # specific form number for future-proofing purposes, but Mech will emit
    # a warning if there are more than one form matching the account/password
    # inputs.
    my $old_onwarn = $mech->{onwarn} ;
    $mech->{onwarn} = sub {};

    $mech->submit_form(
        with_fields => {
            account  => $self->{account},
            password => $self->{password},
        },
    );

    $mech->{onwarn} = $old_onwarn;

    my $content = $mech->content;

    if ($content =~ /password has not been defined/) {
        croak "Incorrect account number";
    } elsif ($content =~ /password you have entered is invalid/) {
        croak "Incorrect password";
    }

    return $content;
}

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

=head1 DEPENDENCIES

WWW::Mechanize

=head1 WHY?!

I wanted to write a cronjob that would alert me when my points balance changed or I became eligible for a free night. For an example of such a script, see bin/cron_example.pl.

=head1 TO-DO LIST

A few other features that I might code at some point. Send me an email if you would find them useful. Oh, and patches are welcome.

=over 4

=item * B<Account History>

Scraper for your account history - what hotels you spent your points at, how many points you used for free nights, how many points were earned from hotel stays/credit card usage/etc.

=back

=cut

=head1 BUGS

Like all screen-scraping tools, this module is prone to bugs or epic breakage if La Quinta changes their site design. It's not intended for use in production applications.

=head1 DISCLAIMER

The author of this module is not affiliated in any way with La Quinta Hotels.

Use this scraper like you would a web browser. You wouldn't sit at your computer refreshing the La Quinta website every second, so don't use this module to write a cronjob that does that.

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2010 Michael Aquilina. All rights reserved.

This code is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 AUTHOR

Michael Aquilina, aquilina@cpan.org

=cut

1;