app-pieces/lib/App/Pieces.pm

=pod

=head1 NAME

App::Pieces - some utility functions for bookmarking and interlinking things

=head1 SYNOPSIS

tk tk tk

=head1 INSTALLING

    $ perl Build.PL
    $ ./Build
    $ ./Build install

=head1 DESCRIPTION

tk tk tk

=cut

package App::Pieces;

use strict;
use warnings;
use 5.10.0;

use base qw(Exporter);
our @EXPORT_OK = qw();

our ($VERSION) = '0.0.1';

use Carp;
use DBI;
use File::Basename;
use File::HomeDir;
use File::Spec;
use URI;

my %default = (
  dbfile => File::Spec->catfile(File::HomeDir->my_home, 'pieces.db')
);

=head1 SUBROUTINES

=over

=item new(%params)

Get a new Pieces object with the specified parameters set.

=cut

sub new {
  my $class = shift;
  my %params = @_;

  my %copy_of_default = %default;
  my $self = \%copy_of_default;
  bless $self, $class;

  # Configure from passed-in values, overwriting defaults:
  for my $p (keys %params) {
    $self->{$p} = $params{$p};
  }

  $self->{dbh} = $self->get_dbh();

  return $self;
}

=item get_dbh()

Get database handle for default pieces database, stored in F<~/pieces.db>.

Creates a new database with the correct schema if one doesn't already exist.

=cut

sub get_dbh {
  my ($self) = shift;
  my $dbfile = $self->{dbfile};

  my $init_new = 0;
  $init_new = 1 unless -f $dbfile;

  my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "");

  $self->create_pieces_db($dbh) if $init_new;

  return $dbh;
}

=item create_pieces_db($dbh)

Create new pieces tables.

=cut

sub create_pieces_db {
  my ($self) = shift;
  my ($dbh) = @_;

  # We'll stash what version of pieces created the schema, and when:
  $dbh->do(qq{
    CREATE TABLE schema_version (
      id integer primary key,
      version text DEFAULT '$VERSION',
      created text DEFAULT CURRENT_TIMESTAMP
    );
  });

  $dbh->do(q{ INSERT INTO schema_version DEFAULT VALUES; });

  $dbh->do(q{
    CREATE TABLE pieces (
      id integer primary key,
      address text,
      created text,
      modified text
    );
  });


  $dbh->do(q{
    CREATE TABLE links (
      id integer primary key,
      from_piece integer,
      to_piece integer,
      description text,
      created text
    );
  });

  $dbh->do(q{
    CREATE TABLE groups (
      id integer primary key,
      name text,
      description text,
      created text,
      modifed text
    );
  });
}

=item add(@addresses)

Add one or more addresses to the pieces db.

=cut

sub add {
  my ($self) = shift;
  my (@addresses) = @_;

  # Filter out any paths that have already been marked:
  # XXX: This is gonna get pretty silly with thousands of entries to read every
  #      time.
  my %addressmap = map { $_ => 1 } @addresses;
  $self->each_address(sub {
    my ($existing_addy) = @_;
    if ($addressmap{ $existing_addy }) {
      delete $addressmap{ $existing_addy };
    }
  });

  my $sth = $self->{dbh}->prepare(q{
    INSERT INTO pieces (address, created) VALUES (?, datetime('now'))
  });

  my @ids;
  foreach my $addy (keys %addressmap) {
    $sth->execute($addy);

    # The empty strings passed to last_insert_id() should just leave it
    # getting the last insert for the dbh:
    push @ids, $self->{dbh}->last_insert_id('', '', '', '');
  }

  return @ids;
}

sub get {
  my ($self) = shift;
  my ($addy) = @_;

  my $find_sth = $self->{dbh}->prepare(q{
    SELECT id FROM pieces WHERE address = ?;
  });

  my ($id) = $self->{dbh}->selectrow_array($find_sth, {}, $addy);

  return $id;
}

sub get_or_add {
  my ($self) = shift;
  my ($addy) = @_;

  my $id = $self->get($addy);

  # If we didn't find an existing piece, add it and get its id
  if (! defined $id) {
    ($id) = $self->add($addy);
  }

  return $id;
}

sub add_link {
  my ($self) = shift;
  my ($from, $to) = @_;

  my $from_id = $self->get_or_add($from);
  my $to_id = $self->get_or_add($to);

  my $sth = $self->{dbh}->prepare(q{
    INSERT INTO links (from_piece, to_piece, created) VALUES (?, ?, datetime('now'))
  });

  $sth->execute($from_id, $to_id);
}

=item remove(@paths)

Remove all given paths from the mark list.

=cut

sub remove {
  my ($self) = shift;
  my (@addresses) = @_;

  my $sth = $self->{dbh}->prepare(q{
    DELETE FROM pieces WHERE address = ?;
  });

  foreach my $addy (@addresses) {
    $sth->execute($addy);
  }
}

=item each_address($func)

Run an anonymous function against each item in the pieces list.

Expects a sub which takes a path string.

=cut

sub each_address {
  my ($self) = shift;
  my ($func) = @_;

  my $sth = $self->{dbh}->prepare(q{
    SELECT DISTINCT(address) as address FROM pieces ORDER BY created;
  });

  $sth->execute();

  while (my $data = $sth->fetchrow_hashref()) {
    $func->($data->{address});
  }
}

sub foreach_row {
  my ($self) = shift;
  my ($query, $func) = @_;

  my $sth = $self->{dbh}->prepare($query);
  $sth->execute();

  while (my $data = $sth->fetchrow_hashref()) {
    $func->($data);
  }
}

=back

=head1 AUTHOR

Copyright 2018 Brennen Bearnes

    pieces is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

=cut

1;