From 9a1001da0406efa10e7c7a838d77b9466b811a44 Mon Sep 17 00:00:00 2001 From: dakkar Date: Tue, 2 Jan 2018 17:55:53 +0000 Subject: the db model is sqlite-specific, make it obvious --- lib/Ultramarine/Model/DB.pm6 | 259 +----------------------------------- lib/Ultramarine/Model/DB/SQLite.pm6 | 257 +++++++++++++++++++++++++++++++++++ 2 files changed, 263 insertions(+), 253 deletions(-) create mode 100644 lib/Ultramarine/Model/DB/SQLite.pm6 (limited to 'lib') 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; - my $album-id = self.ensure-album(:title($_),:$artist-id) - with %metadata; - 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 = from-json(%song); - 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; + my $album-id = self.ensure-album(:title($_),:$artist-id) + with %metadata; + 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 = from-json(%song); + 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; + } +} -- cgit v1.2.3