diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2007-2009 Dino Morelli +Copyright (c) 2007-2010 Dino Morelli All rights reserved. Redistribution and use in source and binary forms, with or without diff --git a/doc/hcar-photoname b/doc/hcar-photoname deleted file mode 100644 --- a/doc/hcar-photoname +++ /dev/null @@ -1,26 +0,0 @@ -This information is for this project's entry in the _Haskell Communities and Activities Report_ (http://www.haskell.org/communities/) - -entry begins below - ----------- -[section 6 Applications] - -6.x photoname - ------ -Report by: Dino Morelli -Maintainer: Dino Morelli -Status: stable, maintained ------ - -photoname is a command-line utility for renaming/moving photo image files. The new folder location and naming are determined by the EXIF photo shoot date and the usually-camera-assigned serial number, often appearing in the filename. - -Between versions 2.0 and 2.1 the software is largely the same on the outside but has undergone extensive changes inside. Most of this involving redesign with monad transformers. - -photoname is on Hackage and can be acquired using darcs or other methods. See the project page below for more. - - -Further reading - - * Project page: http://ui3.info/d/proj/photoname.html - * Source repository: darcs get http://ui3.info/darcs/photoname diff --git a/doc/hcar-photoname.tex b/doc/hcar-photoname.tex new file mode 100644 --- /dev/null +++ b/doc/hcar-photoname.tex @@ -0,0 +1,21 @@ +\begin{hcarentry}{photoname} +\label{photoname} +\report{Dino Morelli}%11/08 +\status{stable, maintained} +\makeheader + +photoname is a command-line utility for renaming/moving photo image files. The new folder location and naming are determined by the EXIF photo shoot date and the usually-camera-assigned serial number, often appearing in the filename. + +photoname is on Hackage and can be acquired using darcs or other methods. See the project page below for more. + +\FurtherReading +\begin{compactitem} +\item Project page: + +\url{http://ui3.info/d/proj/photoname.html} + +\item Source repository: + +\texttt{darcs get} \url{http://ui3.info/darcs/photoname} +\end{compactitem} +\end{hcarentry} 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.2 +version: 2.3.0 build-type: Simple license: BSD3 license-file: LICENSE -copyright: 2007-2009 Dino Morelli +copyright: 2007-2010 Dino Morelli author: Dino Morelli maintainer: Dino Morelli stability: stable diff --git a/src/Photoname/Date.hs b/src/Photoname/Date.hs --- a/src/Photoname/Date.hs +++ b/src/Photoname/Date.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli 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-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -79,5 +79,5 @@ , "" , "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." , "" - , "Version 2.2 2009-Jun-07 Dino Morelli " + , "Version 2.3.0 2010-Jan-17 Dino Morelli " ] diff --git a/src/Photoname/Serial.hs b/src/Photoname/Serial.hs --- a/src/Photoname/Serial.hs +++ b/src/Photoname/Serial.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -39,5 +39,5 @@ getSerial :: (MonadError String m) => String -> m String getSerial path = case (parse serialNum "" path) of - Left _ -> throwError $ "File " ++ path ++ " has no serial" + Left _ -> throwError "has no serial" Right serial -> return serial diff --git a/src/photoname.hs b/src/photoname.hs --- a/src/photoname.hs +++ b/src/photoname.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -6,9 +6,10 @@ import Control.Monad.Error import Control.Monad.Reader -import Graphics.Exif ( fromFile, getTag ) +import Graphics.Exif ( fromFile, getTag, Exif ) import System.Environment ( getArgs ) import System.FilePath +import System.IO.Error import System.Posix import Photoname.Date @@ -29,25 +30,45 @@ 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 path = do - exif <- liftIO $ fromFile path +getDate = loadExif >=> getOneOf dateTagNames + where + loadExif = (liftIO . safeExif) >=> + maybe (throwError "failed EXIF loading") return - -- This foldl gets us the first IO (Maybe String) that's not Nothing - maybeDate <- liftIO $ foldl (liftM2 mplus) (return Nothing) $ - map (getTag exif) - ["DateTimeDigitized", "DateTimeOriginal", "DateTime"] + getOneOf [] _ = throwError "has no EXIF date" + getOneOf (tagName:tagNames) exif = + maybe (getOneOf tagNames exif) return =<< + liftIO (getTag exif tagName) - case maybeDate of - Just d -> return d - Nothing -> throwError $ "File " ++ path ++ " has no EXIF date" + dateTagNames = + ["DateTimeDigitized", "DateTimeOriginal", "DateTime"] -{- Take a file path to a JPEG file and use EXIF information available to +{- 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. -} createNewLink :: FilePath -> FilePath -> Ph () @@ -58,11 +79,10 @@ -- Check for existance of the target file exists <- liftIO $ fileExist newPath - when exists $ throwError $ - "** " ++ oldPath ++ " -> " ++ newPath ++ " exists!" + when exists $ throwError $ "Destination " ++ newPath ++ " exists!" -- Display what will be done - unless (optQuiet opts) $ + unless (optQuiet opts) $ liftIO $ putStrLn $ oldPath ++ " -> " ++ newPath unless (optNoAction opts) $ do @@ -78,8 +98,10 @@ return () + let errPrefix = "** Processing " ++ oldPath ++ ": " + case result of - Left errMsg -> liftIO $ putStrLn errMsg + Left errMsg -> liftIO $ putStrLn $ errPrefix ++ errMsg Right _ -> return () @@ -134,6 +156,9 @@ -- 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 -- Normal program operation, process the files with the args. executeCommands (dir:filePaths) = do diff --git a/testsuite/TestHelp.hs b/testsuite/TestHelp.hs --- a/testsuite/TestHelp.hs +++ b/testsuite/TestHelp.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli diff --git a/testsuite/TestLink.hs b/testsuite/TestLink.hs --- a/testsuite/TestLink.hs +++ b/testsuite/TestLink.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli @@ -159,8 +159,7 @@ -- Test output to stdout assertBool "no EXIF: correct output" - (output =~ "File testsuite/resources/noExif.jpg has no EXIF date" - :: Bool) + (output =~ "\\*\\* Processing testsuite/resources/noExif.jpg: failed EXIF loading" :: Bool) testNoSerial :: Test @@ -172,8 +171,7 @@ -- Test output to stdout assertBool "no serial in filename: correct output" - (output =~ "File testsuite/resources/noSerial.jpg has no serial" - :: Bool) + (output =~ "\\*\\* Processing testsuite/resources/noSerial.jpg: has no serial" :: Bool) testDirForFile :: Test diff --git a/testsuite/Util.hs b/testsuite/Util.hs --- a/testsuite/Util.hs +++ b/testsuite/Util.hs @@ -1,4 +1,4 @@ --- Copyright: 2007-2009 Dino Morelli +-- Copyright: 2007-2010 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-2009 Dino Morelli +-- Copyright: 2007-2010 Dino Morelli -- License: BSD3 (see LICENSE) -- Author: Dino Morelli