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