view release on metacpan or  search on metacpan

lib/App/BarnesNoble/WishListMinder.pm  view on Meta::CPAN

  my $dbh = DBI->connect("dbi:SQLite:dbname=$fn","","",
                         { AutoCommit => 0, PrintError => 0, RaiseError => 1,
                           sqlite_unicode => 1 });

  $self->create_database_schema($dbh) unless $exists;

  $dbh;
} # end _build_dbh

sub close_dbh
{
  my $self = shift;

  if ($self->has_dbh) {
    my $dbh = $self->dbh;
    $dbh->rollback;
    $dbh->disconnect;
    $self->_clear_dbh;
  }
} # end close_dbh

has scraper => qw(is lazy);
sub _build_scraper {
  require Web::Scraper::BarnesNoble::WishList;

  Web::Scraper::BarnesNoble::WishList::bn_scraper();
} # end _build_scraper

has updates => qw(is ro  default) => sub { {} };

#---------------------------------------------------------------------
sub configure
{
  my ($self) = @_;

  my $config_file = $self->config_file;

  say "Your config file is:\n $config_file";

  unless ($config_file->is_file) {
    die "$config_file is a directory!\n" if $config_file->is_dir;
    $config_file->spew_utf8(<<'END CONFIG');
;						-*-conf-windows-*-
; Your credentials for logging in to the Barnes & Noble website go here:
email    = YOUR EMAIL HERE
password = YOUR PASSWORD HERE

; If you want the Price Drop Alert emails to go to a different address,
; uncomment the next line and set the email address.
;report   = EMAIL ADDRESS FOR ALERTS

; Next, you need one or more wishlists to monitor.
; Each wishlist must have a unique name in [brackets].

[My Wishlist]
wishlist = WISHLIST URL HERE
END CONFIG
    say "\nYou need to replace the ALL CAPS placeholders with the correct values.";
  }

  if (my $editor = $ENV{VISUAL} || $ENV{EDITOR}) {
    require Text::ParseWords;
    system(Text::ParseWords::shellwords($editor), "$config_file");
  }
} # end configure

#---------------------------------------------------------------------
sub create_database_schema
{
  my ($self, $dbh) = @_;

  $dbh->do("PRAGMA foreign_keys = ON");

  $dbh->do(<<'');
CREATE TABLE books (
  ean         INTEGER PRIMARY KEY,
  title       TEXT NOT NULL,
  author      TEXT
)

  $dbh->do(<<'');
CREATE TABLE wishlists (
  wishlist_id   INTEGER PRIMARY KEY,
  url           TEXT NOT NULL UNIQUE,
  last_fetched  TIMESTAMP
)

  $dbh->do(<<'');
CREATE TABLE wishlist_books (
  wishlist_id   INTEGER NOT NULL REFERENCES wishlists,
  ean           INTEGER NOT NULL REFERENCES books,
  priority      INTEGER,
  date_added    DATE NOT NULL DEFAULT CURRENT_DATE,
  date_removed  DATE,
  PRIMARY KEY (wishlist_id,ean)
)

  $dbh->do(<<'');
CREATE TABLE prices (
  ean            INTEGER NOT NULL REFERENCES books,
  first_recorded TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
  last_checked   TIMESTAMP NOT NULL DEFAULT CURRENT_TIMESTAMP,
  current        TINYINT NOT NULL DEFAULT 1,
  price          INTEGER,
  list_price     INTEGER,
  discount       INTEGER,
  PRIMARY KEY (ean,first_recorded)
)

  $dbh->commit;

} # end create_database_schema

#---------------------------------------------------------------------
sub login
{
  my ($self) = shift;

  my ($config, $m) = ($self->config->{_}, $self->mech);

  $m->get('https://www.barnesandnoble.com/signin');

  #path("/tmp/login.html")->spew_utf8($m->content);

lib/App/BarnesNoble/WishListMinder.pm  view on Meta::CPAN

sub have_user_cookie
{
  my $have_cookie;
  my $min_expires = time() + 30;

  shift->mech->cookie_jar->scan(sub {
    $have_cookie = 1 if $_[1] eq 'userid'
                    and $_[4] eq '.barnesandnoble.com'
                    and $_[8] > $min_expires
  });

  $have_cookie;
} # end have_user_cookie

#---------------------------------------------------------------------

sub update_wishlists
{
  my $self = shift;

  my $config  = $self->config;
  my $m       = $self->mech;

  # Ensure we can open the database before we start making web requests
  $self->dbh;

  $self->login unless $self->have_user_cookie;

  for my $wishlist (sort keys %$config) {
    next if $wishlist eq '_';   # the root INI section

    my $response = $m->get( $config->{$wishlist}{wishlist} );
    my $books    = $self->scrape_response($response);
    unless (@$books) {
      warn "$config->{$wishlist}{wishlist} has no entries\n";
      # Save the response for debugging:
      $self->dir->child("empty-$wishlist.html")->spew_utf8($response->content);
    }
#    path("/tmp/wishlist.html")->spew_utf8($response->content);
    $self->write_db($config->{$wishlist}{wishlist}, $response->last_modified // $response->date, $books);
  }
} # end update_wishlists

#---------------------------------------------------------------------

sub usage {
  my $name = $0;
  $name =~ s!^.*[/\\]!!;

  shift->close_dbh;

  print "$name $VERSION\n";
  exit if $_[0] and $_[0] eq 'version';
  print <<"END USAGE";
\nUsage:  $name [options] [EAN_or_TITLE_or_AUTHOR] ...
  -a, --all-history        Show price history even when multiple items match
  -e, --email              Send Price Drop Alert email (implies --update)
  -q, --quiet              Don't print list of updates
  -s, --since=DATE         Print books whose price changed on or after DATE
  -u, --update             Download current prices from wishlist
      --configure          Create and/or edit the config file
      --help               Display this help message
      --version            Display version information
END USAGE

    exit;
} # end usage
#---------------------------------------------------------------------

sub run
{
  my ($self, @args) = @_;

  # Process command line options
  my ($all_history, $fetch_wishlist, $quiet, $send_email, $since_date);
  {
    require Getopt::Long; Getopt::Long->VERSION(2.24); # object-oriented
    my $getopt = Getopt::Long::Parser->new(
      config => [qw(bundling no_getopt_compat)]
    );
    my $usage = sub { $self->usage(@_) };

    $getopt->getoptionsfromarray(\@args,
      'all-history|a' => \$all_history,
      'email|e'   => \$send_email,
      'quiet|q'   => \$quiet,
      'since|s=s' => \$since_date,
      'update|u'  => \$fetch_wishlist,
      'configure' => sub { $self->configure; exit },
      'help'      => $usage,
      'version'   => $usage
    ) or $self->usage;
  }

  # Update database & send email if requested
  if ($fetch_wishlist or $send_email) {
    $self->update_wishlists;

    $self->email_price_drop_alert if $send_email;
    $self->print_updates unless $quiet;
  } elsif (not @args and not $since_date) {
    # Didn't fetch updates and no request to display book data
    if ($self->config_file->is_file) {
      $self->usage;
    } else {
      $self->configure;
    }
  }

  if ($since_date) {
    $self->print_updates_since($since_date);
  }

  # Display data from the database about requested books
  foreach my $arg (@args) {
    if ($arg =~ /^[0-9]{13}\z/) {
      $self->print_price_history($arg);
    } else {
      $self->print_matching_books($arg, $all_history);
    }
  }