summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bin/ultramarine7
-rw-r--r--lib/Ultramarine/Model/DB.pm6259
-rw-r--r--lib/Ultramarine/Model/DB/SQLite.pm6257
3 files changed, 266 insertions, 257 deletions
diff --git a/bin/ultramarine b/bin/ultramarine
index e7c545e..513e861 100644
--- a/bin/ultramarine
+++ b/bin/ultramarine
@@ -3,7 +3,7 @@ use v6.d.PREVIEW;
use Ultramarine::Model::License;
use Ultramarine::Model::Users;
use Ultramarine::Model::DirScanner;
-use Ultramarine::Model::DB;
+use Ultramarine::Model::DB::SQLite;
use Ultramarine::Model::MusicFile;
use Ultramarine::Model::Collection;
use Ultramarine::Middleware::Authentication;
@@ -20,9 +20,8 @@ my $users = Ultramarine::Model::Users.new(
my $controller = Ultramarine::Controller.new(
license => Ultramarine::Model::License.new,
collection => Ultramarine::Model::Collection.new(
- db => Ultramarine::Model::DB.new(
- :db-driver<SQLite>,
- :db-args(:database('/tmp/songs.sqlite')),
+ db => Ultramarine::Model::DB::SQLite.new(
+ :db-path('/tmp/songs.sqlite'),
),
dirscan => Ultramarine::Model::DirScanner.new(
:root('/mnt/music/Alanis Morissette'),
diff --git a/lib/Ultramarine/Model/DB.pm6 b/lib/Ultramarine/Model/DB.pm6
index 422cd3e..8b034ca 100644
--- a/lib/Ultramarine/Model/DB.pm6
+++ b/lib/Ultramarine/Model/DB.pm6
@@ -1,257 +1,10 @@
use v6.d.PREVIEW;
-use DBIish;
-use Ultramarine::Model::DBMigration;
-use JSON::Fast;
-class Ultramarine::Model::DB {
- has $.db-driver is required;
- has %.db-args is required;
+role Ultramarine::Model::DB {
+ method seen-file(:$path) { ... }
+ method remove-unseen-files() { ... }
- constant $ROOT-DIR-ID=0;
-
- my @migrations = (
- -> $dbh {
- $dbh.do(q:to/END/);
- CREATE TABLE directories (
- id INTEGER PRIMARY KEY,
- name TEXT NOT NULL,
- parent_id INTEGER NOT NULL,
- FOREIGN KEY (parent_id) REFERENCES directories(id),
- UNIQUE (name,parent_id)
- )
- END
-
- $dbh.do(q:to/END/,$ROOT-DIR-ID,'/',$ROOT-DIR-ID);
- INSERT INTO directories(id,name,parent_id) VALUES (?,?,?)
- END
-
- $dbh.do(q:to/END/);
- CREATE TABLE artists (
- id INTEGER PRIMARY KEY,
- name TEXT UNIQUE NOT NULL
- )
- END
-
- $dbh.do(q:to/END/);
- CREATE TABLE albums (
- id INTEGER PRIMARY KEY,
- title TEXT UNIQUE NOT NULL,
- artist_id INTEGER NOT NULL,
- FOREIGN KEY (artist_id) REFERENCES artists(id),
- UNIQUE (title,artist_id)
- )
- END
-
- $dbh.do(q:to/END/);
- CREATE TABLE songs (
- id INTEGER PRIMARY KEY,
- path TEXT UNIQUE NOT NULL,
- mtime INTEGER NOT NULL,
- directory_id INTEGER,
- album_id INTEGER,
- metadata TEXT DEFAULT '{}',
- FOREIGN KEY (directory_id) REFERENCES directories(id),
- FOREIGN KEY (album_id) REFERENCES albums(id)
- )
- END
-
- $dbh.do(q:to/END/);
- CREATE TABLE seen_files (
- path TEXT NOT NULL
- )
- END
- },
- );
-
- has $!dbh = do {
- my $dbh = DBIish.connect($!db-driver, |%!db-args);
- $dbh.do(q{PRAGMA foreign_keys=ON});
- my Ultramarine::Model::DBMigration $migration .= new(:$dbh,:@migrations);
- $migration.ensure-schema;
- $dbh;
- };
-
- method ensure-artist(:$name!) {
- my $sth = $!dbh.prepare(q:to/END/);
- INSERT OR IGNORE INTO artists(name) VALUES (?)
- END
- $sth.execute($name);
- $sth.finish;
- $sth = $!dbh.prepare(q:to/END/);
- SELECT id
- FROM artists
- WHERE name=?
- END
- $sth.execute($name);
- return $sth.row()[0];
-
- LEAVE { .finish with $sth }
- }
-
- method ensure-album(:$title!,:$artist-id!) {
- my $sth = $!dbh.prepare(q:to/END/);
- INSERT OR IGNORE INTO albums(title,artist_id) VALUES (?,?)
- END
- $sth.execute($title,$artist-id);
- $sth.finish;
- $sth = $!dbh.prepare(q:to/END/);
- SELECT id
- FROM albums
- WHERE title=? AND artist_id=?
- END
- $sth.execute($title,$artist-id);
- return $sth.row()[0];
-
- LEAVE { .finish with $sth }
- }
-
- method ensure-one-directory(:$name!,:$parent-id!) {
- my $sth = $!dbh.prepare(q:to/END/);
- INSERT OR IGNORE INTO directories(name,parent_id) VALUES (?,?)
- END
- $sth.execute($name,$parent-id // $ROOT-DIR-ID);
- $sth.finish;
- $sth = $!dbh.prepare(q:to/END/);
- SELECT id
- FROM directories
- WHERE name=? AND parent_id=?
- END
- $sth.execute($name,$parent-id // $ROOT-DIR-ID);
- return $sth.row()[0];
-
- LEAVE { .finish with $sth }
- }
-
- method ensure-directories(IO() :$path!) {
- my $rel-path = $path.relative($path.CWD).IO;
- my @components = gather {
- while $rel-path ne '.'|'/' {
- take $rel-path.basename;
- $rel-path .= parent;
- }
- };
- my $parent-id=Nil;
- while my $name = @components.pop {
- $parent-id = self.ensure-one-directory(:$name,:$parent-id);
- }
- return $parent-id;
- }
-
- method ensure-song(IO() :$path!,:$mtime!,:%metadata!) {
- CATCH { default { .perl.say } }
- my $last-dir-id = self.ensure-directories(:path($path.dirname));
- my $artist-id = self.ensure-artist(:name($_))
- with %metadata<tags><artist>;
- my $album-id = self.ensure-album(:title($_),:$artist-id)
- with %metadata<tags><album>;
- my $sth = $!dbh.prepare(q:to/END/);
- INSERT OR REPLACE INTO songs(path,mtime,directory_id,album_id,metadata)
- VALUES (?,?,?,?,?)
- END
- LEAVE { .finish with $sth }
- $sth.execute($path.Str,$mtime,$last-dir-id,$album-id,to-json(%metadata));
- }
-
- method seen-file(Str() :$path!) {
- $!dbh.do(q:to/END/,$path);
- INSERT INTO seen_files(path) VALUES (?)
- END
- }
- method remove-unseen-files() {
- $!dbh.do(q:to/END/);
- DELETE FROM songs
- WHERE NOT EXISTS (
- SELECT * FROM seen_files f WHERE f.path = songs.path
- )
- END
- $!dbh.do('DELETE FROM seen_files');
-
- self.remove-empty();
- }
-
- method ensure-file-absent(Str() :$path!) {
- $!dbh.do(q:to/END/,$path);
- DELETE FROM songs
- WHERE path=?
- END
-
- self.remove-empty();
- }
-
- method remove-empty() {
- my $affected-rows=1;
- while $affected-rows > 0 {
- $affected-rows = $!dbh.do(q:to/END/);
- DELETE FROM directories
- WHERE NOT EXISTS (
- SELECT directory_id
- FROM songs
- WHERE songs.directory_id=directories.id
- UNION ALL
- SELECT parent_id
- FROM directories d2
- WHERE d2.parent_id=directories.id
- )
- END
- }
- $!dbh.do(q:to/END/);
- DELETE FROM albums
- WHERE NOT EXISTS (
- SELECT album_id
- FROM songs
- WHERE songs.album_id=albums.id
- )
- END
- $!dbh.do(q:to/END/);
- DELETE FROM artists
- WHERE NOT EXISTS (
- SELECT artist_id
- FROM albums
- WHERE albums.artist_id=artists.id
- )
- END
- }
-
- sub unpack-row(%song is copy) {
- %song<metadata> = from-json(%song<metadata>);
- return %song;
- }
-
- method get-song(Str() :$path!) {
- my $sth = $!dbh.prepare(q:to/END/);
- SELECT *
- FROM songs
- WHERE path=?
- END
- LEAVE { .finish with $sth }
- $sth.execute($path);
- return unpack-row($sth.row(:hash));
- }
-
- method all-songs() {
- my $sth = $!dbh.prepare(q:to/END/);
- SELECT *
- FROM songs
- ORDER BY path ASC
- END
- $sth.execute();
- return gather {
- while $sth.row(:hash) -> %song {
- take unpack-row(%song);
- }
- .finish with $sth;
- }
- }
-
- method is-up-to-date(Str() :$path!,:$mtime!) {
- my $sth = $!dbh.prepare(q:to/END/);
- SELECT COUNT(*)
- FROM songs
- WHERE path=?
- AND mtime >= $mtime
- END
- LEAVE { .finish with $sth };
- $sth.execute($path,$mtime);
- return ($sth.row[0]//0).Bool;
- }
+ method is-up-to-date(:$path,:$mtime --> Bool) { ... }
+ method ensure-song(:$path,:$mtime,:%metadata) { ... }
+ method ensure-file-absent(:$path) { ... }
}
diff --git a/lib/Ultramarine/Model/DB/SQLite.pm6 b/lib/Ultramarine/Model/DB/SQLite.pm6
new file mode 100644
index 0000000..8a0e017
--- /dev/null
+++ b/lib/Ultramarine/Model/DB/SQLite.pm6
@@ -0,0 +1,257 @@
+use v6.d.PREVIEW;
+use DBIish;
+use Ultramarine::Model::DBMigration;
+use Ultramarine::Model::DB;
+use JSON::Fast;
+
+class Ultramarine::Model::DB::SQLite does Ultramarine::Model::DB {
+ has $.db-path is required;
+
+ constant $ROOT-DIR-ID=0;
+
+ my @migrations = (
+ -> $dbh {
+ $dbh.do(q:to/END/);
+ CREATE TABLE directories (
+ id INTEGER PRIMARY KEY,
+ name TEXT NOT NULL,
+ parent_id INTEGER NOT NULL,
+ FOREIGN KEY (parent_id) REFERENCES directories(id),
+ UNIQUE (name,parent_id)
+ )
+ END
+
+ $dbh.do(q:to/END/,$ROOT-DIR-ID,'/',$ROOT-DIR-ID);
+ INSERT INTO directories(id,name,parent_id) VALUES (?,?,?)
+ END
+
+ $dbh.do(q:to/END/);
+ CREATE TABLE artists (
+ id INTEGER PRIMARY KEY,
+ name TEXT UNIQUE NOT NULL
+ )
+ END
+
+ $dbh.do(q:to/END/);
+ CREATE TABLE albums (
+ id INTEGER PRIMARY KEY,
+ title TEXT UNIQUE NOT NULL,
+ artist_id INTEGER NOT NULL,
+ FOREIGN KEY (artist_id) REFERENCES artists(id),
+ UNIQUE (title,artist_id)
+ )
+ END
+
+ $dbh.do(q:to/END/);
+ CREATE TABLE songs (
+ id INTEGER PRIMARY KEY,
+ path TEXT UNIQUE NOT NULL,
+ mtime INTEGER NOT NULL,
+ directory_id INTEGER,
+ album_id INTEGER,
+ metadata TEXT DEFAULT '{}',
+ FOREIGN KEY (directory_id) REFERENCES directories(id),
+ FOREIGN KEY (album_id) REFERENCES albums(id)
+ )
+ END
+
+ $dbh.do(q:to/END/);
+ CREATE TABLE seen_files (
+ path TEXT NOT NULL
+ )
+ END
+ },
+ );
+
+ has $!dbh = do {
+ my $dbh = DBIish.connect('SQLite', :database($!db-path));
+ $dbh.do(q{PRAGMA foreign_keys=ON});
+ my Ultramarine::Model::DBMigration $migration .= new(:$dbh,:@migrations);
+ $migration.ensure-schema;
+ $dbh;
+ };
+
+ method ensure-artist(:$name!) {
+ my $sth = $!dbh.prepare(q:to/END/);
+ INSERT OR IGNORE INTO artists(name) VALUES (?)
+ END
+ $sth.execute($name);
+ $sth.finish;
+ $sth = $!dbh.prepare(q:to/END/);
+ SELECT id
+ FROM artists
+ WHERE name=?
+ END
+ $sth.execute($name);
+ return $sth.row()[0];
+
+ LEAVE { .finish with $sth }
+ }
+
+ method ensure-album(:$title!,:$artist-id!) {
+ my $sth = $!dbh.prepare(q:to/END/);
+ INSERT OR IGNORE INTO albums(title,artist_id) VALUES (?,?)
+ END
+ $sth.execute($title,$artist-id);
+ $sth.finish;
+ $sth = $!dbh.prepare(q:to/END/);
+ SELECT id
+ FROM albums
+ WHERE title=? AND artist_id=?
+ END
+ $sth.execute($title,$artist-id);
+ return $sth.row()[0];
+
+ LEAVE { .finish with $sth }
+ }
+
+ method ensure-one-directory(:$name!,:$parent-id!) {
+ my $sth = $!dbh.prepare(q:to/END/);
+ INSERT OR IGNORE INTO directories(name,parent_id) VALUES (?,?)
+ END
+ $sth.execute($name,$parent-id // $ROOT-DIR-ID);
+ $sth.finish;
+ $sth = $!dbh.prepare(q:to/END/);
+ SELECT id
+ FROM directories
+ WHERE name=? AND parent_id=?
+ END
+ $sth.execute($name,$parent-id // $ROOT-DIR-ID);
+ return $sth.row()[0];
+
+ LEAVE { .finish with $sth }
+ }
+
+ method ensure-directories(IO() :$path!) {
+ my $rel-path = $path.relative($path.CWD).IO;
+ my @components = gather {
+ while $rel-path ne '.'|'/' {
+ take $rel-path.basename;
+ $rel-path .= parent;
+ }
+ };
+ my $parent-id=Nil;
+ while my $name = @components.pop {
+ $parent-id = self.ensure-one-directory(:$name,:$parent-id);
+ }
+ return $parent-id;
+ }
+
+ method ensure-song(IO() :$path!,:$mtime!,:%metadata!) {
+ CATCH { default { .perl.say } }
+ my $last-dir-id = self.ensure-directories(:path($path.dirname));
+ my $artist-id = self.ensure-artist(:name($_))
+ with %metadata<tags><artist>;
+ my $album-id = self.ensure-album(:title($_),:$artist-id)
+ with %metadata<tags><album>;
+ my $sth = $!dbh.prepare(q:to/END/);
+ INSERT OR REPLACE INTO songs(path,mtime,directory_id,album_id,metadata)
+ VALUES (?,?,?,?,?)
+ END
+ LEAVE { .finish with $sth }
+ $sth.execute($path.Str,$mtime,$last-dir-id,$album-id,to-json(%metadata));
+ }
+
+ method seen-file(Str() :$path!) {
+ $!dbh.do(q:to/END/,$path);
+ INSERT INTO seen_files(path) VALUES (?)
+ END
+ }
+ method remove-unseen-files() {
+ $!dbh.do(q:to/END/);
+ DELETE FROM songs
+ WHERE NOT EXISTS (
+ SELECT * FROM seen_files f WHERE f.path = songs.path
+ )
+ END
+ $!dbh.do('DELETE FROM seen_files');
+
+ self.remove-empty();
+ }
+
+ method ensure-file-absent(Str() :$path!) {
+ $!dbh.do(q:to/END/,$path);
+ DELETE FROM songs
+ WHERE path=?
+ END
+
+ self.remove-empty();
+ }
+
+ method remove-empty() {
+ my $affected-rows=1;
+ while $affected-rows > 0 {
+ $affected-rows = $!dbh.do(q:to/END/);
+ DELETE FROM directories
+ WHERE NOT EXISTS (
+ SELECT directory_id
+ FROM songs
+ WHERE songs.directory_id=directories.id
+ UNION ALL
+ SELECT parent_id
+ FROM directories d2
+ WHERE d2.parent_id=directories.id
+ )
+ END
+ }
+ $!dbh.do(q:to/END/);
+ DELETE FROM albums
+ WHERE NOT EXISTS (
+ SELECT album_id
+ FROM songs
+ WHERE songs.album_id=albums.id
+ )
+ END
+ $!dbh.do(q:to/END/);
+ DELETE FROM artists
+ WHERE NOT EXISTS (
+ SELECT artist_id
+ FROM albums
+ WHERE albums.artist_id=artists.id
+ )
+ END
+ }
+
+ sub unpack-row(%song is copy) {
+ %song<metadata> = from-json(%song<metadata>);
+ return %song;
+ }
+
+ method get-song(Str() :$path!) {
+ my $sth = $!dbh.prepare(q:to/END/);
+ SELECT *
+ FROM songs
+ WHERE path=?
+ END
+ LEAVE { .finish with $sth }
+ $sth.execute($path);
+ return unpack-row($sth.row(:hash));
+ }
+
+ method all-songs() {
+ my $sth = $!dbh.prepare(q:to/END/);
+ SELECT *
+ FROM songs
+ ORDER BY path ASC
+ END
+ $sth.execute();
+ return gather {
+ while $sth.row(:hash) -> %song {
+ take unpack-row(%song);
+ }
+ .finish with $sth;
+ }
+ }
+
+ method is-up-to-date(Str() :$path!,:$mtime!) {
+ my $sth = $!dbh.prepare(q:to/END/);
+ SELECT COUNT(*)
+ FROM songs
+ WHERE path=?
+ AND mtime >= $mtime
+ END
+ LEAVE { .finish with $sth };
+ $sth.execute($path,$mtime);
+ return ($sth.row[0]//0).Bool;
+ }
+}