#!/usr/bin/env tclsh #------------------------------------------------------------------------------ # c a m c o p y -- copy files from a USB-connected digital camera #------------------------------------------------------------------------------ # REVISION HISTORY # 0.00 2001-09-06 Adrian F Clark # Original version # 0.01 2002-07-03 Adrian F Clark # Changed default output extension to ".jpeg" # 1.00 2002-12-28 Adrian F Clark # Make -from and -to to specify formats rather than directories. # By default, output filename is formed from creation date of input file. # 1.01 2003-09-18 Adrian F Clark # Moved copy code into "retrieve" and added support for copying movies. # 2.00 2004-04-01 Adrian F Clark # Complete re-write in Tcl. # Support recursing down directory trees, separate JPEG and AVI numbers. # 2.01 2004-11-25 Adrian F Clark # Added "-p" qualifier to "cp" command to preserve capture date and time. # 2.02 2004-12-05 Adrian F Clark # Order the files according to their creation dates when copying. # 2.03 2004-12-14 Adrian F Clark # Corrected typo introduced in 2.02 that caused movies not to be copied. # 2.04 2005-10-28 Adrian F Clark # Added /media/camera to list of places to look for a mount point. # 2.05 2005-12-26 Adrian F Clark # Added ability to mount and dismount the first device in FROM. # Added support for "-mount" and "-nomount" qualifiers. # 2.06 2007-08-28 Adrian F Clark # Added support for "-from " for use with my Canon camera. # 2.07 2008-02-12 Adrian F Clark # Added a couple more directories to the search list. # 2.08 2009-03-11 Adrian F Clark # Look for ".jpeg" as well as ".jpg" and ".JPG". # 2.09 2009-09-23 Adrian F Clark # Chronologically sort on the basis of modification, not creation, time. # 2.10 2010-12-30 Adrian F Clark # Copy across raw files too (kludgy implementation though). # Allow ".mov" and ".MOV" for movies. #------------------------------------------------------------------------------ # Copyright 2001-2010 Adrian F Clark . All rights reserved. #------------------------------------------------------------------------------ # "Symbolic constants". set ME "camcopy" set VERSION "2.10" set VERBOSITY 1 set DO_MOUNT 0 # Places from which we'll copy files: # /mnt/camera where my cameras mounts under old versions of Linux # /media/camera where my cameras mounts under new versions of Linux # /Volumes/Untitled where my Fuji camera mounts under MacOS X # /Volumes/Unlabeled where my Olympus camera mounts under MacOS X set FROM [list "/media/camera" "/mnt/camera" \ "/Volumes/Untitled" "/Volumes/Unlabeled" \ "/Volumes/ALIENCAM" "/Volumes/CHRISCAM" \ "/Volumes/EOS_DIGITAL" "/Volumes/NONAME"] #------------------------------------------------------------------------------ # FindFiles -- find files, recursing down the directory hierarchy #------------------------------------------------------------------------------ proc FindFiles {names dir pat} { upvar $names list global VERBOSITY set pwd [pwd] if {[catch {cd $dir} err]} { return } foreach match [glob -nocomplain -- $pat] { if {$VERBOSITY > 1} { puts stdout [file join $dir $match] } set file [file join $dir $match] file stat $file info lappend list "$info(mtime):$file" } foreach file [glob -nocomplain *] { if {$VERBOSITY > 2} { puts stdout $file } if [file isdirectory $file] { if {$VERBOSITY > 1} { puts stdout [file join $dir $file] } FindFiles list [file join $dir $file] $pat } } cd $pwd } #------------------------------------------------------------------------------ # Copy -- copy across a single file #------------------------------------------------------------------------------ proc Copy {f suffix {rawext ".NEF"}} { global VERBOSITY file stat $f info # Form the first part of the filename based on the file's modification date. set prefix [clock format $info(mtime) -format "%Y-%m-%d-"] # Now find the last-numbered file with that prefix. There's a tweak in # the regexp to strip off leading zeros, which cause numbers to be # interpreted as octal. set highest 0 foreach match [lsort [glob -nocomplain -- "$prefix*$suffix"]] { set re "[set prefix]0*\(\\d+\)$suffix" if [regexp $re $match junk v] { if {$v > $highest} { set highest $v } } else { puts stdout "Weird: '$match' doesn't match my regexp ($re)!" exit 1 } } # Increment highest to give a new file number and, finally, copy across # the file. incr highest set highest [format "%3.3d" $highest] set fullf [glob $f] if {$VERBOSITY > 0} { puts stdout "$fullf -> $prefix$highest$suffix" } if {[catch {exec cp -p $fullf $prefix$highest$suffix} msg]} { puts stderr $msg } if {[catch {exec chmod -x $prefix$highest$suffix} msg]} { puts stderr $msg } # If there's a matching raw file, copy it across too. set rawlen [expr [string length $fullf] - 5] set rawf [string range $fullf 0 $rawlen]$rawext if {[file exists $rawf]} { if {$VERBOSITY > 0} { puts stdout "$rawf -> $prefix$highest$rawext" } if {[catch {exec cp -p $rawf $prefix$highest$rawext} msg]} { puts stderr $msg } if {[catch {exec chmod -x $prefix$highest$rawext} msg]} { puts stderr $msg } } } #------------------------------------------------------------------------------ # Main program. #------------------------------------------------------------------------------ # Process any command line arguments. set argc [llength $argv] for {set a 0} {$a < $argc} {incr a} { set arg [lindex $argv $a] if {[string equal $arg "-mount"]} { set DO_MOUNT 1 } elseif {[string equal $arg "-nomount"]} { set DO_MOUNT 0 } elseif {[string equal $arg "-from"]} { incr a if {$a >= $argc} { puts stderr "-from qualifier requires a value." exit 1 } set FROM [linsert $FROM 1 [lindex $argv $a]] set DO_MOUNT 0 } else { puts stderr "Unknown command-line argument \"$arg\"." exit 1 } } # If we're to mount the device, try and do so. if {$DO_MOUNT} { if {$VERBOSITY > 1} { puts stdout "Mounting [lindex $FROM 0]..." } exec mount [lindex $FROM 0] } # Find the names of the files to be copied. First, we look for pictures, # then we look for movies. if {$VERBOSITY > 1} { puts stdout "Looking for images and movies..." } set pictures [list] foreach dir $FROM { if {$VERBOSITY > 1} { puts stdout $dir } FindFiles pictures $dir "*.jpg" FindFiles pictures $dir "*.jpeg" FindFiles pictures $dir "*.JPG" } set movies [list] foreach dir $FROM { if {$VERBOSITY > 1} { puts stdout $dir } FindFiles movies $dir "*.avi" FindFiles movies $dir "*.AVI" FindFiles movies $dir "*.mov" FindFiles movies $dir "*.MOV" } # Copy across the pictures, then copy across the movies. if {$VERBOSITY > 1} { puts stdout "Copying images..." } foreach key [lsort $pictures] { if {[regexp -- {^(\d+):(.+)$} $key junk date file]} { Copy $file ".jpeg" } else { puts stderr "Trouble handling image \"$key\"" } } if {$VERBOSITY > 1} { puts stdout "Copying movies..." } foreach key [lsort $movies] { if {[regexp -- {^(\d+):(.+)$} $key junk date file]} { Copy $file ".avi" } else { puts stderr "Trouble handling movie \"$key\"" } } # Dismount the device, if necessary if {$DO_MOUNT} { if {$VERBOSITY > 1} { puts stdout "Dismounting [lindex $FROM 0]..." } exec umount [lindex $FROM 0] } #------------------------------------------------------------------------------ # End of camcopy. #------------------------------------------------------------------------------