view release on metacpan or  search on metacpan

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

has db_file => qw(is lazy);
sub _build_db_file {
  shift->dir->child('wishlist.sqlite');
} # end _build_db_file

has dbh => qw(is lazy  predicate 1  clearer _clear_dbh);
sub _build_dbh {
  my $self = shift;

  require DBI;
  DBI->VERSION(1.38);           # last_insert_id

  my $fn = $self->db_file;
  my $exists = $fn->exists;

  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);

  $m->submit_form(
    with_fields => {
      'login.email'    => $config->{email},
      'login.password' => $config->{password},
    },
  );
} # end login
#---------------------------------------------------------------------

sub scrape_response
{
  my ($self, $response) = @_;

  my $books = $self->scraper->scrape($response);

  for my $book (@$books) {
    $book->{priority} //= 3;
    for ($book->{discount}) {
      next unless defined $_;
      s/^\s+//;
      s/\s+\z//;
      s/^\((.+)\)\z/$1/;
      s/^You save\s*//i;
    }
    $book->{date_added} =~ s!^(\d\d)/(\d\d)/(\d\d)$!20$3-$1-$2!;
  }

  $books;
} # end scrape_response
#---------------------------------------------------------------------

sub write_db
{
  my ($self, $wishlist_url, $time_fetched, $books) = @_;

  $time_fetched = _format_timestamp($time_fetched);

  my $dbh = $self->dbh;
  my $updates = $self->updates;

  my $wishlist_id = $self->get_wishlist_id($wishlist_url);

  my $existing_priority = $self->get_existing_books($wishlist_id);

  my $get_book = $dbh->prepare(<<'');
    SELECT title, author FROM books WHERE ean = ?

  my $get_price = $dbh->prepare(<<'');
    SELECT price, list_price, discount, first_recorded FROM prices
    WHERE ean = ? AND current == 1

  for my $book (@$books) {
    my $ean = $book->{ean};
    my $current_price_row;

    # Update or add the book to the books table
    my $book_row = $dbh->selectrow_hashref($get_book, undef, $ean);
    if ($book_row) {
      # The book exists.  Update title & author if necessary
      unless (_eq($book_row->{title}, $book->{title}) and
              _eq($book_row->{author}, $book->{author})) {
        $dbh->do(<<'', undef, @$book{qw(title author ean)});
          UPDATE books SET title = ?, author = ? WHERE ean = ?