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
|
#! /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> TODO
=head1 DESCRIPTION
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)
# TODO: if the second argument is a directory, don't update database but
# only symlinks (and mv the file in the dir)
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 director on the
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;
}
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;
}
}
|
