Browse Source

App::Pieces is now a class, very basic add/link stuff working

  - adds a constructor which allows configuring db path
  - adds pieces(1) and subcommands
  - allows for adding an address and linking between 2 addresses

This is still super raw and I'm undecided about various things.
Brennen Bearnes 1 year ago
parent
commit
167fb41fa5
16 changed files with 399 additions and 542 deletions
  1. 1
    1
      Build.PL
  2. 0
    124
      bin/mark
  3. 0
    9
      bin/mark-clear
  4. 0
    56
      bin/mark-cp
  5. 0
    43
      bin/mark-each
  6. 0
    64
      bin/mark-mv
  7. 32
    0
      bin/pieces
  8. 6
    6
      bin/pieces-add
  9. 10
    0
      bin/pieces-clear
  10. 49
    0
      bin/pieces-link
  11. 2
    2
      bin/pieces-ls
  12. 4
    2
      bin/pieces-ls-print0
  13. 7
    9
      bin/pieces-remove
  14. 0
    226
      lib/App/MarkFiles.pm
  15. 282
    0
      lib/App/Pieces.pm
  16. 6
    0
      test.sh

+ 1
- 1
Build.PL View File

@@ -2,7 +2,7 @@ use Module::Build;
2 2
 
3 3
 my $build = Module::Build->new(
4 4
 
5
-  module_name => 'App::MarkFiles',
5
+  module_name => 'App::Pieces',
6 6
 
7 7
   license  => 'gpl',
8 8
 

+ 0
- 124
bin/mark View File

@@ -1,124 +0,0 @@
1
-#!/bin/sh
2
-
3
-: <<=cut
4
-=pod
5
-
6
-=head1 NAME
7
-
8
-mark - a tool for marking and acting on file paths
9
-
10
-=head1 SYNOPSIS
11
-
12
-    mark add <path>     # Add a file path to the mark list
13
-    mark remove <path>  # Remove a file path from the mark list
14
-    mark clear          # Remove all marks from list
15
-    mark ls             # List current marks
16
-    mark ls-print0      # List current marks, separated by NUL chars
17
-    mark cp             # Copy marked files to current directory
18
-    mark mv             # Move files to current directory and unmark
19
-    mark each <command> # Execute command with each marked file as parameter
20
-    mark -h             # Print help message
21
-
22
-=head1 DESCRIPTION
23
-
24
-mark stores a list of marked file paths in an SQLite database called marks.db
25
-in the user's home directory.  Once marked, files can be copied, moved, listed,
26
-or passed as parameters to arbitrary shell commands.
27
-
28
-Commands are intended to be invoked as subcommands of mark(1), in the style of
29
-git(1).
30
-
31
-=head1 COMMANDS
32
-
33
-=head2 mark-add
34
-
35
-Add one or more paths to the mark list.  Relative paths will be stored by their
36
-absolute location.  Repeated commands are idempotent - a path can only appear
37
-once in the mark list.
38
-
39
-=head2 mark-remove
40
-
41
-Remove one or more paths from the mark list.  Relative paths will be resolved
42
-to their absolute location before the list is searched.
43
-
44
-=head2 mark-clear
45
-
46
-Clear the entire mark list.
47
-
48
-=head2 mark-ls
49
-
50
-List all currently marked paths, one line per path.
51
-
52
-=head2 mark-ls-print0
53
-
54
-List all currently marked paths, separated by null characters, for use when
55
-piping to C<xargs -0> or other commands which expect null-terminated file
56
-lists.  Analogous to C<find -print0>.  This is useful where filenames contain
57
-whitespace, quotes, etc.
58
-
59
-=head2 mark-cp
60
-
61
-Copy all marked paths to the current working directory.
62
-
63
-=head2 mark-mv
64
-
65
-Move all marked paths to the current working directory, and remove them from
66
-the mark list.
67
-
68
-=head2 mark-each
69
-
70
-Execute the provided command once per marked path, with the path as a
71
-parameter, and print any output from the command.
72
-
73
-This is crudely analogous to C<xargs>.  While good enough for simple commands,
74
-it's likely to break in more complex cases, and may be slow for large mark
75
-lists.  Consider using mark-ls-print0(1) and xargs(1) instead.
76
-
77
-=head1 SEE ALSO
78
-
79
-App::MarkFiles
80
-
81
-=head1 LICENSE
82
-
83
-    mark is free software; you can redistribute it and/or modify
84
-    it under the terms of the GNU General Public License as published by
85
-    the Free Software Foundation; either version 2 of the License, or
86
-    (at your option) any later version.
87
-
88
-=head1 AUTHOR
89
-
90
-Brennen Bearnes
91
-
92
-=cut
93
-
94
-print_help() {
95
-  echo "$0 - mark and operate on files"
96
-  echo
97
-  echo "Usage: mark [command] [args]"
98
-  echo "    mark add [path]     - Add a file path to the mark list"
99
-  echo "    mark clear          - Clear mark list"
100
-  echo "    mark cp             - Copy marked files to current directory"
101
-  echo "    mark each [command] - Execute command for each marked file"
102
-  echo "    mark ls             - List current marks"
103
-  echo "    mark ls-nullsep     - List current marks, separated by NUL chars"
104
-  echo "    mark mv             - Move files to current directory and unmark"
105
-  echo "    mark -h             - Print this help message"
106
-  echo
107
-  echo "You must specify a command."
108
-  exit 1
109
-}
110
-
111
-if [ $# -lt 1 ] || [ "$1" = "--help" ] || [ "$1" = "-h" ]; then
112
-  print_help
113
-fi
114
-
115
-subprog="mark-$1"
116
-
117
-# Make sure that the command we've been given exists:
118
-command -v "$subprog" >/dev/null 2>&1 || {
119
-  echo "mark: '$1' is not a mark command.  See 'mark -h'."
120
-  exit 1
121
-}
122
-
123
-shift
124
-exec "$subprog" "$@"

+ 0
- 9
bin/mark-clear View File

@@ -1,9 +0,0 @@
1
-#!/usr/bin/env perl
2
-
3
-use warnings;
4
-use strict;
5
-use 5.10.0;
6
-
7
-use App::MarkFiles qw(get_dbh);
8
-
9
-get_dbh()->prepare(q{DELETE FROM marks})->execute();

+ 0
- 56
bin/mark-cp View File

@@ -1,56 +0,0 @@
1
-#!/usr/bin/env perl
2
-
3
-use warnings;
4
-use strict;
5
-use 5.10.0;
6
-
7
-use App::MarkFiles qw(each_path check_collisions);
8
-use File::Basename;
9
-use File::Copy;
10
-use File::Spec;
11
-use Getopt::Long;
12
-
13
-
14
-my $dry_run;
15
-GetOptions(
16
-  'no-action|dry-run|n' => \$dry_run,
17
-  help                  => sub { pod2usage(0) },
18
-) or pod2usage(2);
19
-
20
-my (@collisions) = check_collisions();
21
-if (scalar @collisions) {
22
-  # We got something.  Alert the user and bail.
23
-  say "Multiple marked paths would be copied to the following filenames:";
24
-  say join "\n", @collisions;
25
-  say "";
26
-  say "No action taken, since this probably isn't what you want.";
27
-  exit(1);
28
-}
29
-
30
-each_path(sub {
31
-  my ($path) = @_;
32
-
33
-  unless (-e $path) {
34
-    say "No such file: $path";
35
-    return;
36
-  }
37
-
38
-  my ($source_basename, $source_path) = fileparse($path);
39
-  my $target = File::Spec->catfile('.', $source_basename);
40
-
41
-  if (-e $target) {
42
-    say "Warning: $path will overwrite $target";
43
-    # See mark-mv for some discussion of what happens if target exists.
44
-  }
45
-
46
-  if ($dry_run) {
47
-    say "Would copy: $path";
48
-    return;
49
-  }
50
-
51
-  if (copy($path, './')) {
52
-    say "Copied: $path";
53
-  } else {
54
-    say "Copy failed: $!"
55
-  }
56
-});

+ 0
- 43
bin/mark-each View File

@@ -1,43 +0,0 @@
1
-#!/usr/bin/env perl
2
-
3
-=pod
4
-
5
-=head1 NAME
6
-
7
-mark-each - execute some command for each marked file
8
-
9
-=head1 SYNOPSIS
10
-
11
-  mark-each  execute a command for each marked file
12
-
13
-  USAGE:
14
-    mark each command
15
-
16
-  EXAMPLE:
17
-    mark foo.txt bar.txt
18
-    mark each wc -l
19
-
20
-=head1 AUTHOR
21
-
22
-Brennen Bearnes <bbearnes@gmail.com>
23
-
24
-=cut
25
-
26
-use strict;
27
-use warnings;
28
-use 5.10.0;
29
-
30
-use App::MarkFiles qw(each_path);
31
-use Getopt::Long;
32
-use Pod::Usage;
33
-
34
-GetOptions(
35
-  help => sub { pod2usage(0) },
36
-) or pod2usage(2);
37
-
38
-my ($cmd) = join ' ', @ARGV;
39
-
40
-each_path(sub {
41
-  my ($path) = @_;
42
-  print `$cmd "$path"`;
43
-});

+ 0
- 64
bin/mark-mv View File

@@ -1,64 +0,0 @@
1
-#!/usr/bin/env perl
2
-
3
-use warnings;
4
-use strict;
5
-use 5.10.0;
6
-
7
-use App::MarkFiles qw(each_path remove check_collisions);
8
-use File::Basename;
9
-use File::Copy;
10
-use File::Spec;
11
-use Getopt::Long;
12
-use Pod::Usage;
13
-
14
-my $dry_run;
15
-GetOptions(
16
-  'no-action|dry-run|n' => \$dry_run,
17
-  help                  => sub { pod2usage(0) },
18
-) or pod2usage(2);
19
-
20
-my (@collisions) = check_collisions();
21
-if (scalar @collisions) {
22
-  # We got something.  Alert the user and bail.
23
-  say "Multiple marked paths would move to the following filenames:";
24
-  say join "\n", @collisions;
25
-  say "";
26
-  say "No action taken, since this probably isn't what you want.";
27
-  exit(1);
28
-}
29
-
30
-my @unmark;
31
-each_path(sub {
32
-  my ($path) = @_;
33
-
34
-  unless (-e $path) {
35
-    say "No such file: " . $path;
36
-    return;
37
-  }
38
-
39
-  my ($source_basename, $source_path) = fileparse($path);
40
-  my $target = File::Spec->catfile('.', $source_basename);
41
-
42
-  if (-e $target) {
43
-    say "Warning: $path will overwrite $target";
44
-  }
45
-
46
-  if ($dry_run) {
47
-    say "Would move: $path";
48
-    push @unmark, $path;
49
-    return;
50
-  }
51
-
52
-  if (move($path, $target)) {
53
-    say "Moved: $path";
54
-    push @unmark, $path;
55
-  } else {
56
-    say "Move failed: $!"
57
-  }
58
-});
59
-
60
-if ($dry_run) {
61
-  say "Would remove marks from: " . join ', ', @unmark;
62
-} else {
63
-  remove(@unmark);
64
-}

+ 32
- 0
bin/pieces View File

@@ -0,0 +1,32 @@
1
+#!/bin/sh
2
+
3
+print_help() {
4
+  echo "$0 - pieces and operate on things"
5
+  echo
6
+  echo "Usage: pieces [command] [args]"
7
+  echo "    pieces add [address]  - Add a thing's address to the pieces list"
8
+  echo "    pieces clear          - Clear pieces list"
9
+  echo "    pieces each [command] - Execute command for each piecesed thing"
10
+  echo "    pieces ls             - List current piecess"
11
+  echo "    pieces ls-nullsep     - List current piecess, separated by NUL chars"
12
+  echo "    pieces mv             - Move files to current directory and unpieces"
13
+  echo "    pieces -h             - Print this help message"
14
+  echo
15
+  echo "You must specify a command."
16
+  exit 1
17
+}
18
+
19
+if [ $# -lt 1 ] || [ "$1" = "--help" ] || [ "$1" = "-h" ]; then
20
+  print_help
21
+fi
22
+
23
+subprog="pieces-$1"
24
+
25
+# Make sure that the command we've been given exists:
26
+command -v "$subprog" >/dev/null 2>&1 || {
27
+  echo "pieces: '$1' is not a pieces command.  See 'pieces -h'."
28
+  exit 1
29
+}
30
+
31
+shift
32
+exec "$subprog" "$@"

bin/mark-remove → bin/pieces-add View File

@@ -4,17 +4,17 @@
4 4
 
5 5
 =head1 NAME
6 6
 
7
-mark-remove - remove files from the current set of marked files
7
+pieces-add - add URLs to the collection of pieces
8 8
 
9 9
 =head1 SYNOPSIS
10 10
 
11
-  mark-remove:  removes filesystem paths from the mark list
11
+  pieces-add:  stashes a filesystem path for use with other utilities
12 12
 
13 13
   USAGE:
14
-    mark remove path_to_mark
14
+    pieces add path_to_mark
15 15
 
16 16
   EXAMPLE:
17
-    mark remove foo.txt
17
+    pieces add *.txt
18 18
 
19 19
 =head1 AUTHOR
20 20
 
@@ -26,7 +26,7 @@ use warnings;
26 26
 use strict;
27 27
 use 5.10.0;
28 28
 
29
-use App::MarkFiles qw(remove);
29
+use App::Pieces;
30 30
 use Cwd qw(cwd abs_path);
31 31
 use Getopt::Long;
32 32
 use Pod::Usage;
@@ -36,4 +36,4 @@ GetOptions(
36 36
   help => sub { pod2usage(0) },
37 37
 ) or pod2usage(2);
38 38
 
39
-remove(map { abs_path($_) } @ARGV);
39
+App::Pieces->new()->add(@ARGV);

+ 10
- 0
bin/pieces-clear View File

@@ -0,0 +1,10 @@
1
+#!/usr/bin/env perl
2
+
3
+use warnings;
4
+use strict;
5
+use 5.10.0;
6
+
7
+use App::Pieces;
8
+
9
+my $p = App::Pieces->new();
10
+$p->{dbh}->do(q{DELETE FROM pieces});

+ 49
- 0
bin/pieces-link View File

@@ -0,0 +1,49 @@
1
+#!/usr/bin/env perl
2
+
3
+=pod
4
+
5
+=head1 NAME
6
+
7
+pieces - link two things together
8
+
9
+=head1 SYNOPSIS
10
+
11
+  pieces-link  links two things together
12
+
13
+  USAGE:
14
+    pieces link "thing1" "thing2"
15
+
16
+  EXAMPLE:
17
+    pieces link "file:///home/brennen/p1k3" "urn:vimwiki:p1k3"
18
+
19
+=head1 AUTHOR
20
+
21
+Brennen Bearnes
22
+
23
+=cut
24
+
25
+use warnings;
26
+use strict;
27
+use 5.10.0;
28
+
29
+use App::Pieces;
30
+use Cwd qw(cwd abs_path);
31
+use Getopt::Long;
32
+use Pod::Usage;
33
+
34
+GetOptions(
35
+  # 'config=s' => \$config_file,
36
+  help => sub { pod2usage(0) },
37
+) or pod2usage(2);
38
+
39
+my $p = App::Pieces->new();
40
+
41
+$p->add_link($ARGV[0], $ARGV[1]);
42
+
43
+$p->foreach_row(
44
+  'SELECT * FROM links',
45
+  sub {
46
+    my ($data) = @_;
47
+    say $data->{from_piece} . " " . $data->{to_piece};
48
+  }
49
+);

bin/mark-ls → bin/pieces-ls View File

@@ -23,7 +23,7 @@ use strict;
23 23
 use warnings;
24 24
 use 5.10.0;
25 25
 
26
-use App::MarkFiles qw(each_path);
26
+use App::Pieces;
27 27
 use Getopt::Long;
28 28
 use Pod::Usage;
29 29
 
@@ -32,7 +32,7 @@ GetOptions(
32 32
   help => sub { pod2usage(0) },
33 33
 ) or pod2usage(2);
34 34
 
35
-each_path(sub {
35
+App::Pieces->new()->each_address(sub {
36 36
   my ($path) = @_;
37 37
   say $path;
38 38
 });

bin/mark-ls-print0 → bin/pieces-ls-print0 View File

@@ -4,9 +4,11 @@ use strict;
4 4
 use warnings;
5 5
 use 5.10.0;
6 6
 
7
-use App::MarkFiles qw(each_path);
7
+use App::Pieces;
8 8
 
9
-each_path(sub {
9
+my $p = App::Pieces->new();
10
+
11
+$p->each_address(sub {
10 12
   my ($path) = @_;
11 13
   print $path . "\0";
12 14
 });

bin/mark-add → bin/pieces-remove View File

@@ -4,23 +4,21 @@
4 4
 
5 5
 =head1 NAME
6 6
 
7
-mark-add - add files to the current set of marked files
7
+pieces-remove - remove files from the current set of marked files
8 8
 
9 9
 =head1 SYNOPSIS
10 10
 
11
-  mark-add:  stashes a filesystem path for use with other utilities
11
+  pieces-remove:  removes paths from the pieces list
12 12
 
13 13
   USAGE:
14
-    mark add path_to_mark
14
+    pieces remove path [...]
15 15
 
16 16
   EXAMPLE:
17
-    mark add *.txt
18
-    cd ~/notes
19
-    mark mv
17
+    pieces remove foo.txt
20 18
 
21 19
 =head1 AUTHOR
22 20
 
23
-Brennen Bearnes <bbearnes@gmail.com>
21
+Brennen Bearnes
24 22
 
25 23
 =cut
26 24
 
@@ -28,7 +26,7 @@ use warnings;
28 26
 use strict;
29 27
 use 5.10.0;
30 28
 
31
-use App::MarkFiles qw(add);
29
+use App::Pieces;
32 30
 use Cwd qw(cwd abs_path);
33 31
 use Getopt::Long;
34 32
 use Pod::Usage;
@@ -38,4 +36,4 @@ GetOptions(
38 36
   help => sub { pod2usage(0) },
39 37
 ) or pod2usage(2);
40 38
 
41
-add(map { abs_path($_) } @ARGV);
39
+App::Pieces->new()->remove(map { abs_path($_) } @ARGV);

+ 0
- 226
lib/App/MarkFiles.pm View File

@@ -1,226 +0,0 @@
1
-=pod
2
-
3
-=head1 NAME
4
-
5
-App::MarkFiles - some utility functions for marking and operating on files
6
-
7
-=head1 SYNOPSIS
8
-
9
-    # This module:
10
-    use App::MarkFiles qw(get_dbh each_path add remove);
11
-
12
-    my $dbh = get_dbh(); # db handle for marks.db
13
-
14
-    add('/foo/bar', '/foo/baz');
15
-
16
-    remove('/foo/baz');
17
-
18
-    each_path(sub {
19
-      my ($path) = @_;
20
-      print "$path\n";
21
-    });
22
-
23
-    # mark commands:
24
-    $ mark add foo.txt
25
-    $ cd ~/somedir
26
-    $ mark mv
27
-
28
-=head1 INSTALLING
29
-
30
-    $ perl Build.PL
31
-    $ ./Build
32
-    $ ./Build install
33
-
34
-=head1 DESCRIPTION
35
-
36
-The mark utilities store a list of marked file paths in marks.db in the user's
37
-home directory.  Once marked, files can be copied, moved, listed, or passed as
38
-parameters to arbitrary shell commands.
39
-
40
-This originated as a simple tool for collecting files from one or more
41
-directories and moving or copying them to another.  A basic usage pattern
42
-looks something like this:
43
-
44
-    $ cd ~/screenshots
45
-    $ mark add foo.png
46
-    $ cd ~/blog/files/screenshots
47
-    $ mark mv
48
-    Moved: /home/brennen/screenshots/foo.png
49
-
50
-This is more steps than a simple invocation of mv(1), but its utility becomes
51
-more apparent when it's combined with aliases for quickly navigating
52
-directories or invoked from other programs like editors and file managers.
53
-
54
-See C<bin/mark> in this distribution (or, when installed, the mark(1) man page)
55
-for details on the commands.
56
-
57
-=cut
58
-
59
-package App::MarkFiles;
60
-
61
-use strict;
62
-use warnings;
63
-
64
-use base qw(Exporter);
65
-our @EXPORT_OK = qw(get_dbh each_path add remove check_collisions);
66
-
67
-our ($VERSION) = '0.0.1';
68
-
69
-use DBI;
70
-use File::Basename;
71
-use File::HomeDir;
72
-use File::Spec;
73
-
74
-=head1 SUBROUTINES
75
-
76
-=over
77
-
78
-=item get_dbh()
79
-
80
-Get database handle for default marks database, stored in F<~/marks.db>.
81
-
82
-Creates a new marks.db with the correct schema if one doesn't already exist.
83
-
84
-=cut
85
-
86
-sub get_dbh {
87
-  my $dbfile = File::Spec->catfile(File::HomeDir->my_home, 'marks.db');
88
-
89
-  my $init_new = 0;
90
-  $init_new = 1 unless -f $dbfile;
91
-
92
-  my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "");
93
-
94
-  create_mark_db($dbh) if $init_new;
95
-
96
-  return $dbh;
97
-}
98
-
99
-=item create_mark_db($dbh)
100
-
101
-Create a new marks table.
102
-
103
-=cut
104
-
105
-sub create_mark_db {
106
-  my ($dbh) = @_;
107
-
108
-  $dbh->do(<<'SQL'
109
-    CREATE TABLE marks (
110
-      id integer primary key,
111
-      path text,
112
-      datetime text
113
-    );
114
-SQL
115
-  );
116
-}
117
-
118
-=item add(@paths)
119
-
120
-Add a mark to one or more paths.
121
-
122
-=cut
123
-
124
-sub add {
125
-  my (@paths) = @_;
126
-
127
-  # Filter out any paths that have already been marked:
128
-  my %pathmap = map { $_ => 1 } @paths;
129
-  each_path(sub {
130
-    my ($existing_path) = @_;
131
-    if ($pathmap{ $existing_path }) {
132
-      delete $pathmap{ $existing_path };
133
-    }
134
-  });
135
-
136
-  my $sth = get_dbh()->prepare(q{
137
-    INSERT INTO marks (path, datetime) VALUES (?, datetime('now'))
138
-  });
139
-
140
-  foreach my $path (keys %pathmap) {
141
-    $sth->execute($path);
142
-  }
143
-}
144
-
145
-=item remove(@paths)
146
-
147
-Remove all given paths from the mark list.
148
-
149
-=cut
150
-
151
-sub remove {
152
-  my (@paths) = @_;
153
-
154
-  my $sth = get_dbh()->prepare(q{
155
-    DELETE FROM marks WHERE PATH = ?;
156
-  });
157
-
158
-  foreach my $path (@paths) {
159
-    $sth->execute($path);
160
-  }
161
-}
162
-
163
-=item each_path($func)
164
-
165
-Run an anonymous function against each item in the mark list.
166
-
167
-Expects a sub which takes a path string.
168
-
169
-=cut
170
-
171
-sub each_path {
172
-  my ($func) = @_;
173
-
174
-  my $sth = get_dbh()->prepare(q{
175
-    SELECT DISTINCT(path) as path FROM marks ORDER BY datetime;
176
-  });
177
-
178
-  $sth->execute();
179
-
180
-  while (my $data = $sth->fetchrow_hashref()) {
181
-    $func->($data->{path});
182
-  }
183
-}
184
-
185
-=item check_collisions()
186
-
187
-Return a list of basenames which would collide from the current list.
188
-
189
-=cut
190
-
191
-sub check_collisions {
192
-  # Accumulate a list of basenames:
193
-  my %basenames;
194
-  each_path(sub {
195
-    my ($path) = @_;
196
-    my ($source_basename, $source_path) = fileparse($path);
197
-    $basenames{ $source_basename }++;
198
-  });
199
-
200
-  my @collisions;
201
-  while(my($basename, $count) = each %basenames) {
202
-    push @collisions, $basename if 1 < $count;
203
-  }
204
-
205
-  return @collisions;
206
-}
207
-
208
-=back
209
-
210
-=head1 AUTHOR
211
-
212
-Copyright 2018 Brennen Bearnes
213
-
214
-    mark is free software; you can redistribute it and/or modify
215
-    it under the terms of the GNU General Public License as published by
216
-    the Free Software Foundation; either version 2 of the License, or
217
-    (at your option) any later version.
218
-
219
-    This program is distributed in the hope that it will be useful,
220
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
221
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
222
-    GNU General Public License for more details.
223
-
224
-=cut
225
-
226
-1;

+ 282
- 0
lib/App/Pieces.pm View File

@@ -0,0 +1,282 @@
1
+=pod
2
+
3
+=head1 NAME
4
+
5
+App::Pieces - some utility functions for bookmarking and interlinking various things
6
+
7
+=head1 SYNOPSIS
8
+
9
+tk tk tk
10
+
11
+=head1 INSTALLING
12
+
13
+    $ perl Build.PL
14
+    $ ./Build
15
+    $ ./Build install
16
+
17
+=head1 DESCRIPTION
18
+
19
+tk tk tk
20
+
21
+=cut
22
+
23
+package App::Pieces;
24
+
25
+use strict;
26
+use warnings;
27
+use 5.10.0;
28
+
29
+use base qw(Exporter);
30
+our @EXPORT_OK = qw();
31
+
32
+our ($VERSION) = '0.0.1';
33
+
34
+use Carp;
35
+use DBI;
36
+use File::Basename;
37
+use File::HomeDir;
38
+use File::Spec;
39
+use URI;
40
+
41
+my %default = (
42
+  dbfile => File::Spec->catfile(File::HomeDir->my_home, 'pieces.db')
43
+);
44
+
45
+=head1 SUBROUTINES
46
+
47
+=over
48
+
49
+=item new(%params)
50
+
51
+Get a new Pieces object with the specified parameters set.
52
+
53
+=cut
54
+
55
+sub new {
56
+  my $class = shift;
57
+  my %params = @_;
58
+
59
+  my %copy_of_default = %default;
60
+  my $self = \%copy_of_default;
61
+  bless $self, $class;
62
+
63
+  # Configure from passed-in values, overwriting defaults:
64
+  for my $p (keys %params) {
65
+    $self->{$p} = $params{$p};
66
+  }
67
+
68
+  $self->{dbh} = $self->get_dbh();
69
+
70
+  return $self;
71
+}
72
+
73
+=item get_dbh()
74
+
75
+Get database handle for default pieces database, stored in F<~/pieces.db>.
76
+
77
+Creates a new database with the correct schema if one doesn't already exist.
78
+
79
+=cut
80
+
81
+sub get_dbh {
82
+  my ($self) = shift;
83
+  my $dbfile = $self->{dbfile};
84
+
85
+  my $init_new = 0;
86
+  $init_new = 1 unless -f $dbfile;
87
+
88
+  my $dbh = DBI->connect("dbi:SQLite:dbname=$dbfile", "", "");
89
+
90
+  $self->create_pieces_db($dbh) if $init_new;
91
+
92
+  return $dbh;
93
+}
94
+
95
+=item create_pieces_db($dbh)
96
+
97
+Create new pieces tables.
98
+
99
+=cut
100
+
101
+sub create_pieces_db {
102
+  my ($self) = shift;
103
+  my ($dbh) = @_;
104
+
105
+  $dbh->do(q{
106
+    CREATE TABLE pieces (
107
+      id integer primary key,
108
+      address text,
109
+      created text
110
+    );
111
+  });
112
+
113
+  $dbh->do(q{
114
+    CREATE TABLE schema_version (
115
+      id integer primary key,
116
+      version text,
117
+      created text
118
+    );
119
+  });
120
+
121
+  $dbh->do(q{
122
+    CREATE TABLE links (
123
+      id integer primary key,
124
+      from_piece integer,
125
+      to_piece integer,
126
+      description text,
127
+      created text
128
+    );
129
+  });
130
+}
131
+
132
+=item add(@addresses)
133
+
134
+Add one or more addresses to the pieces db.
135
+
136
+=cut
137
+
138
+sub add {
139
+  my ($self) = shift;
140
+  my (@addresses) = @_;
141
+
142
+  # Filter out any paths that have already been marked:
143
+  # XXX: This is gonna get pretty silly with thousands of entries to read every
144
+  # time.
145
+  my %addressmap = map { $_ => 1 } @addresses;
146
+  $self->each_address(sub {
147
+    my ($existing_addy) = @_;
148
+    if ($addressmap{ $existing_addy }) {
149
+      delete $addressmap{ $existing_addy };
150
+    }
151
+  });
152
+
153
+  my $sth = $self->{dbh}->prepare(q{
154
+    INSERT INTO pieces (address, created) VALUES (?, datetime('now'))
155
+  });
156
+
157
+  my @ids;
158
+  foreach my $addy (keys %addressmap) {
159
+    $sth->execute($addy);
160
+
161
+    # The empty strings to last_insert_id() should just leave it
162
+    # getting the last insert for the dbh:
163
+    push @ids, $self->{dbh}->last_insert_id('', '', '', '');
164
+  }
165
+
166
+  return @ids;
167
+}
168
+
169
+sub get {
170
+  my ($self) = shift;
171
+  my ($addy) = @_;
172
+
173
+  my $find_sth = $self->{dbh}->prepare(q{
174
+    SELECT id FROM pieces WHERE address = ?;
175
+  });
176
+
177
+  my ($id) = $self->{dbh}->selectrow_array($find_sth, {}, $addy);
178
+
179
+  return $id;
180
+}
181
+
182
+sub get_or_add {
183
+  my ($self) = shift;
184
+  my ($addy) = @_;
185
+
186
+  my $id = $self->get($addy);
187
+
188
+  # If we didn't find an existing piece, add it and get its id
189
+  if (! defined $id) {
190
+    ($id) = add($addy);
191
+  }
192
+
193
+  return $id;
194
+}
195
+
196
+sub add_link {
197
+  my ($self) = shift;
198
+  my ($from, $to) = @_;
199
+
200
+  my $from_id = $self->get_or_add($from);
201
+  my $to_id = $self->get_or_add($to);
202
+
203
+  my $sth = $self->{dbh}->prepare(q{
204
+    INSERT INTO links (from_piece, to_piece, created) VALUES (?, ?, datetime('now'))
205
+  });
206
+
207
+  $sth->execute($from_id, $to_id);
208
+}
209
+
210
+=item remove(@paths)
211
+
212
+Remove all given paths from the mark list.
213
+
214
+=cut
215
+
216
+sub remove {
217
+  my ($self) = shift;
218
+  my (@addresses) = @_;
219
+
220
+  my $sth = $self->{dbh}->prepare(q{
221
+    DELETE FROM pieces WHERE address = ?;
222
+  });
223
+
224
+  foreach my $addy (@addresses) {
225
+    $sth->execute($addy);
226
+  }
227
+}
228
+
229
+=item each_address($func)
230
+
231
+Run an anonymous function against each item in the pieces list.
232
+
233
+Expects a sub which takes a path string.
234
+
235
+=cut
236
+
237
+sub each_address {
238
+  my ($self) = shift;
239
+  my ($func) = @_;
240
+
241
+  my $sth = $self->{dbh}->prepare(q{
242
+    SELECT DISTINCT(address) as address FROM pieces ORDER BY created;
243
+  });
244
+
245
+  $sth->execute();
246
+
247
+  while (my $data = $sth->fetchrow_hashref()) {
248
+    $func->($data->{address});
249
+  }
250
+}
251
+
252
+sub foreach_row {
253
+  my ($self) = shift;
254
+  my ($query, $func) = @_;
255
+
256
+  my $sth = $self->{dbh}->prepare($query);
257
+  $sth->execute();
258
+
259
+  while (my $data = $sth->fetchrow_hashref()) {
260
+    $func->($data);
261
+  }
262
+}
263
+
264
+=back
265
+
266
+=head1 AUTHOR
267
+
268
+Copyright 2018 Brennen Bearnes
269
+
270
+    mark is free software; you can redistribute it and/or modify
271
+    it under the terms of the GNU General Public License as published by
272
+    the Free Software Foundation; either version 2 of the License, or
273
+    (at your option) any later version.
274
+
275
+    This program is distributed in the hope that it will be useful,
276
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
277
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
278
+    GNU General Public License for more details.
279
+
280
+=cut
281
+
282
+1;

+ 6
- 0
test.sh View File

@@ -0,0 +1,6 @@
1
+sudo ./Build install
2
+rm ~/pieces.db
3
+pieces add https://p1k3.com/
4
+pieces add https://squiggle.city/
5
+pieces ls
6
+pieces link https://p1k3.com/ https://squiggle.city/

Loading…
Cancel
Save