app-markfiles/lib/App/MarkFiles.pm

=pod

=head1 NAME

App::MarkFiles - some utility functions for marking and operating on files

=head1 SYNOPSIS

    # This module:
    use App::MarkFiles qw(get_dbh each_path add remove);

    my $dbh = get_dbh(); # db handle for marks.db

    add('/foo/bar', '/foo/baz');

    remove('/foo/baz');

    each_path(sub {
      my ($path) = @_;
      print "$path\n";
    });

    # marks commands:
    $ marks add foo.txt
    $ cd ~/somedir
    $ marks mv

=head1 INSTALLING

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

=head1 DESCRIPTION

The mark utilities store a list of marked file paths in marks.db in the user's
home directory.  Once marked, files can be copied, moved, listed, or passed as
parameters to arbitrary shell commands.

This originated as a simple tool for collecting files from one or more
directories and moving or copying them to another.  A basic usage pattern
looks something like this:

    $ cd ~/screenshots
    $ marks add foo.png
    $ cd ~/blog/files/screenshots
    $ marks mv
    Moved: /home/brennen/screenshots/foo.png

This is more steps than a simple invocation of mv(1), but its utility becomes
more apparent when it's combined with aliases for quickly navigating
directories or invoked from other programs like editors and file managers.

See C<bin/marks> in this distribution (or, when installed, the marks(1) man
page) for details on the commands.

=cut

package App::MarkFiles;

use strict;
use warnings;

use base qw(Exporter);
our @EXPORT_OK = qw(get_dbh each_path add remove check_collisions);

our ($VERSION) = '0.0.3';

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

=head1 SUBROUTINES

=over

=item get_dbh()

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

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

=cut

sub get_dbh {
  my $dbfile = File::Spec->catfile(File::HomeDir->my_home, 'marks.db');

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

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

  create_mark_db($dbh) if $init_new;

  return $dbh;
}

=item create_mark_db($dbh)

Create a new marks table.

=cut

sub create_mark_db {
  my ($dbh) = @_;

  $dbh->do(<<'SQL'
    CREATE TABLE marks (
      id integer primary key,
      path text,
      datetime text
    );

    CREATE TABLE things (
      id integer primary key,
      address text
    );

    CREATE TABLE links (
      id integer primary key,
      from_thing integer,
      to_thing integer,
      created text,
      updated text
    );
SQL
  );
}

=item add(@paths)

Add a mark to one or more paths.

=cut

sub add {
  my (@paths) = @_;

  # Filter out any paths that have already been marked:
  my %pathmap = map { $_ => 1 } @paths;
  each_path(sub {
    my ($existing_path) = @_;
    if ($pathmap{ $existing_path }) {
      delete $pathmap{ $existing_path };
    }
  });

  my $sth = get_dbh()->prepare(q{
    INSERT INTO marks (path, datetime) VALUES (?, datetime('now'))
  });

  foreach my $path (keys %pathmap) {
    $sth->execute($path);
  }
}

=item remove(@paths)

Remove all given paths from the mark list.

=cut

sub remove {
  my (@paths) = @_;

  my $sth = get_dbh()->prepare(q{
    DELETE FROM marks WHERE PATH = ?;
  });

  foreach my $path (@paths) {
    $sth->execute($path);
  }
}

=item each_path($func)

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

Expects a sub which takes a path string.

=cut

sub each_path {
  my ($func) = @_;

  my $sth = get_dbh()->prepare(q{
    SELECT DISTINCT(path) as path FROM marks ORDER BY datetime;
  });

  $sth->execute();

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

=item check_collisions()

Return a list of basenames which would collide from the current list.

=cut

sub check_collisions {
  # Accumulate a list of basenames:
  my %basenames;
  each_path(sub {
    my ($path) = @_;
    my ($source_basename, $source_path) = fileparse($path);
    $basenames{ $source_basename }++;
  });

  my @collisions;
  while(my($basename, $count) = each %basenames) {
    push @collisions, $basename if 1 < $count;
  }

  return @collisions;
}

=back

=head1 AUTHOR

Copyright 2018 Brennen Bearnes

    mark 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, version 2 of the License.

    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;