0: # This my first posting in this section so be kind (well, unless it's for my own good ;-) ).
1:
2: # The program was intended to synchronise MP3 files on my hard disk with
3: # those on my portable MP3 jukebox thingy
4: # (<a href="http://www.archos.com">Archos Jukebox 6000</a>).
5: # I rip the CDs onto my local hard disk then copy them across
6: # to the player (which appears as a USB removable hard disk).
7:
8: # I just recently noticed the a module which does a lot of the same things,
9: # as well as lots of other things. That makes this program yet another
10: # re-invented wheel but I enjoyed writing it. (NOTE: I can't
11: # remember what the module was called though!)
12:
13: #!perl -w
14: # MP3sync - synchronises MP3 files/directories between
15: # two directories
16:
17: # Usage:
18: # MP3sync [configfile]
19: # Where:
20: # configfile is a configuration file (as described below),
21: # the program defaults to reading mp3sync.cfg
22:
23: # Configuration file format:
24: # Each line begins with a setting name, followed by '=' and
25: # the value to be assigned to the setting. Case is significant.
26: #
27: # Settings: [default in square brackets]
28: # Source - directory with (possibly new) MP3s
29: # [C:/My Documents/My Music/]
30: # Dest - directory where MP3s should be copied (if necessary)
31: # [G:/]
32: # (each of these specifies a path which should be the root directory
33: # of the tree containing the files and directories to be synchronised)
34:
35: # important stuff
36: use strict;
37: use diagnostics;
38:
39: # we want to calculate checksums for files
40: use Digest::MD5;
41: # for reading directories
42: use IO::Dir;
43: # for copying files
44: use File::Copy;
45:
46: # Default configuration file name
47: my $configFile = "mp3sync.cfg";
48:
49: # Hash to hold configuration settings
50: my %config = (
51: Source => 'C:/My Document/My music/',
52: Dest => 'G:/'
53: );
54:
55: # Sub: ReadConfig - reads in a configuration file
56: # Usage:
57: # $status = ReadConfig($configFile, \%configHash);
58: # Where:
59: # $status will be true on successfull reading of the file.
60: # (error messages will be output to STDERR)
61: # $configFile is the name of the file to read
62: # \%ConfigHash is a reference to a hash holding configuration
63: # settings
64: sub ReadConfig {
65: my $filename = shift;
66: my $configHash = shift;
67: # check the parameters - filename first
68: if (!defined($filename)) {
69: warn("You must supply a filename to ReadConfig");
70: return undef;
71: };
72: # has the user specified a hash?
73: if (!defined($configHash)) {
74: warn("You must supply a configuration hash reference to ReadConfig");
75: return undef;
76: };
77: # is it really a hash ref?
78: if (ref($configHash) ne "HASH") {
79: warn("The second parameter to ReadConfig must be a hash reference");
80: return undef;
81: };
82: # open the file - warn that we're using the defaults if it can't be opened
83: unless (open(CONFFILE, '<', $filename)) {
84: warn("Couldn't open config file $filename: $!\n");
85: warn("Using defaults");
86: return 1;
87: };
88: # now read each line
89: my $line;
90: while (defined($line = <CONFFILE>)) {
91: # if it's a valid line store it in the hash
92: if ($line =~ /(\w+)\=(.+)/) {
93: $configHash->{$1} = $2;
94: };
95: # ignore invalid lines silently
96: };
97: # close the file
98: unless (close(CONFFILE)) {
99: WARN("Couldn't close config file $filename: $!\n");
100: return undef;
101: };
102: # success!
103: return 1;
104: };
105:
106: # Sub: PopulateTree
107: # Usage:
108: # $status = PopulateTree($path, \%hash);
109: # Where:
110: # $status will be true if the function succeeded
111: # $path is the directory to examine (terminate in '/')
112: # \%hash is a reference to a hash to be filled with directory
113: # tree information. Each item in the hash will be a hash
114: # containing the following keys:
115: # Type (files and dirs) - 'File' or 'Dir'
116: # Contents (dirs only) - an array containing the directory
117: # contents, in this form
118: # Digest (files only) - the MD5 digest of the file
119: sub PopulateTree {
120: # get our parameters
121: my $path = shift;
122: if (!defined($path)) {
123: warn("PopulateTree needs a path");
124: return undef;
125: };
126: my $hashref = shift;
127: if (!defined($hashref)) {
128: warn("PopulateTree needs a hash reference");
129: return undef;
130: };
131: # check that $hashref really is a hash reference
132: if (ref($hashref) ne 'HASH') {
133: warn("PopulateTree needs a HASH reference");
134: print ref($hashref), "\n";
135: return undef;
136: };
137:
138: print "Looking in $path...\n";
139:
140: # create a Digest::MD5 object
141: my $digest = new Digest::MD5;
142:
143: # read the directory
144: my $dir = new IO::Dir;
145: my @dirContents;
146: unless ($dir->open($path)) {
147: warn("Couldn't open directory $path: $!\n");
148: return undef;
149: };
150: unless (@dirContents = $dir->read()) {
151: warn("Couldn't read directory $path: $!\n");
152: return undef;
153: };
154: # now look at each item and decide what to do with it
155: ITEM:
156: foreach my $item (@dirContents) {
157: if (($item eq '.') || ($item eq '..')) {
158: next ITEM;
159: };
160: if (-d $path.$item) {
161: # it's a directory, create an item entry for it
162: $hashref->{$item} = {
163: Type => 'Dir',
164: Contents => {}
165: };
166: # get its contents
167: unless (PopulateTree($path.$item."/", $hashref->{$item}->{Contents})) {
168: warn("PopulateTree failed");
169: return undef;
170: };
171: } elsif (-f _) {
172: # it's an ordinary file, pass it to Digest::MD5
173: unless (open(*FILE, '<', $path.$item)) {
174: warn("Couldn't open $path$item: $!\n");
175: return undef;
176: };
177: $digest->addfile(*FILE);
178: my $fileDigest = $digest->hexdigest();
179: unless (close(*FILE)) {
180: warn("Couldn't close $path$item: $!\n");
181: return undef;
182: };
183: # create an item entry for it
184: $hashref->{$item} = {
185: Type => 'File',
186: Digest => $fileDigest
187: };
188: };
189: # ignore other item types
190: };
191: # success
192: return 1;
193: };
194:
195:
196: # Sub: CompareTrees
197: # Usage:
198: # ($status, @doList) =
199: # CompareTrees($sourcePath,$destPath,\%sourceTree, \%destTree);
200: # Where:
201: # $status will be true if the function succeeded.
202: # @doList will contain a list of things to do to make the two trees
203: # identical, or be undefined on failure. Each item in the list will be
204: # a hash containing two keys: 'Action' and 'Detail'. 'Action' will be
205: # either 'Copy' or 'Create', 'Detail' will be the full path to create (for
206: # 'Create') or a two item array (for 'Copy'). The first item is the source
207: # file, the second is the file to copy it to both have full paths.
208: # $sourcePath is the full path to the source tree root
209: # $destPath is the full path to the destination tree root
210: # \%sourceTree is a reference to a tree as returned by PopulateTree.
211: # \%destTree is a reference to a tree as returned by PopulateTree.
212: # Note:
213: # The destTree hash is modified by this function, keep a copy of it if
214: # you want the original data.
215: sub CompareTrees {
216: # get the paths
217: my $sourcePath = shift;
218: unless ($sourcePath) {
219: warn("You must provide a source path to CompareTrees");
220: return undef;
221: };
222: my $destPath = shift;
223: unless ($destPath) {
224: warn("You must provide a destination path to CompareTrees");
225: return undef;
226: };
227: # get our two tree refs
228: my $sourceRef = shift;
229: unless ($sourceRef) {
230: warn("You must provide a source tree reference to CompareTrees");
231: return undef;
232: };
233: my $destRef = shift;
234: unless ($destRef) {
235: warn("You must provide a destination tree reference to CompareTrees");
236: return undef;
237: };
238: # check that they are hash refs
239: if ((ref($sourceRef) ne 'HASH') || (ref($destRef) ne 'HASH')) {
240: warn("CompareTrees takes two hash references");
241: return undef;
242: };
243:
244: # an array to return our result in
245: my @retArray = ();
246: my $item;
247: # look at each item contained in the source tree
248: CMPITEM:
249: foreach $item (keys(%{$sourceRef})) {
250: # is there a corresponding item in the destination tree?
251: if (defined($destRef->{$item})) {
252: # if it's a directory we know it exists, if it's a file we want to
253: # check it's identical
254: if ($destRef->{$item}->{Type} eq 'File') {
255: # compare the MD5 digests
256: if ($destRef->{$item}->{Digest} ne $sourceRef->{$item}->{Digest}) {
257: # indicate that we want to make a copy
258: push(@retArray, {
259: Action => 'Copy',
260: Detail => [$sourcePath.$item, $destPath]
261: });
262: };
263: };
264: # no further action is required, look at the next item
265: next CMPITEM;
266: } else {
267: # if it's a directory then we need to create it, if it's a file we need
268: # to copy it
269: if ($sourceRef->{$item}->{Type} eq 'File') {
270: # indicate that we want to make a copy
271: push(@retArray, {
272: Action => 'Copy',
273: Detail => [$sourcePath.$item, $destPath.$item]
274: });
275: } else {
276: # it's a directory, indicate that we want to create it
277: push(@retArray, {
278: Action => 'Create',
279: Detail => $destPath.$item
280: });
281: # create it in the destination tree
282: $destRef->{$item} = {
283: Contents => {},
284: Type => 'Dir'
285: };
286: # we also need to recurse down into it
287: my ($status, @tempArray) = CompareTrees(
288: $sourcePath.$item.'/',
289: $destPath.$item.'/',
290: $sourceRef->{$item}->{Contents},
291: $destRef->{$item}->{Contents});
292: unless ($status) {
293: warn("CompareTrees recursion failed");
294: return undef;
295: };
296: push(@retArray, @tempArray);
297: }; # item type is 'Dir'
298: }; # !defined($destRef->{$item})
299: }; # foreach
300: # success
301: return (1, @retArray);
302: };
303:
304:
305: # Sub: DoActions - carry out the actions to sync two trees
306: # Usage:
307: # $status = DoActions(@actionArray);
308: # Where:
309: # $status will be true if successful
310: # @actionArray is an array of actions as returned by CompareTrees
311: sub DoActions {
312: # get the array
313: my @actions = @_;
314: # carry out the actions
315: foreach my $action (@actions) {
316: # what type of action is it?
317: if ($action->{Action} eq 'Copy') {
318: # it's a copy, get the source and destination
319: print "Copying $action->{Detail}->[0]...\n";
320: unless (copy($action->{Detail}->[0], $action->{Detail}->[1])) {
321: warn("Couldn't copy $action->{Detail}->[0] to $action->{Detail}->[1]: $!\n");
322: return undef;
323: };
324: } else {
325: # it's a create, get the directory name
326: print "Creating $action->{Detail}...\n";
327: unless(mkdir $action->{Detail}) {
328: warn("Couldn't create directory $action->{Detail}: $!\n");
329: return undef;
330: };
331: };
332: }; # foreach Action
333: return 1;
334: };
335:
336:
337: #
338: # Main
339: #
340:
341: # read the config file
342: ReadConfig($configFile, \%config) or die("Couldn't read config file $configFile\n");
343:
344: # storage for the two trees
345: my (%sourceTree, %destTree);
346:
347: # read the source tree
348: PopulateTree($config{Source}, \%sourceTree) or die("Couldn't read source tree\n");
349: # and the destination tree
350: PopulateTree($config{Dest}, \%destTree) or die("Couldn't read dest tree\n");
351:
352: # find the differences
353: my ($status, @actions) =
354: CompareTrees($config{Source}, $config{Dest}, \%sourceTree, \%destTree)
355: or die("Couldn't compare trees\n");
356:
357: # check whether there are any actions
358: if (scalar(@actions) == 0) {
359: print "Nothing to do, source and destination trees are identical.\n";
360: };
361:
362: DoActions(@actions) or die("Sync failed to create files/directories.\n");
363:
364: print "Finished.";
365:
366: # So what do you think?
367: # Kevin O'Rourke. In reply to File synchronisation (for criticism) by kevin_i_orourke
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |