path: root/videomv.pl

#! /usr/bin/perl -w

# This program is free software. It comes without any warranty, to the
# extent permitted by applicable law. You can redistribute it and/or
# modify it under the terms of the Do What The Fuck You Want To Public
# License, Version 2, as published by Sam Hocevar.
# See http://sam.zoy.org/wtfpl/COPYING for more details.


$VERSION = "0.1, 08 August 2011";

use Getopt::Long qw(:config posix_default no_ignore_case gnu_compat
                            bundling auto_version auto_help);
use Pod::Usage;
use DBI;
use File::Basename;
use strict;

################################################################################

# This path has to be absolute!
my $video     = "/home/guilhem/video";

my $symlinks  = "MOVIES";       # Symlinks folder in $video
my $directors = "DIRECTORS";    # Directors folder in $video

# Database configuration
my $driver    = "mysql";
my $database  = "videodb";
my $hostname  = "127.0.0.1";
my $user      = "videodb";
my $port      = 3306;
my $password  = "videodb";
my $videodata = "videodb_videodata";

################################################################################

=head1 NAME

videomv.pl - TODO

=head1 SYNOPSIS

B<videomv.pl> [B<--sort>] I<path/to/oldfile> [I<.../>{I<MOVIES>,I<DIRECTORS/director/>}I</>[I<newfile>]]

video
  |- ...
  |- DIRECTORS
  |    |- director1/
  |    |- director2/
  |    `- ...
  `- MOVIES/


=head1 DESCRIPTION

Depending on whether I<path/to/> is I<.../MOVIES/>,
I<.../DIRECTORS/director/>, or something
else, one has one of the six behaviors below. For the sake of
readability the paths are absolute here, but relative paths are fine as
well.

=over 4

=item B<videomv.pl> [B<--sort>] I<.../MOVIES/oldfile> I<.../MOVIES/newfile>

I<oldfile> is supposed to be an existing symlink in I<.../MOVIES/>,
which targets to I<../DIRECTORS/director/oldfile>. If
I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
actions will be performed:

=over 4

=item * The filename in the database will be updated,

=item * the old target will be renamed to I<../DIRECTORS/director/newfile>,

=item * the old symlink will be deleted, and

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
will be created.

=back

If the B<--sort> flag is set, the new I<director> will be find on the
database instead of from the old target. 


=item B<videomv.pl> I<.../MOVIES/oldfile> I<.../DIRECTOR/newdirector/>[I<newfile>]

I<oldfile> is supposed to be an existing symlink in I<.../MOVIES/>,
which targets to I<../DIRECTORS/olddirector/oldfile>. If
I<olddirector/oldfile>=I<newdirector/newfile>
(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
an error will be raised.
Otherwise, the following actions will be performed:

=over 4

=item * The filename in the database will be updated if I<oldfile><>I<newfile>,

=item * the old target will be moved to I<../DIRECTORS/newdirector/newfile>,
(or to I<../DIRECTORS/newdirector/oldfile> if I<newfile> was not given),

=item * the old symlink will be deleted, and

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
(or -> I<../DIRECTORS/newdirector/oldfile> if I<newfile> was not given)
will be created.

=back


=item B<videomv.pl> [B<--sort>] I<.../DIRECTORS/director/oldfile> I<.../MOVIES/newfile>

A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> is
supposed to exist.
If I<oldfile>=I<newfile>, an error will be raised. Otherwise, the following
actions will be performed:

=over 4

=item * The filename in the database will be updated,

=item * the old target I<../DIRECTORS/director/oldfile> will be renamed to
I<../DIRECTORS/director/newfile>,

=item * the old symlink will be deleted, and

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
will be created.

=back


=item B<videomv.pl> I<.../DIRECTORS/olddirector/oldfile> I<.../DIRECTOR/newdirector/>[I<newfile>]

A symlink I<.../MOVIES/oldfile> -> I<../DIRECTORS/olddirector/oldfile> is
supposed to exist.  
If I<olddirector/oldfile>=I<newdirector/newfile>
(or if I<olddirector>=I<newdirector> and I<newfile> was not given),
an error will be raised.
Otherwise, the following actions will be performed:

=over 4

=item * The filename in the database will be updated if I<oldfile><>I<newfile>,

=item * the old target I<../DIRECTORS/olddirector/oldfile> will be moved to
I<../DIRECTORS/newdirector/newfile>,

=item * the old symlink will be deleted, and

=item * a new symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/newdirector/newfile>
will be created.

=back


=item B<videomv.pl> B<--sort> I<path/to/oldfile> [I<.../MOVIES/newfile>]

Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>.
The director will looked for in the database, and and error will be
raised if no entry is found.
Otherwise, the following actions will be performed:

=over 4

=item * The filename in the database will be updated if I<oldfile><>I<newfile>,

=item * the old file will be moved to I<../DIRECTORS/director/newfile>
(or to I<../DIRECTORS/director/oldfile> if the second argument was not
given),

=item * a symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
(or I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second
argument was not given) will be created.

=back

Note that the B<--sort> has to set for this to work; if not, an error
will be raised.


=item B<videomv.pl> I<path/to/oldfile> I<.../DIRECTOR/director/>[I<newfile>]

Where I<path/to/> is neither of I<.../MOVIES/> nor I<.../DIRECTORS/*/>.
The following actions will be performed:

=over 4

=item * The filename in the database will be updated if I<oldfile><>I<newfile>,

=item * the old file will be moved to I<../DIRECTORS/director/newfile>
(or to I<../DIRECTORS/director/oldfile> if I<newfile> was not given),

=item * a symlink I<.../MOVIES/newfile> -> I<../DIRECTORS/director/newfile>
(or I<.../MOVIES/oldfile> -> I<../DIRECTORS/director/oldfile> if the second
argument was not given) will be created.

=back

=back


=head1 OPTIONS

=over 8

=item B<--sort>

TODO

=back

=head1 EXIT STATUS

TODO

=head1 REQUIREMENTS

TODO

=head1 AUTHOR

Copyright 2011 Guilhem Moulin. See the source for copying conditions.

=cut

################################################################################

my $man;
my $quiet;


# Get options
GetOptions( "q|quiet" => sub { open LOG, '>', '/dev/null'
                               or die "Cannot open `/dev/null': $!" },
            "man"     => sub { pod2usage(-exitstatus => 0, -verbose => 2) }
          )
    or  pod2usage(2);
pod2usage(2)  if  ($#ARGV < 0 or $#ARGV > 1);
*LOG = *STDERR  unless  defined (fileno LOG);


# File to rename/sort, with its path
my $old_file = $ARGV[0];

# Basenames of files to rename to / sort
my ($old_filename, $new_filename) = map {basename($_)} @ARGV;


# Connect to database
my $dsn = "DBI:$driver:database=$database;host=$hostname;port=$port";
my $dbh = DBI->connect($dsn, $user, $password)
              or die "Can't connect do database";
$dbh->do( "set names utf8" ) or die;


# Lookup for the file in the videodb database
my $RES =
    $dbh->selectall_hashref ( "SELECT id,director,title FROM $videodata
                               WHERE filename = ?",
                              'id', undef, $old_filename
    )
        or die "Can't select: " . $dbh->errstr;

my $nRES = scalar (keys %$RES);

die "Error: no entry entry found in the database.\n" if $nRES == 0;
die "Error: $nRES > 1 entries found in the database.\n" if $nRES > 1;


# The *unique* ID of the movie found in the database
my $id = each %$RES;


print LOG "One entry found: " .
          $RES->{$id}->{director} .  " - " . $RES->{$id}->{title} . "\n";

if (defined $new_filename) {
#    print LOG "Update filename for " .
#              $RES->{$id}->{director} .  " - " .  $RES->{$id}->{title} .
#              ":\n";
#    print LOG "`" . $old_filename . "' -> `" . $new_filename, "'\n";

    &rename ($id, $old_filename, $new_filename);
}
else {
    # TODO: this might not be a valid dirname!
    my $dirname = $directors .'/'. $RES->{$id}->{director};
#    print LOG "Sort " .
#              $RES->{$id}->{director} . " - " .  $RES->{$id}->{title} . ":\n";
#    print LOG "`" . $old_filename . "' -> `" . $dirname . "'\n";

    &arrange ($old_file, $dirname);
}
    
# Disconnect
$dbh->disconnect();


################################################################################

# TODO: find the target from the database instead (option)
sub rename {
    my ($id, $old_filename, $new_filename) = @_;
    my $r = 0;
    
    print LOG "Updating database...    ";
    my $rv = $dbh->do ( "UPDATE $videodata SET filename = ? WHERE id = ?",
                        undef, $new_filename, $id
    );
    &ack (\$r, $rv);
   
    my $old_symlink = $video .'/'. $symlinks .'/'. $old_filename;
    my $new_symlink = $video .'/'. $symlinks .'/'. $new_filename;

    unless (-l $old_symlink) {
        print LOG "Warning: `$old_symlink' does not exist!\n";
        return 1;
    }

    chdir $video .'/'. $symlinks 
        or  die "Can't cd to `$video/$symlinks': $!";
    
    # Find the previous directory of the file TODO
    my $old_target = readlink $old_symlink;
    my $new_target = dirname($old_target) .'/'. $new_filename;
    
    print LOG "Renaming file...        ";
    &ack (\$r, rename $old_target, $new_target);

    print LOG "Creating new symlink... ";
    &ack (\$r, symlink $new_symlink, $new_target);
    
    print LOG "Deleting old symlink... ";
    &ack (\$r, unlink $old_symlink);
    
    return $r;
}


# TODO: if the second argument is a directory, don't update database but
# only symlinks (and mv the file in the dir)

sub arrange {
    my ($old_filename, $director) = @_;
    my $r;

    my $new_dirname = $video .'/'. $director;

    unless (-d $new_dirname) {
        print STDERR "Directory `$new_dirname' does not exist. ";
        until (-d $new_dirname) {
            print STDERR "Should I create it? (Y/n) ";
            my $a = lc <STDIN>;
            chomp $a;
            if ($a eq 'y' or $a eq '') {
                mkdir $new_dirname or die "Cannot mkdir `$new_dirname': $!";
            }
            elsif ($a eq 'n') {
                exit 0;
            }
        }
        
        # TODO
        print "\n";
    }

    print LOG "Moving file...      ";
    &ack (\$r, CORE::rename $old_filename, $new_dirname);

    print LOG "Creating symlink... ";
    &ack (\$r, symlink '../'. $director .'/'. basename($old_filename),
                       $video .'/'. $symlinks);

    return $r;
}



# Acknowledge the result of a test
sub ack {
    my ($r, $test) = @_;
    if ($test) {
        print LOG "OK\n";
    } else {
        print LOG "failed!: $!\n";
        $$r = 1;
    }
}