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=$ROOT-DIR-ID;
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 Ultramarine::Model::DB::File.new(
|(%song<id path mtime metadata album_id>:p.Capture),
);
}
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 top-folders() {
return (Ultramarine::Model::DB::Directory.new(
id => $ROOT-DIR-ID,
name => 'Music',
),);
}
method dir-children-of(Int() :$id = $ROOT-DIR-ID) {
my $sth = $!dbh.prepare(q:to/END/);
SELECT *
FROM directories
WHERE parent_id = ?
AND id != ?
ORDER BY name ASC
END
# the C< AND id != ? > is because the root dir is its own
# parent, and we never want to return it
$sth.execute($id,$id);
return gather {
while $sth.row(:hash) -> %dir {
take Ultramarine::Model::DB::Directory.new(
|(%dir<id name>:p.Capture),
);
}
.finish with $sth;
};
}
method songs-children-of(Int() :$id = $ROOT-DIR-ID) {
my $sth = $!dbh.prepare(q:to/END/);
SELECT *
FROM songs
WHERE directory_id = ?
ORDER BY path ASC
END
$sth.execute($id);
return gather {
while $sth.row(:hash) -> %song {
take unpack-row(%song);
}
.finish with $sth;
};
}
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;
}
}