summaryrefslogtreecommitdiffstats
path: root/videodb-check.pl
blob: daab65880c9fa708cb0af0f98d59caca3e9f7ccc (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
#!/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, 27 November 2011";

use DBI;
use Pod::Usage;
use File::Spec::Functions;
use Cwd;
use Env qw /HOME/;
use strict;

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

# Configuration
my $confile = catfile ($HOME, '.videodb.rc');
die "Can't read `" .$confile. "'\n" unless -f $confile;
my %config = do $confile;
die "Error in `" .$confile. "'\n" if $@ || not %config;

map { exists $config{$_} || die "Error: Missing `${_}'.\n" }
    qw /videodir driver database hostname user port password videodata/;

my $symlinks  = catdir($config{videodir},'MOVIES');    # Symlinks folder
die "Error: No such directory: `" .$symlinks. "'.\n" unless -d $symlinks;

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

=head1 NAME

videodb-check.pl - a sanity check for your video database

=head1 SYNOPSIS

B<videodb-check.pl>

=head1 DISCLAIMER

Your collection is assumed to have the following structure: two
folders, I<DIRECTORS> and I<MOVIES>, that have the same parent.
I<DIRECTORS> contains one subdirectory for each director, and each movie
lies (B<as a regular file>) in the subdirectory of its director.
The folder I<MOVIES> contains symlinks - one for each movie - that target
to I<../DIRECTORS/director_of_the_movie/movie>.
The behavior of B<videodb-check.pl> is NOT specified if your collection does
not verify these conventions!

  |- ...
  |- DIRECTORS
  |    |- director1
  |    |-   |- movie11
  |    |    `- movie12
  |    |- director2/
  |    `- ...
  `- MOVIES
       |- movie11 -> ../DIRECTORS/director1/movie1
       |- movie12 -> ../DIRECTORS/director1/movie2
       `- ...

=head1 DESCRIPTION

B<videodb-check> performs the following sanity checks on your database
and collection:

=over 4

=item *

Each entry in the database has a corresponding symlink under the
directory I<MOVIES> of your collection, that in turn has a valid target
in the directory I<DIRECTORS>.

=item *

Each symlink in the directory I<MOVIES> of your collection has exactly
one corresponding entry in the database.

=back

=head1 EXIT STATUS

The exit status is 0 if your collection and database are sane, and 1
otherwise.

=head1 REQUIREMENTS

The imported modules are available on CPAN. See the source for details.

=head1 AUTHOR

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

=cut

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

if (@ARGV) {
    pod2usage(-exitstatus => 0, -verbose => 2) if $ARGV[0] eq '--man';
    pod2usage(2);
}

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

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

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

# Check that all entries in the DB have a symlink, that in turn have a
# valid target

my $res = $dbh->selectall_arrayref ( "SELECT filename FROM $config{videodata}" )
    or die "Can't select: " .$dbh->errstr. "\n";

my @links;
my @files;
foreach (@$res) {
    my $l = File::Spec->catfile ($symlinks, $_->[0]);
    unless (-l $l or -f $l) {
        push @links, $_->[0];
    }

    if (-l $l and not -f File::Spec->catfile ($symlinks, readlink $l)) {
        push @files, $_->[0];
    }

}

my $r = 0;
if (@links) {
    print STDERR "* The following entries are in the DB, but I can't file the files:\n";
    foreach (@links) {
        print STDERR "    ", $_, "\n";
    }
    $r = 1;
}

if (@files) {
    print STDERR "* The following entries don't have a valid target:\n";
    foreach (@files) {
        print STDERR "    ", $_, "\n";
    }
    $r = 1;
}


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

# For all symlink, check that it has exactly one entry in the DB

my @filelist;
opendir (DIR, $symlinks) or die "Can't open dir `" .$symlinks. ".:" .$!. "\n";
while (my $l = readdir(DIR)) {
    next if $l eq File::Spec->curdir();
    next if $l eq File::Spec->updir(); 

    my $f = File::Spec->catfile($symlinks, $l);
    if ( -d Cwd::realpath($f) ) {
        opendir (SUBDIR, Cwd::realpath($f))
            or die "Can't open dir `" .Cwd::realpath($f). ".:" .$!. "\n";
        while (my $d = readdir(SUBDIR)) {
            next if $d eq File::Spec->curdir();
            next if $d eq File::Spec->updir(); 
            push @filelist, File::Spec->catfile($l,$d);
        }
        closedir(SUBDIR) or die "Can't close: $!\n";
    }
    elsif ( -l $f or -f $f ) {
        push @filelist, $l;
    }
}
closedir(DIR) or die "Can't close: $!\n";


undef @files;
my $sth = $dbh->prepare ( "SELECT id FROM $config{videodata} WHERE filename = ?" )
             or die "Error: " .$dbh->errstr;
foreach (@filelist) {
    $sth->execute ($_) or die "Can't select: " .$dbh->errstr. "\n";
    my @res = $sth->fetchrow_array;
    die $sth->errstr if $sth->err;

    push @files, $_  unless $#res == 0;
}
$sth->finish;
$dbh->disconnect;


if (@files) {
    print STDERR "* The following files have <> 1 corresponding entries in the DB:\n";
    foreach (@files) {
        print STDERR "    ", $_, "\n";
    }
    $r = 1;
}


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

exit $r;