summaryrefslogtreecommitdiffstats
path: root/videodb-check.pl
blob: 8acff46b6c71127ef81cfc6b8af8ae16ac926f83 (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
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
#!/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 collection

=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 *

The directory in I<DIRECTORS> coincides with the director(s) found in
the database.

=item *

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

=item *

No movie in the database has invalid release date, empty title or empty
language.

=back

=head1 CONFIGURATION

B<videodb-check> reads its database configuration from the file
I<$HOME/.videodb.rc>. This file has to be the content of a Perl hash
e.g.,

  videodir  => catdir($HOME,'video'),
  driver    => 'mysql',
  database  => 'videodb',
  hostname  => '127.0.0.1',
  user      => 'username',
  port      => 3306,
  password  => '******',
  videodata => "videodb_videodata",

=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-2012 Guilhem Moulin. See the source for copying conditions.

=cut

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

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

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

# 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 $r = 0;  # Exit status
my $res = $dbh->selectall_arrayref ( "SELECT filename,director FROM $config{videodata}" )
    or die "Can't select: " .$dbh->errstr. "\n";


my @links;  # List of missing symlinks
my @files;  # List of symlinks that have a non existing/valid target
my @dirs;   # List of symlinks that target to a wrong director
foreach (@$res) {
    my @ls = File::Spec->splitdir($_->[0]);
    my $l = File::Spec->catfile ($symlinks, $ls[0]);

    unless (-l $l) {
        push @links, $_->[0];
        next;
    }

    my @target = File::Spec->splitdir (readlink $l);
    push @files, $_->[0]
        unless ( $target[0] eq File::Spec->updir()
             and $target[1] eq "DIRECTORS"
             and -f File::Spec->catfile ($symlinks, $_->[0]) );

    if ( not (defined $_->[1]) or $_->[1] eq '' ) {
        push @dirs, $_->[0]. " (no director)";
    }
    elsif ( $target[2] ne $_->[1] ) {
        push @dirs, $_->[0]. " (" .$target[2]. " <> " .$_->[1]. ")";
    }
}


&report ("The following entries are in the DB, but I can't find the files", \@links);
&report ("The following entries don't have a valid target", \@files);
&report ("The following entries target to a wrong director", \@dirs);


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

# Check that each symlink has exactly one entry in the DB

my @filelist; # List of filenames that have <> 1 entry in the DB
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;
&report ("The following files have <> 1 corresponding entries in the DB", \@files);


&check ( "no release date", "year = 0" );
&check ( "no language set", "language IS NULL OR language =''" );
&check ( "no title set", "title IS NULL OR title =''" );


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


$dbh->disconnect;
exit $r;


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


sub report {
    my ($str, $bad) = @_;
    if (@$bad) {
        print LOG "* " .$str. ":\n";
        foreach (@$bad) {
            print LOG "    ", $_, "\n";
        }
        $r = 1;
    }
}

sub check {
    my $bad = $dbh->selectall_arrayref( "SELECT filename
                                         FROM $config{videodata}
                                         WHERE " .$_[1] )
        or die "Can't select: " .$dbh->errstr. "\n";
    &report ("The following files have " .$_[0], [map {$_->[0]} @$bad]);
}