diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2007-2010 Dino Morelli +Copyright (c) 2007-2011 Dino Morelli All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/README b/README --- a/README +++ b/README @@ -7,12 +7,10 @@ *about* photoname is a command-line utility for renaming/moving photo image -files. The new folder location and naming are determined by two things: -the photo shoot date information contained within the file's EXIF tags -and the usually-camera-assigned serial number, often appearing in the -filename. +files. The new folder location and naming are determined by the the +photo shoot date information contained within the file's EXIF tags. -This program is known to work with GHC 6.10.3 on systems where System.Posix (unix) and exif packages are available. +This program is known to build with GHC 6.12.3 *install* diff --git a/TODO b/TODO --- a/TODO +++ b/TODO @@ -1,27 +1,5 @@ -- Add support for different camera filename formats, check with the Olympus. - -- First, I think I'd like to see the PARENTDIR argument become a named switch (-d --parent-dir), to better differentiate it from the list of files to be processed. - -- Second, I'd like to start using a config file (~/.photoname) that will contain things like default parent dir: - parent-dir=/foo/bar/baz - - This would be used in the event that none was specified. Other switches could be specified here perhaps. - - This config file behavior will require a config file API, I can try to use the one I started a few months ago. - -- I'm wondering if it would be possible to have a post-command switch that could specify something to be done after other processing is done. This came up when i was thinking about rolling jhead -autorot rotation behavior into this program. But I'm reluctant to make this program have direct knowledge of such tools and procedures. - An example: - --post-cmd='jhead -autorot %f' - - What syntax to use for variables in such strings? - - Allow user to specify permissions for newly-created dirs and files. Bonus points for parsing the octal codes everyone knows and loves. - Add a --force switch to disregard existing links. - Deal gracefully with unknown dates. This means not just putting pictures into the 0000/0000-00-00 directory, but making sure that the _### serial number part is incremented from the highest one in there. - -- Allow additional switch for part of filenames for initials of photographer: _xyz Call this the suffix? (-s --suffix) - -- Add the Homepage item to the debian/control that you see now in more recent packages. Use dh_make on something to see what it looks like, something like this: - Homepage: diff --git a/doc/dev/notes b/doc/dev/notes --- a/doc/dev/notes +++ b/doc/dev/notes @@ -1,47 +1,24 @@ ----- -Do something with this, better error checking? - -- Parse arguments -- Look at args, cases: - - --help - - no files - - no parent path - - normal processing (ReaderT) - ------ - To change the app version: - - Edit photoname.cabal: version: xx.yy + - Edit photoname.cabal - Edit src/Photoname/Opts.hs, usageText near the bottom of footer - - darcs rec these changes as "Changed version to xx.yy" - - darcs tag "xx.yya" - Use a, b, c as attempts for version xx.yy I'd like to make a script in util/ to automate this. After such a script has been made, may want to put developer notes on using it in doc/dev/ ---------- -File serial number formats: - -Panasonic: P###0###.jpg - First part is dir, second is serial. We can use the second part. -Canon: img_####.jpg - Can use the last 3 digits of this -Olympus: - - -Photo naming scheme (this info needs to go into usage help at some point) +File naming format: yyyymmdd_[oth_]nnn[-e[n]].jpg +yyyymmdd-hhmmss[_oth][_ss].jpg date: year month day -other author: 2 or 3 character initials -photo serial: last 3 digits of camera-supplied number, if possible -e or s: edited or sized, optional number for more than one - -sp -ep : sized/edited for printing - -sd -ed : sized/edited for desktop - -sw -ew : sized/edited for web - -Photo serial: Note that 3-digits is standard for Panasonic cameras. 4 digits is standard for Canon cameras. But we'll use 3 digits for Canon too, seems like unique within each day. +time: hour minute second +oth: could be photographer: 2 or 3 character initials +ss: edited or sized, optional number for more than one + _sp _ep : sized/edited for printing + _sd1920x1080 _ed : sized/edited for desktop + _sw _ew : sized/edited for web These files are arranged into a dir structure diff --git a/photoname.cabal b/photoname.cabal --- a/photoname.cabal +++ b/photoname.cabal @@ -1,10 +1,10 @@ name: photoname cabal-version: >= 1.2 -version: 2.3.0 +version: 3.0.0 build-type: Simple license: BSD3 license-file: LICENSE -copyright: 2007-2010 Dino Morelli +copyright: 2007-2011 Dino Morelli author: Dino Morelli maintainer: Dino Morelli stability: stable @@ -12,13 +12,13 @@ synopsis: Rename JPEG photo files based on shoot date description: Command-line utility for renaming/moving photo image files based on - EXIF tags. Written in Haskell. -category: Unclassified + EXIF tags. +category: Application, Console tested-with: GHC>=6.8.2 executable photoname main-is: photoname.hs - build-depends: base >= 3 && < 5, exif, filepath, mtl, old-locale, - parsec, time, unix + build-depends: base >= 3 && < 5, directory, exif, filepath, mtl, + old-locale, parsec, time, unix ghc-options: -Wall hs-source-dirs: src diff --git a/src/Photoname/Common.hs b/src/Photoname/Common.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/Common.hs @@ -0,0 +1,26 @@ +-- Copyright: 2007-2011 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Photoname.Common + ( Ph, runRename + + -- Re-exporting: + , MonadError + , ask, asks + , liftIO + , throwError + ) + where + +import Control.Monad.Error +import Control.Monad.Reader + +import Photoname.Opts ( Options (..) ) + + +type Ph a = ReaderT Options (ErrorT String IO) a + + +runRename :: Options -> Ph a -> IO (Either String a) +runRename env action = runErrorT $ runReaderT action env diff --git a/src/Photoname/Date.hs b/src/Photoname/Date.hs --- a/src/Photoname/Date.hs +++ b/src/Photoname/Date.hs @@ -1,11 +1,13 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli -module Photoname.Date ( - formatYear, formatDay, formatPrefix, - readDate -) +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} + +module Photoname.Date + ( formatYear, formatDateHyphens, formatDate, formatDateTime + , readDate + ) where import Data.Time.Calendar @@ -15,9 +17,10 @@ import Text.ParserCombinators.Parsec --- Parse a date string in the form "yyyy:mm:dd hh:mm:ss" into a --- CalendarTime datatype. Strings that fail to parse in this manner are --- returned as Nothing +{- Parse a date string in the form "yyyy:mm:dd hh:mm:ss" into a + CalendarTime datatype. Strings that fail to parse in this manner are + returned as Nothing +-} readDate :: String -> Maybe LocalTime readDate s = case (parse dateParser "" s) of @@ -39,22 +42,33 @@ (fromIntegral ((read second) :: Integer))) --- Format a Maybe CalendarTime into a "yyyy" string. Dates that are --- Nothing in value format to "0000" +{- Format a Maybe CalendarTime into a "yyyy" string. Dates that are + Nothing in value format to "0000" +-} formatYear :: Maybe LocalTime -> String formatYear Nothing = "0000" formatYear (Just x) = formatTime defaultTimeLocale "%Y" x --- Format a Maybe CalendarTime into a "yyyy-mm-dd" string. Dates that are --- Nothing in value format to "0000-00-00" -formatDay :: Maybe LocalTime -> String -formatDay Nothing = "0000-00-00" -formatDay (Just x) = formatTime defaultTimeLocale "%Y-%m-%d" x +{- Format a Maybe CalendarTime into a "yyyy-mm-dd" string. Dates that are + Nothing in value format to "0000-00-00" +-} +formatDateHyphens :: Maybe LocalTime -> String +formatDateHyphens Nothing = "0000-00-00" +formatDateHyphens (Just x) = formatTime defaultTimeLocale "%Y-%m-%d" x --- Format a Maybe CalendarTime into a "yyyymmdd" string. Dates that are --- Nothing in value format to "00000000" -formatPrefix :: Maybe LocalTime -> String -formatPrefix Nothing = "00000000" -formatPrefix (Just x) = formatTime defaultTimeLocale "%Y%m%d" x +{- Format a Maybe CalendarTime into a "yyyymmdd" string. Dates that are + Nothing in value format to "00000000" +-} +formatDate :: Maybe LocalTime -> String +formatDate Nothing = "00000000" +formatDate (Just x) = formatTime defaultTimeLocale "%Y%m%d" x + + +{- Format a Maybe CalendarTime into a "yyyymmdd-HHMMSS" string. Dates + that are Nothing in value format to "00000000-000000" +-} +formatDateTime :: Maybe LocalTime -> String +formatDateTime Nothing = "00000000-000000" +formatDateTime (Just x) = formatTime defaultTimeLocale "%Y%m%d-%H%M%S" x diff --git a/src/Photoname/DateFormat.hs b/src/Photoname/DateFormat.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/DateFormat.hs @@ -0,0 +1,35 @@ +-- Copyright: 2007-2011 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Photoname.DateFormat + ( buildDatePath + ) + where + +import System.FilePath +import Text.Printf + +import Photoname.Common +import Photoname.Date +import Photoname.Exif +import Photoname.Opts ( Options (..) ) + + +{- Given a path to a file with EXIF data, construct a new path based on the + date and some serial number info we can parse out of the filename. +-} +buildDatePath :: FilePath -> Ph FilePath +buildDatePath oldPath = do + dateString <- getDate oldPath + let date = readDate dateString + + suffix <- asks optSuffix + let fileName = printf "%s%s.jpg" (formatDateTime date) suffix + + parentDir <- asks optParentDir + noDirs <- asks optNoDirs + return $ if (noDirs) + then parentDir fileName + else parentDir (formatYear date) + (formatDateHyphens date) fileName diff --git a/src/Photoname/Exif.hs b/src/Photoname/Exif.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/Exif.hs @@ -0,0 +1,50 @@ +-- Copyright: 2007-2011 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} + +module Photoname.Exif + where + +import Control.Monad.Error +import Graphics.Exif ( fromFile, getTag, Exif ) +import System.IO.Error + + +{- load Exif information from a filename, returning Nothing if libexif + encounters a NULL instead of raising an IO error. + + This is somewhat bogus because of the error type that is used by + the EXIF library. We have to compare the error string to see if it + is the kind of user error that we expect. If we build against an + EXIF library that raises some other exception, then this build will + still succeed, and the exception will be propagated instead of + transformed into a handled photoname error. +-} +safeExif :: FilePath -> IO (Maybe Exif) +safeExif = try . fromFile >=> either handleBadExif (return . Just) + where + isBadExif e = + ioeGetErrorString e == "mkExif: NULL" && isUserError e + handleBadExif e = + if isBadExif e then return Nothing else ioError e + + +{- Get shoot date from the exif information. There are several tags + potentially containing dates. Try them in a specific order until we + find one that has data. +-} +getDate :: (MonadError String m, MonadIO m) => FilePath -> m String +getDate = loadExif >=> getOneOf dateTagNames + where + loadExif = (liftIO . safeExif) >=> + maybe (throwError "Failed EXIF loading") return + + getOneOf [] _ = throwError "has no EXIF date" + getOneOf (tagName:tagNames) exif = + maybe (getOneOf tagNames exif) return =<< + liftIO (getTag exif tagName) + + dateTagNames = + ["DateTimeDigitized", "DateTimeOriginal", "DateTime"] diff --git a/src/Photoname/Opts.hs b/src/Photoname/Opts.hs --- a/src/Photoname/Opts.hs +++ b/src/Photoname/Opts.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -8,76 +8,180 @@ ) where +import Control.Applicative import System.Console.GetOpt +import System.Directory data Options = Options - { optNoAction :: Bool - , optQuiet :: Bool - , optMove :: Bool + { optConfig :: String , optHelp :: Bool + , optMove :: Bool + , optNoAction :: Bool + , optNoConfig :: Bool + , optNoDirs :: Bool + , optOldStyle :: Bool + , optParentDir :: String + , optQuiet :: Bool + , optSuffix :: String } +defaultConfig :: String +defaultConfig = "~/.config/photoname.conf" defaultOptions :: Options defaultOptions = Options - { optNoAction = False - , optQuiet = False - , optMove = False + { optConfig = defaultConfig , optHelp = False + , optMove = False + , optNoAction = False + , optNoConfig = False + , optNoDirs = False + , optOldStyle = False + , optParentDir = "." + , optQuiet = False + , optSuffix = "" } options :: [OptDescr (Options -> Options)] options = - [ Option ['n'] ["no-action"] + [ Option ['c'] ["config"] + (ReqArg (\c opts -> opts { optConfig = c }) "FILE") + ("Defaults to " ++ defaultConfig ++ ". See CONFIG") + , Option ['C'] ["no-config"] + (NoArg (\opts -> opts { optNoConfig = True } )) + "Do not load config file" + , Option ['D'] ["no-dirs"] + (NoArg (\opts -> opts { optNoDirs = True } )) + "No subdirectory hierarchy. Just do DIR/NEWFILE" + , Option ['h'] ["help"] + (NoArg (\opts -> opts { optHelp = True } )) + "This help text" + , Option [] ["move"] + (NoArg (\opts -> opts { optMove = True } )) + "Move the files, don't just hard-link to the new locations" + , Option ['n'] ["no-action"] (NoArg (\opts -> opts { optNoAction = True } )) "Display what would be done, but do nothing" + , Option ['o'] ["old-style"] + (NoArg (\opts -> opts { optOldStyle = True } )) + "Use older name format with serial. See FILENAME FORMAT" + , Option ['p'] ["parent-dir"] + (ReqArg (\d opts -> opts { optParentDir = d } ) "DIR") + "Top-level directory where new links are created. Default: ." , Option ['q'] ["quiet"] (NoArg (\opts -> opts { optQuiet = True } )) "Suppress normal output of what's being done" - , Option [] ["move"] - (NoArg (\opts -> opts { optMove = True } )) - "Move the files, don't just hard-link to the new locations" - , Option ['h'] ["help"] - (NoArg (\opts -> opts { optHelp = True } )) - "This help text" + , Option ['s'] ["suffix"] + (ReqArg (\s opts -> opts { optSuffix = s } ) "SUF") + "Add optional suffix to each name. See SUFFIX" ] -parseOpts :: [String] -> IO (Options, [String]) -parseOpts argv = - case getOpt Permute options argv of +{- Try to load a config file, converting its lines into a [String] + of long options to be parsed +-} +loadConfig :: FilePath -> IO [String] +loadConfig path = do + confExists <- doesFileExist path + + if confExists + then (map ("--" ++) . lines) <$> readFile path + else return [] + + +{- Perform the actual parse of a [String] +-} +parseOpts' :: [String] -> IO (Options, [String]) +parseOpts' args = + case getOpt Permute options args of (o,n,[] ) -> return (foldl (flip id) defaultOptions o, n) (_,_,errs) -> ioError $ userError (concat errs ++ usageText) +{- The set of steps to parse args from both the command-line and a + config file +-} +parseOpts :: [String] -> IO (Options, [String]) +parseOpts cliArgs = do + -- Parse argv first time to get -c and/or -C + (prelimOpts, _) <- parseOpts' cliArgs + + -- Load config file + confArgs <- if (optNoConfig prelimOpts) + then return [] + else loadConfig $ optConfig prelimOpts + + -- Parse second time with all args + parseOpts' (confArgs ++ cliArgs) + + usageText :: String usageText = (usageInfo header options) ++ "\n" ++ footer where header = init $ unlines - [ "Usage: photoname [OPTIONS] PARENTDIR FILES" + [ "Usage: photoname [OPTIONS] FILES" , "Rename and move photo files based on EXIF data" , "" , "Options:" ] footer = init $ unlines - [ "This software is for renaming and storing your digital photos. It will extract shoot date from the EXIF data in the image file and use that along with the usually-camera-assigned serial number to build a meaningful filename." + [ "This software is for renaming and storing your digital photos. It will attempt to construct a meaningful filename based on the EXIF shoot date in the file and optionally some other information." , "" - , "You get a subdirectory hierarchy consisting of directories for the years, then subdirs within those for the day photos were shot. These day dirs contain the image files, renamed as follows:" + , "CONFIG" , "" - , "A photo shot on 2002-May-02 with a Canon camera:" + , "The program will attempt to load a config file from this location: " ++ defaultConfig ++ " A different path may be specified with the --config switch" + , "Entries in this file should be the long switches above minus the -- and including any arguments they may have. To completely ignore an existing config file, use the --no-config switch." + , "" + , "Example config contents:" + , "" + , " move" + , " old-style" + , " parent-dir=~/mypics" + , " suffix=_dwm" + , "" + , "" + , "FILENAME FORMAT" + , "" + , "Normal operation builds a subdirectory hierarchy consisting of directories for the years, then subdirs within those for the day photos were shot. These day dirs contain the image files, named as follows:" + , "" + , "A photo shot on 2002-May-02 01:23:07 PM:" + , " img_1790.jpg -> /2002/2002-05-02/20020502-132307.jpg" + , "" + , "The EXIF date/time stamp used for naming is the first of these fields to be found: DateTimeDigitized, DateTimeOriginal, DateTime" + , "" + , "The is the one given by the --parent-dir switch and represents the top-level of where you're storing photos." + , "" + , "The --no-dirs switch will suppress the directory-hierarchy-creating part of this, instead placing the new links directly in . So you get files like:" + , "" + , " /20020502-132307.jpg" + , "" + , "Default behavior is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to not leave the original links." + , "" + , "The --old-style switch specifies the prior behavior of photoname where the name is a date followed by the last three digits of the camera-assigned number from the original filename:" + , "" , " img_1790.jpg -> /2002/2002-05-02/20020502_790.jpg" , "" - , "The code is basically looking for three digits before the file extension to use as a 'serial' number for the day's photos. This is a seemingly common occurrance with cameras that we can pick numbers off the end of the filename, or at least I hope that's the case. Examples of the two that I have:" + , "The code is basically looking for three digits before the file extension to use as a 'serial' number for the day's photos. This is a seemingly common occurrance with cameras that we can pick numbers off the end of the filename. Examples of the two that I have:" , "" , " vvv (use these digits)" , " Panasonic: P###0###.jpg" , " Canon: img_####.jpg" , " ^^^" - , "The is the one given on the command-line to this utility, and represents the top-level of where you're storing photos." + , " ^^^" , "" - , "Note that the default behavior of this software is to create hard links to the new paths and leave the original links as they were. You can use the --move switch to blow away the original location, leaving only the new." + , "The --old-style behavior in photoname remains for backwards compatibility. Many cameras today (and particularly camera phones) don't generate a name we can use in this way, and so something needed to change in this software." , "" - , "Version 2.3.0 2010-Jan-17 Dino Morelli " + , "Another nagging problem is the old-style naming is non-deterministic. Using photoname --old-style on a file may not always give you the same name, say if the serial info in the name is ever lost. Naming based on the EXIF data alone is more reliable." + , "" + , "" + , "SUFFIX" + , "" + , "The optional --suffix switch can be used to provide a string placed between the date/time and extension. Use it for anything you like. An example is photographer initials or series info. Example:" + , "" + , "photoname invoked with --suffix=_dwm :" + , " 20020502-132307_dwm.jpg" + , "" + , "Version 3.0.0 Dino Morelli " ] diff --git a/src/Photoname/Serial.hs b/src/Photoname/Serial.hs deleted file mode 100644 --- a/src/Photoname/Serial.hs +++ /dev/null @@ -1,43 +0,0 @@ --- Copyright: 2007-2010 Dino Morelli --- License: BSD3 (see LICENSE) --- Author: Dino Morelli - -{-# LANGUAGE FlexibleContexts #-} - -module Photoname.Serial - ( getSerial - ) - where - -import Control.Monad.Error -import Text.ParserCombinators.Parsec - - -{- Combinator similar to manyTill, but evaluates to end instead of p --} -skipTill :: GenParser tok st t1 -> GenParser tok st t -> GenParser tok st t -skipTill p end = scan - where - scan = do { end } -- If end succeeds, return that. - <|> - do { p; scan } -- Otherwise, match p and recurse. - - -serialNum :: GenParser Char st [Char] -serialNum = - skipTill anyChar $ try $ do -- Skip anything up to.. - serial <- count 3 digit -- 3 digits.. - char '.' -- followed by a period.. - count 3 alphaNum -- followed by 3 alphaNumS.. - eof -- at the end of the string. - return serial -- Return those 3 digits - - -{- Evaluates one or more parsers trying to find the serial number in the - supplied path. Transforms the result from Either to Maybe --} -getSerial :: (MonadError String m) => String -> m String -getSerial path = - case (parse serialNum "" path) of - Left _ -> throwError "has no serial" - Right serial -> return serial diff --git a/src/Photoname/SerialFormat.hs b/src/Photoname/SerialFormat.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/SerialFormat.hs @@ -0,0 +1,70 @@ +-- Copyright: 2007-2011 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +{-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-unused-do-bind #-} + +module Photoname.SerialFormat + ( buildSerialPath + ) + where + +import System.FilePath +import Text.ParserCombinators.Parsec + +import Photoname.Common +import Photoname.Date +import Photoname.Exif +import Photoname.Opts ( Options (..) ) + + +{- Combinator similar to manyTill, but evaluates to end instead of p +-} +skipTill :: GenParser tok st t1 -> GenParser tok st t -> GenParser tok st t +skipTill p end = scan + where + scan = do { end } -- If end succeeds, return that. + <|> + do { p; scan } -- Otherwise, match p and recurse. + + +serialNum :: GenParser Char st [Char] +serialNum = + skipTill anyChar $ try $ do -- Skip anything up to.. + serial <- count 3 digit -- 3 digits.. + char '.' -- followed by a period.. + count 3 alphaNum -- followed by 3 alphaNumS.. + eof -- at the end of the string. + return serial -- Return those 3 digits + + +{- Evaluates one or more parsers trying to find the serial number in the + supplied path. Transforms the result from Either to Maybe +-} +getSerial :: (MonadError String m) => String -> m String +getSerial path = + case (parse serialNum "" path) of + Left _ -> throwError "Can't determine serial" + Right serial -> return serial + + +{- Given a path to a file with EXIF data, construct a new path based on the + date and some serial number info we can parse out of the filename. +-} +buildSerialPath :: FilePath -> Ph FilePath +buildSerialPath oldPath = do + dateString <- getDate oldPath + serial <- getSerial oldPath + let date = readDate dateString + + suffix <- asks optSuffix + let fileName = (formatDate date) ++ "_" ++ serial + ++ suffix <.> "jpg" + + parentDir <- asks optParentDir + noDirs <- asks optNoDirs + return $ if (noDirs) + then parentDir fileName + else parentDir (formatYear date) + (formatDateHyphens date) fileName diff --git a/src/photoname.hs b/src/photoname.hs --- a/src/photoname.hs +++ b/src/photoname.hs @@ -1,27 +1,19 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli {-# LANGUAGE FlexibleContexts #-} -import Control.Monad.Error -import Control.Monad.Reader -import Graphics.Exif ( fromFile, getTag, Exif ) +import Control.Monad import System.Environment ( getArgs ) import System.FilePath -import System.IO.Error import System.Posix +import Text.Printf -import Photoname.Date +import Photoname.Common import Photoname.Opts ( Options (..) , parseOpts, usageText ) -import Photoname.Serial ( getSerial ) - - -type Ph a = ReaderT Options IO a - - -runRename :: Options -> Ph a -> IO a -runRename env action = runReaderT action env +import Photoname.DateFormat ( buildDatePath ) +import Photoname.SerialFormat ( buildSerialPath ) modeDir :: FileMode @@ -30,81 +22,38 @@ groupExecuteMode -{- load Exif information from a filename, returning Nothing if libexif - encounters a NULL instead of raising an IO error. - - This is somewhat bogus because of the error type that is used by - the EXIF library. We have to compare the error string to see if it - is the kind of user error that we expect. If we build against an - EXIF library that raises some other exception, then this build will - still succeed, and the exception will be propagated instead of - transformed into a handled photoname error. --} -safeExif :: FilePath -> IO (Maybe Exif) -safeExif = try . fromFile >=> either handleBadExif (return . Just) - where - isBadExif e = - ioeGetErrorString e == "mkExif: NULL" && isUserError e - handleBadExif e = - if isBadExif e then return Nothing else ioError e - - -{- Get shoot date from the exif information. There are several tags - potentially containing dates. Try them in a specific order until we - find one that has data. --} -getDate :: (MonadError String m, MonadIO m) => FilePath -> m String -getDate = loadExif >=> getOneOf dateTagNames - where - loadExif = (liftIO . safeExif) >=> - maybe (throwError "failed EXIF loading") return - - getOneOf [] _ = throwError "has no EXIF date" - getOneOf (tagName:tagNames) exif = - maybe (getOneOf tagNames exif) return =<< - liftIO (getTag exif tagName) - - dateTagNames = - ["DateTimeDigitized", "DateTimeOriginal", "DateTime"] - - {- Take a file path to a JPEG file and use EXIF information available to - move the file to a new location below the given basedir. + link the file at its new location below the given basedir. -} -createNewLink :: FilePath -> FilePath -> Ph () -createNewLink newDir oldPath = do +createNewLink :: FilePath -> Ph () +createNewLink oldPath = do opts <- ask - result <- liftIO $ runErrorT $ do - newPath <- buildNewPath newDir oldPath + newPath <- if (optOldStyle opts) + then buildSerialPath oldPath + else buildDatePath oldPath - -- Check for existance of the target file - exists <- liftIO $ fileExist newPath - when exists $ throwError $ "Destination " ++ newPath ++ " exists!" + -- Check for existance of the target file + exists <- liftIO $ fileExist newPath + when exists $ throwError $ "Destination " ++ newPath ++ " exists!" - -- Display what will be done - unless (optQuiet opts) $ - liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath + -- Display what will be done + unless (optQuiet opts) $ + liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath - unless (optNoAction opts) $ do - -- Make the target dir - liftIO $ makeDirectory $ takeDirectory newPath + unless (optNoAction opts) $ do + -- Make the target dir + liftIO $ makeDirectory $ takeDirectory newPath - -- Make the new hard link - liftIO $ createLink oldPath newPath + -- Make the new hard link + liftIO $ createLink oldPath newPath - -- If user has specified, remove the original link - when (optMove opts) $ - liftIO $ removeLink oldPath + -- If user has specified, remove the original link + when (optMove opts) $ + liftIO $ removeLink oldPath return () - let errPrefix = "** Processing " ++ oldPath ++ ": " - case result of - Left errMsg -> liftIO $ putStrLn $ errPrefix ++ errMsg - Right _ -> return () - - {- Given a list of lists, make a new list where each sublist element consists of the accumulation of all parts that came before it. Like this: @@ -135,49 +84,30 @@ in mapM_ makeOneDir $ listAcc $ splitPath d -{- Given a path to a file with EXIF data, construct a new path based on the - date and some serial number info we can parse out of the filename. --} -buildNewPath :: (MonadError String m, MonadIO m) => - FilePath -> FilePath -> m FilePath -buildNewPath newDir oldPath = do - dateString <- getDate oldPath - serial <- getSerial oldPath - let date = readDate dateString - let year = formatYear date - let day = formatDay date - let prefix = formatPrefix date - return (newDir year day - (prefix ++ "_" ++ serial) <.> "jpg") - - -- Figure out and execute what the user wants based on the supplied args. -executeCommands :: [String] -> Ph () +executeCommands :: Options -> [String] -> IO () -- User gave no files at all. Display help -executeCommands [] = liftIO $ putStrLn usageText - --- User gave just a dir and no files at all. Display help -executeCommands [_] = liftIO $ putStrLn usageText +executeCommands _ [] = putStrLn usageText -- Normal program operation, process the files with the args. -executeCommands (dir:filePaths) = do - opts <- ask - +executeCommands opts filePaths = do -- Get rid of anything not a regular file from the list of paths - actualPaths <- liftIO $ filterM + actualPaths <- filterM (\p -> getFileStatus p >>= return . isRegularFile) filePaths -- Notify user of the switches that will be in effect. when (optNoAction opts) $ - liftIO $ putStrLn "No-action mode, nothing will be changed." + putStrLn "No-action mode, nothing will be changed." when (optMove opts) $ - liftIO $ putStrLn - "Removing original links after new links are in place." + putStrLn "Removing original links after new links are in place." - -- Do the link manipulations. - mapM_ (createNewLink dir) actualPaths + -- Do the link manipulations, and report any errors. + forM_ actualPaths $ \path -> do + result <- runRename opts $ createNewLink path + either (\em -> printf "** Processing %s: %s\n" path em) + (const return ()) result main :: IO () @@ -186,6 +116,6 @@ (opts, paths) <- getArgs >>= parseOpts -- Do the photo naming procedure - runRename opts $ executeCommands paths + executeCommands opts paths -- Perhaps we should get an ExitCode back from all this above? diff --git a/testsuite/TestHelp.hs b/testsuite/TestHelp.hs --- a/testsuite/TestHelp.hs +++ b/testsuite/TestHelp.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -18,7 +18,7 @@ ] expectedFirstLine :: String -expectedFirstLine = "Usage: photoname [OPTIONS] PARENTDIR FILES" +expectedFirstLine = "Usage: photoname [OPTIONS] FILES" testHelpSwitch :: Test diff --git a/testsuite/TestLink.hs b/testsuite/TestLink.hs --- a/testsuite/TestLink.hs +++ b/testsuite/TestLink.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -8,7 +8,7 @@ where import System.Directory ( copyFile, removeDirectoryRecursive ) -import System.FilePath.Posix ( () ) +import System.FilePath.Posix ( (), (<.>) ) import System.Posix.Files ( fileExist ) import System.Process ( waitForProcess ) import Test.HUnit ( Test (..), assertBool, assertString ) @@ -23,12 +23,14 @@ testLinkAll :: Test testLinkAll = TestList - [ TestLabel "testLink" testLink + [ TestLabel "testLinkDate" testLinkDate + , TestLabel "testLinkSerial" testLinkSerial , TestLabel "testMove" testMove , TestLabel "testLinkNoAction" testLinkNoAction , TestLabel "testLinkNoActionLong" testLinkNoActionLong , TestLabel "testLinkQuiet" testLinkQuiet , TestLabel "testLinkQuietLong" testLinkQuietLong + , TestLabel "testLinkSuffix" testLinkSuffix , TestLabel "testNoExif" testNoExif , TestLabel "testNoSerial" testNoSerial , TestLabel "testDirForFile" testDirForFile @@ -37,17 +39,19 @@ topDir = Util.resourcesPath "foo" oldPath = Util.resourcesPath "img_1220.jpg" -newLinkPath = topDir "2003/2003-09-02/20030902_220.jpg" +newLinkPathDate = topDir "2003/2003-09-02/20030902-114303.jpg" +newLinkPathSerial = topDir "2003/2003-09-02/20030902_220.jpg" -testLink :: Test -testLink = TestCase $ do +testLinkDate :: Test +testLinkDate = TestCase $ do -- Run the program with known input data - (output, procH) <- Util.getBinaryOutput [ topDir, oldPath ] + (output, procH) <- Util.getBinaryOutput + [ "--parent-dir=" ++ topDir, oldPath ] waitForProcess procH -- Check that the correct output path exists - existsNew <- fileExist newLinkPath + existsNew <- fileExist newLinkPathDate assertBool "make link: existance of new link" existsNew -- Check that old path still exists @@ -59,9 +63,32 @@ -- Test output to stdout assertBool "make link: correct output" - (output =~ newLinkPath :: Bool) + (output =~ newLinkPathDate :: Bool) +testLinkSerial :: Test +testLinkSerial = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ "--parent-dir=" ++ topDir, "--old-style", oldPath ] + waitForProcess procH + + -- Check that the correct output path exists + existsNew <- fileExist newLinkPathSerial + assertBool "make link: existance of new link" existsNew + + -- Check that old path still exists + existsOld <- fileExist oldPath + assertBool "make link: existance of old link" existsOld + + -- Remove files and dirs that were created + removeDirectoryRecursive topDir + + -- Test output to stdout + assertBool "make link: correct output" + (output =~ newLinkPathSerial :: Bool) + + testMove :: Test testMove = TestCase $ do let newNewLinkPath = topDir "2003/2003-09-02/20030902_321.jpg" @@ -73,7 +100,7 @@ -- Run the program with known input data (output, procH) <- Util.getBinaryOutput - [ "--move", topDir, newOldPath ] + [ "--move", "--parent-dir=" ++ topDir, "--old-style", newOldPath ] waitForProcess procH -- Check that the correct output path exists @@ -103,7 +130,8 @@ testLinkNoAction' :: String -> String -> Test testLinkNoAction' label switch = TestCase $ do -- Run the program with known input data - (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ] + (output, procH) <- Util.getBinaryOutput + [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ] waitForProcess procH -- Check that the correct output path exists @@ -116,7 +144,7 @@ -- Test output to stdout assertBool (label ++ ": correct output") - (output =~ newLinkPath :: Bool) + (output =~ newLinkPathSerial :: Bool) testLinkQuiet :: Test @@ -131,11 +159,12 @@ testLinkQuiet' :: String -> String -> Test testLinkQuiet' label switch = TestCase $ do -- Run the program with known input data - (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ] + (output, procH) <- Util.getBinaryOutput + [ switch, "--parent-dir=" ++ topDir, "--old-style", oldPath ] waitForProcess procH -- Check that the correct output path exists - existsNew <- fileExist newLinkPath + existsNew <- fileExist newLinkPathSerial assertBool (label ++ ": existance of new link") existsNew -- Check that old path still exists @@ -147,6 +176,34 @@ -- Test output to stdout Util.assertFalse (label ++ ": no output") + (output =~ newLinkPathSerial :: Bool) + + +testLinkSuffix :: Test +testLinkSuffix = TestCase $ do + let suffix = "_dwm" + + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ "--parent-dir=" ++ topDir, "--suffix=" ++ suffix, oldPath ] + waitForProcess procH + + let newLinkPath = topDir + ("2003/2003-09-02/20030902-114303" ++ suffix) <.> "jpg" + + -- Check that the correct output path exists + existsNew <- fileExist newLinkPath + assertBool "make link: existance of new link" existsNew + + -- Check that old path still exists + existsOld <- fileExist oldPath + assertBool "make link: existance of old link" existsOld + + -- Remove files and dirs that were created + removeDirectoryRecursive topDir + + -- Test output to stdout + assertBool "make link: correct output" (output =~ newLinkPath :: Bool) @@ -154,31 +211,32 @@ testNoExif = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput - [ topDir, Util.resourcesPath "noExif.jpg" ] + [ "--parent-dir=" ++ topDir, Util.resourcesPath "noExif.jpg" ] waitForProcess procH -- Test output to stdout assertBool "no EXIF: correct output" - (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: failed EXIF loading" :: Bool) + (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: Failed EXIF loading" :: Bool) testNoSerial :: Test testNoSerial = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput - [ topDir, Util.resourcesPath "noSerial.jpg" ] + [ "--parent-dir=" ++ topDir + , "--old-style", Util.resourcesPath "noSerial.jpg" ] waitForProcess procH -- Test output to stdout assertBool "no serial in filename: correct output" - (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: has no serial" :: Bool) + (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: Can't determine serial" :: Bool) testDirForFile :: Test testDirForFile = TestCase $ do -- Run the program with known input data (output, procH) <- Util.getBinaryOutput - [ topDir, Util.resourcesPath ] + [ "--parent-dir=" ++ topDir, Util.resourcesPath ] waitForProcess procH -- Test output to stdout diff --git a/testsuite/Util.hs b/testsuite/Util.hs --- a/testsuite/Util.hs +++ b/testsuite/Util.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli diff --git a/testsuite/runtests.hs b/testsuite/runtests.hs --- a/testsuite/runtests.hs +++ b/testsuite/runtests.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2010 Dino Morelli +-- Copyright: 2007-2011 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -10,8 +10,10 @@ import TestLink -main :: IO Counts -main = runTestTT tests +main :: IO () +main = do + runTestTT tests + return () tests :: Test diff --git a/util/resources/test.conf b/util/resources/test.conf new file mode 100644 --- /dev/null +++ b/util/resources/test.conf @@ -0,0 +1,4 @@ +move +old-style +parent-dir=~/mypics +suffix=_dwm