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.
238 lines
4.6 KiB
238 lines
4.6 KiB
=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;
|