You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
297 lines
5.3 KiB
297 lines
5.3 KiB
=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;
|