#!/usr/bin/perl -w

use strict;
use Cwd;
use DBI ();


# Another auxiliary function which exits the program with return value 1 after
# optionally printing a message to STDERR.  Akin to die but without the silly
# line number output which users don't have any use for.  To be used for errors
# which are the user's fault, rather than the programmer's.
# -> Error message
sub croak
{
    print STDERR @_, "\n" if @_;
    exit 1;
}


# Find uniquely abbreviated string in list.  If choice is unavailable or not
# unique, dies with error message if descriptive string is passed, and returns
# undef otherwise.
# -> Selection, possibly abbreviated
#    Reference to array of legal strings
#    Word describing what is being selected (for error message generation)
# <- Selection (full string, not abbreviated)
sub prefixchoice
{
    my ($choice, $list, $what)= @_;

    my $re= qr/^\Q$choice\E/i;
    my @candidates= grep /$re/, @$list;
    return $candidates[0] if @candidates == 1;
    return undef unless defined $what;
    croak("Unknown $what \`$choice'.  Choices are: ", join(", ", @$list), "\n")
        unless @candidates;
    croak("Ambiguous $what \`$choice'.  Could be: ", join(", ", @candidates), "\n");
}


my $home= Cwd::abs_path($ENV{HOME});


# Canonicalise file path for reference database.  URLs with a scheme are not
# modified.
# <-> Reference to scalar containing path
sub canonref
{
    my ($path)= @_;

    return if $$path =~ m!^\w+://!;
    $$path =~ s!/*$!/! if -d $$path;
    $$path= Cwd::abs_path($$path);
    if( substr($$path, 0, length($home)+1) eq "$home/" ) {
        $$path= "~" . substr($$path, length($home));
    }
}

# Canonicalise possibly non-existing file path for moving refs.  Final slashes
# are retained.  The directory in which the file resides has to exist.
# <-> Reference to scalar containing path
sub canonfake
{
    my ($path)= @_;

    return if $$path =~ m!^\w+://!;

    if( -e $$path ) {
        my $slash= $$path =~ m!/$!;
        $$path= Cwd::abs_path($$path);
        $$path =~ s!/*$!/! if $slash;
        if( substr($$path, 0, length($home)+1) eq "$home/" ) {
            $$path= "~" . substr($$path, length($home));
        }
        return;
    }
    $$path= Cwd::cwd() . "/" . $$path unless $$path =~ m!^[/~]!;
    my $dir= $$path;
    $dir =~ s|[^/]+$||;
    if( -d $dir && substr(Cwd::abs_path($dir), 0, length($home)+1) eq "$home/" ) {
        $$path =~ s|^.*/||;
        $$path= "~" . substr(Cwd::abs_path($dir), length($home)) . "/" . $$path;
    }
}


my $dbfile= "/home/vs/info/infodb/refs.sqlite";
my $table= "refs";
my $types= [ qw(page site database local) ];


my $op;
if( $0 =~ m!(?:^|/)(add|del|search|mv)[^/]*$!i ) {
    $op= $1;
}
else {
    print STDERR "Unknown symlink / operation name \`$0'.  Legal operations start with one of add, del, search or mv.\n";
    exit;
}


my $db= DBI->connect( "dbi:SQLite:dbname=$dbfile", "", "" )
    or croak "Error opening database file $dbfile: $DBI::errstr";

my ($keywstr, $sqlstr, $query, $rowref);

if( $op eq "add" )
{
    my $addusage= <<EOF;
usage: $0 [-f] <page|site|database|local> <url/path> <keyword1> ...
Adds entry to the reference database.  If it exists, keywords are appended
except when -f (force) is given, when they are replaced.  The type argument
(page, ...) may be abbreviated.  It can be omitted for local files names
containing slashes.
EOF
    my $force;
    if( @ARGV && $ARGV[0] eq "-f" ) {
        $force= 1;
        shift @ARGV;
    }
    my ($type, $url);
    croak $addusage unless @ARGV >= 2;
    $type= prefixchoice($ARGV[0], $types, undef);
    shift @ARGV if $type;
    croak $addusage unless @ARGV >= 2;
    if( $ARGV[0] =~ m!^\w+://! && $ARGV[0] !~ m!^file://!i ) {
        defined($type) && $type ne "local" or croak "Need reference type (one of ".join(", ", grep $_ ne "local", @$types).") for URLs.";
        $url= shift @ARGV;
    }
    else {
        $ARGV[0] =~ s!^file://!!i;
        -e $ARGV[0] or croak "File `$ARGV[0]' does not exist.";
        !defined($type) || $type eq "local" or croak "Type has to be `local' for local files.";
        $type= "local";
        $url= shift @ARGV;
        canonref(\$url);
    }
    $keywstr= join(", ", @ARGV);
    $keywstr =~ s/'/''/g;

    $query= $db->prepare("select * from $table where url = '$url';");
    $query->execute() or croak "$0: Error querying database: $DBI::errstr";
    my $action;
    if( $rowref= $query->fetchrow_arrayref() ) {
        $keywstr= $$rowref[2] . ", " . $keywstr unless $force;
        $sqlstr= "update $table set type='$type', keywords='$keywstr', date=date('now') where url='$url';";
        $action= "updating";
    }
    else {
        $sqlstr= "insert into $table values ('$url', '$type', '$keywstr', date('now'));";
        $action= "inserting";
    }
    $query->finish();

    $query= $db->prepare($sqlstr);
    $query->execute() or croak "$0: Error $action database entry: $DBI::errstr";
    $query->finish();
}
elsif( $op eq "del" )
{
    @ARGV == 1 or croak "usage: $0 <URL/path>\nRemoves an entry from the reference database.\n";
    my $url= shift @ARGV;
    canonref(\$url);

    $query= $db->prepare("delete from $table where url = '$url';");
    $query->execute() or croak "$0: Error deleting database entry: $DBI::errstr";
    $query->finish();
}
elsif( $op eq "search" )
{
    my $quiet;
    if( @ARGV && $ARGV[0] eq "-q" ) {
        $quiet= 1;
        shift @ARGV;
    }
    @ARGV > 0 or croak "usage: $0 [-q] <keywords> ...\nlooks for an entry with all <keywords> in the reference database.\nWith -q, only the URL/path is output.\n";

    $keywstr= join "%' and keywords like '%", @ARGV;

    $query= $db->prepare("select * from $table where keywords like '%$keywstr%';");
    $query->execute() or croak "$0: Error querying database: $DBI::errstr\n";

    while( $rowref = $query->fetchrow_arrayref() ) {
        print "$$rowref[0]\n    $$rowref[1]    $$rowref[3]    $$rowref[2]\n";
        print "    $$rowref[4]\n" if $$rowref[4];
    }

    $query->finish();
}
elsif( $op eq "mv" )
{
    my ($noop, $multi);

    if( @ARGV && $ARGV[0] =~ /^-n$/ ) {
        $noop= 1;
        shift @ARGV;
    }
    @ARGV == 2 or croak <<EOF;
usage: $0 [ -n ] <source> <destination>
Renames or moves <source> to <destination> in the reference database.  If 
<source> ends on '/', all entries starting with <source> are moved.  If only
<destination> ends on '/' and is an existing directory, the base name of
<source> is appended.  -n causes a dummy run.
EOF
    my ($srcpre, $destpre)= @ARGV;

    if( ($srcpre =~ m!^\w+://!) != ($destpre =~ m!^\w+://!) ) {
        print STDERR "Cannot move URLs to file names or vice versa.\n";
        exit 1;
    }
    $srcpre =~ s!/+$!/!;
    $destpre =~ s!/+$!/!;
    $multi= $srcpre =~ m!/$!;
    if( $srcpre =~ m!^\w+://! ) {
        $multi= 0 unless $destpre =~ m!/$!;
    }
    elsif( -d $destpre ) {
        if( -d $srcpre ) {
            if( $multi ) {
                $destpre =~ s!/*$!/!;    # append slash if not present
            }
            elsif( $destpre =~ m!/$! ) {
                $destpre =~ s!/+$!!;
                $srcpre =~ m!([^/]+)/?$!;
                my $srcname= $1;
                $destpre .= "$srcname";
            }
        }
        else {
            $srcpre =~ m!([^/]+)/?$!;
            my $srcname= $1;
            $destpre =~ s!/*$!/$srcname!;
            if( ! -f $srcpre && ! -f $destpre ) {
                print STDERR "Neither `$srcpre' nor `$destpre' are existing files - what are you trying to move?\n";
                exit 1;
            }
        }
    }
    elsif( ! -e $destpre ) {
        $destpre =~ s!/*$!/! if $multi;
    }
    # Since this must work when src or dest do not exist (yet or any more), we
    # cannot rely on canonref() for canonicalising paths
    if( $srcpre !~ m!^\w+://! ) {
        canonfake \$srcpre;
        canonfake \$destpre;
    }
# print STDERR "src $srcpre dest $destpre\n";

    $multi= $multi ? "\%" : "";
    $query= $db->prepare("select url from $table where url like '$srcpre$multi';");
    $query->execute() or croak "$0: Error querying database: $DBI::errstr\n";
    my @urls= map $$_[0], @{$query->fetchall_arrayref()};
    $query->finish();
    unless( @urls ) {
        if( $multi ) {
            print "No URLs/paths with prefix `$srcpre' found in reference database.\n";
        }
        else {
            print "`$srcpre' not found in reference database.\n";
        }
        exit;
    }
    for my $src (@urls) {
        my $dest= $destpre . substr($src, length($srcpre));
        print "$src  ->  $dest\n";
        next if $noop;
        $query= $db->prepare("update $table set url='$dest' where url='$src';");
        $query->execute() or print STDERR "$0: Error moving $src: $DBI::errstr\n";
        $query->finish();
    }
}


$db->disconnect;