diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2007, 2008 Dino Morelli +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Dino Morelli nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,28 @@ +photoname +---------- + +author: Dino Morelli + + +*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. + +This program is known to work with GHC 6.8.2 on systems where System.Posix +(unix) packages are available. + + +*install* + +Build and install in the typical way for Cabalized software: + + $ runhaskell Setup.lhs configure + $ runhaskell Setup.lhs build + $ runhaskell Setup.lhs test + $ runhaskell Setup.lhs install + +A Debian .deb package is available for this project at its home page: http://ui3.info/d/proj/photoname.html diff --git a/Setup.lhs b/Setup.lhs new file mode 100644 --- /dev/null +++ b/Setup.lhs @@ -0,0 +1,11 @@ +#!/usr/bin/env runhaskell + +> import Distribution.Simple +> import System.Cmd + + +> main = defaultMainWithHooks (simpleUserHooks { runTests = testRunner } ) +> where +> testRunner _ _ _ _ = do +> system $ "runhaskell -itestsuite testsuite/runtests.hs" +> return () diff --git a/TODO b/TODO new file mode 100644 --- /dev/null +++ b/TODO @@ -0,0 +1,32 @@ +- I wonder if changing to record style for the Opts.Flags would make any of the code simpler in Main + +- Add support for different camera filename formats, check with the Olympus. + +- Rewrite buildNewPath with MaybeT? + see: http://haskell.org/haskellwiki/New_monads/MaybeT + + +features that would be nice: + +- 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 diff --git a/doc/dev/notes b/doc/dev/notes new file mode 100644 --- /dev/null +++ b/doc/dev/notes @@ -0,0 +1,66 @@ +----- +rearchitecture of Main: + +flags used in: createNewLink, executeCommands, main + +- 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 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) + +yyyymmdd_[oth_]nnn[-e[n]].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. + + +These files are arranged into a dir structure + +top-level/ + 0000/ + 0000-00-00/ + 00000000_001.jpg -- Unknown pictures + 00000000_002.jpg + 2006/ + 2006-10-13/ + 20061013_431.jpg + 20061013_509.jpg + 2007/ + 2007-01-30/ + 20070130_002.jpg + 20070130_119-ew.jpg + 2007-04-19/ + 20070419_bmd_323.jpg + 20070419_bmd_325-sd.jpg diff --git a/doc/hcar-photoname b/doc/hcar-photoname new file mode 100644 --- /dev/null +++ b/doc/hcar-photoname @@ -0,0 +1,22 @@ +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. + + +Further reading + + * Project page: http://ui3.info/d/proj/photoname.html + * Source repository: darcs get http://ui3.info/darcs/photoname diff --git a/photoname.cabal b/photoname.cabal new file mode 100644 --- /dev/null +++ b/photoname.cabal @@ -0,0 +1,22 @@ +name: photoname +version: 2.0 +build-type: Simple +license: BSD3 +license-file: LICENSE +copyright: 2007, 2008 Dino Morelli +author: Dino Morelli +maintainer: Dino Morelli +stability: stable +homepage: http://ui3.info/d/proj/photoname.html +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 +tested-with: GHC==6.8.2 + +executable: photoname +build-depends: base, exif, filepath, mtl, old-locale, parsec, time, unix +main-is: Main.hs +ghc-options: -Wall +hs-source-dirs: src diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,179 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Main + where + +import Control.Monad.Reader +import Control.Monad.Writer +import qualified Graphics.Exif as Exif +import Photoname.Date +import qualified Photoname.Opts as Opts +import Photoname.Serial ( getSerial ) +import System.Environment ( getArgs ) +import System.FilePath +import System.Posix + + +modeDir :: FileMode +modeDir = ownerModes `unionFileModes` + groupReadMode `unionFileModes` + groupExecuteMode + + +{- 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: + before: [[1], [2], [3], [4], [5]] + after : [[1], [1,2], [1,2,3], [1,2,3,4], [1,2,3,4,5]] + + Many thanks to Betty Diegel for help with this algorithm. +-} +listAcc :: [[a]] -> [[a]] +listAcc [] = [[]] +listAcc (x:xs) = listAcc' x xs + where + listAcc' l (y:ys) = [l] ++ listAcc' (l ++ y) ys + listAcc' l [] = [l] + + +{- Execute a sequence of m (Maybe a) actions until the first non-Nothing + evaluation, eval to that. + + Thanks to sjanssen et al on #haskell + + XXX Can this be genericized to be :: (Monad m, Monad n) => + [m (n a)] -> m (n a) + XXX Put this in a more common module. +-} +firstSuccess :: Monad m => [m (Maybe a)] -> m (Maybe a) +firstSuccess = foldr f (return Nothing) + where + f :: Monad t => t (Maybe m1) -> t (Maybe m1) -> t (Maybe m1) + f m ms = do -- m in here, NOT Maybe + x <- m + case x of + Just _ -> return x + Nothing -> ms + + +{- 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 :: Exif.Exif -> IO (Maybe String) +getDate exif = + firstSuccess $ map (Exif.getTag exif) + ["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. +-} +createNewLink :: FilePath -> FilePath -> Ph () +createNewLink newDir oldPath = do + flags <- ask + e <- liftIO $ buildNewPath newDir oldPath + case e of + Left err -> tell [err] + Right newPath -> do + -- Check for existance of the target file + exists <- liftIO $ fileExist newPath + if exists + then tell + ["** " ++ oldPath ++ " -> " ++ newPath ++ " exists!"] + else do + -- Display what will be done + unless (Opts.Quiet `elem` flags) $ + tell [(oldPath ++ " -> " ++ newPath)] + + unless (Opts.NoAction `elem` flags) $ do + -- Make the target dir + liftIO $ makeDirectory $ takeDirectory newPath + + -- Make the new hard link + liftIO $ createLink oldPath newPath + + -- If user has specified, remove the original link + when (Opts.Move `elem` flags) $ + liftIO $ removeLink oldPath + + +{- Ensuring that a directory with subs exists turned out to be a painful + process involving making each parent dir piece by piece but not trying + to make anything that's already there. +-} +makeDirectory :: FilePath -> IO () +makeDirectory d = + let makeOneDir dir = do + exists <- fileExist dir + unless exists $ createDirectory dir modeDir + 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. + This function got complicated, there are several ways this can fail. +-} +buildNewPath :: FilePath -> FilePath -> IO (Either String FilePath) +buildNewPath newDir oldPath = do + exif <- Exif.fromFile oldPath + maybeDs <- getDate exif + case maybeDs of + Just ds -> do + let date = readDate ds + let maybeSerial = getSerial oldPath + case maybeSerial of + Just serial -> do + let year = formatYear date + let day = formatDay date + let prefix = formatPrefix date + return $ Right $ newDir year day + (prefix ++ "_" ++ serial) <.> "jpg" + Nothing -> return $ Left $ "File " ++ oldPath ++ " has no serial." + Nothing -> return $ Left $ "File " ++ oldPath ++ " has no EXIF date." + + +-- Figure out and execute what the user wants based on the supplied args. +executeCommands :: [String] -> Ph () + +-- User gave no files at all. Display help +executeCommands [] = tell [Opts.usageText] + +-- Normal program operation, process the files with the args. +executeCommands (dir:filePaths) = do + flags <- ask + + -- Get rid of anything not a regular file from the list of paths + actualPaths <- liftIO $ filterM + (\p -> getFileStatus p >>= return . isRegularFile) filePaths + + -- Notify user of the switches that will be in effect. + when (Opts.NoAction `elem` flags) $ + tell ["No-action mode, nothing will be changed."] + + when (Opts.Move `elem` flags) $ + tell ["Removing original links after new links are in place."] + + -- Do the link manipulations. + mapM_ (createNewLink dir) actualPaths + + +type Ph a = ReaderT [Opts.Flag] (WriterT [String] IO) a + +runMain :: [Opts.Flag] -> Ph a -> IO (a, [String]) +runMain env exec = runWriterT $ runReaderT exec env + +main :: IO () +main = do + -- Parse the arguments + (flags, paths) <- getArgs >>= Opts.parseOpts + + -- Do the photo naming procedure + (rval, messages) <- runMain flags $ executeCommands paths + + -- Display collected output log + putStrLn $ unlines messages + + return rval diff --git a/src/Photoname/Date.hs b/src/Photoname/Date.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/Date.hs @@ -0,0 +1,60 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Photoname.Date ( + formatYear, formatDay, formatPrefix, + readDate +) + where + +import Data.Time.Calendar +import Data.Time.Format +import Data.Time.LocalTime +import System.Locale ( defaultTimeLocale ) +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 +readDate :: String -> Maybe LocalTime +readDate s = + case (parse dateParser "" s) of + Left _ -> Nothing + Right x -> Just x + where + digit4 = count 4 digit + digit2 = count 2 digit + colon = char ':' + dateParser = do + year <- digit4 ; colon ; month <- digit2 ; colon ; day <- digit2 + space + hour <- digit2 ; colon ; minute <- digit2 + colon ; second <- digit2 + return $ + LocalTime + (fromGregorian (read year) (read month) (read day)) + (TimeOfDay (read hour) (read minute) + (fromIntegral ((read second) :: Integer))) + + +-- 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 "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 diff --git a/src/Photoname/Opts.hs b/src/Photoname/Opts.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/Opts.hs @@ -0,0 +1,77 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Photoname.Opts + ( Flag (..) + , Opts + , parseOpts, usageText + ) + where + +import System.Console.GetOpt + + +data Flag + = NoAction + | Quiet + | Move + | Help + deriving Eq + + +-- A convenience type representing all flags and all non-flag strings +-- that came in from outside +type Opts = ([Flag], [String]) + + +options :: [OptDescr Flag] +options = + [ Option ['n'] ["no-action"] (NoArg NoAction) + "Display what would be done, but do nothing" + , Option ['q'] ["quiet"] (NoArg Quiet) + "Suppress normal output of what's being done" + , Option [] ["move"] (NoArg Move) + "Move the files, don't just hard-link to the new locations" + , Option ['h'] ["help"] (NoArg Help) + "This help text" + ] + + +parseOpts :: [String] -> IO Opts +parseOpts argv = + case getOpt Permute options argv of + (o,n,[] ) -> return (o,n) + (_,_,errs) -> ioError (userError (concat errs ++ usageText)) + + +usageText :: String +usageText = (usageInfo header options) ++ "\n" ++ footer + where + header = init $ unlines + [ "Usage: photoname [OPTIONS] PARENTDIR 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." + , "" + , "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:" + , "" + , "A photo shot on 2002-May-02 with a Canon camera:" + , " img_1790.jpg -> /2002/2002-05-02/20020502_790.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." + , "" + , "Version 2.0 2008-Mar-04 Dino Morelli " + ] diff --git a/src/Photoname/Serial.hs b/src/Photoname/Serial.hs new file mode 100644 --- /dev/null +++ b/src/Photoname/Serial.hs @@ -0,0 +1,42 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Photoname.Serial ( + getSerial +) + where + +--import Debug.Trace +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 :: FilePath -> Maybe String +getSerial s = + case (parse parser "" s) of + Left _ -> Nothing + --Left err -> trace (show err) Nothing + Right x -> Just x + where + parser = serialNum diff --git a/testsuite/TestHelp.hs b/testsuite/TestHelp.hs new file mode 100644 --- /dev/null +++ b/testsuite/TestHelp.hs @@ -0,0 +1,37 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module TestHelp ( + testHelpAll +) + where + +import qualified Util +import Test.HUnit ( Test (..), assertBool, assertEqual ) + + +testHelpAll :: Test +testHelpAll = TestList + [ TestLabel "testHelpSwitch" testHelpSwitch + , TestLabel "testHelpSwitchLong" testHelpSwitchLong + ] + +expectedFirstLine :: String +expectedFirstLine = "Usage: photoname [OPTIONS] PARENTDIR FILES" + + +testHelpSwitch :: Test +testHelpSwitch = TestCase $ do + (allOutput, _) <- Util.getBinaryOutput ["-h"] + assertEqual "-h switch output" + expectedFirstLine + $ head $ lines allOutput + + +testHelpSwitchLong :: Test +testHelpSwitchLong = TestCase $ do + (allOutput, _) <- Util.getBinaryOutput ["--help"] + assertEqual "--help switch output" + expectedFirstLine + $ head $ lines allOutput diff --git a/testsuite/TestLink.hs b/testsuite/TestLink.hs new file mode 100644 --- /dev/null +++ b/testsuite/TestLink.hs @@ -0,0 +1,188 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module TestLink ( + testLinkAll +) + where + +import System.Directory ( copyFile, removeDirectoryRecursive ) +import System.FilePath.Posix ( () ) +import System.Posix.Files ( fileExist ) +import System.Process ( waitForProcess ) +import Test.HUnit ( Test (..), assertBool, assertString ) +import Text.Regex.Posix ( (=~) ) +import qualified Util + + +{- Test the normal behavior of hard-linking the original file to a new + path. +-} + + +testLinkAll :: Test +testLinkAll = TestList + [ TestLabel "testLink" testLink + , TestLabel "testMove" testMove + , TestLabel "testLinkNoAction" testLinkNoAction + , TestLabel "testLinkNoActionLong" testLinkNoActionLong + , TestLabel "testLinkQuiet" testLinkQuiet + , TestLabel "testLinkQuietLong" testLinkQuietLong + , TestLabel "testNoExif" testNoExif + , TestLabel "testNoSerial" testNoSerial + , TestLabel "testDirForFile" testDirForFile + ] + + +topDir = Util.resourcesPath "foo" +oldPath = Util.resourcesPath "img_1220.jpg" +newLinkPath = topDir "2003/2003-09-02/20030902_220.jpg" + + +testLink :: Test +testLink = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput [ topDir, oldPath ] + waitForProcess procH + + -- 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) + + +testMove :: Test +testMove = TestCase $ do + let newNewLinkPath = topDir "2003/2003-09-02/20030902_321.jpg" + + -- Make a dummy copy of the source file. This test will be getting rid + -- of it, if successful. + let newOldPath = Util.resourcesPath "img_0321.jpg" + copyFile oldPath newOldPath + + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ "--move", topDir, newOldPath ] + waitForProcess procH + + -- Check that the correct output path exists + existsNew <- fileExist newNewLinkPath + assertBool "move file: existance of new link" existsNew + + -- Check that old path still exists + existsOld <- fileExist newOldPath + Util.assertFalse "move file: existance of old link" existsOld + + -- Remove files and dirs that were created + removeDirectoryRecursive topDir + + -- Test output to stdout + assertBool "move file: correct output" + (output =~ newNewLinkPath :: Bool) + + +testLinkNoAction :: Test +testLinkNoAction = testLinkNoAction' "no action" "-n" + + +testLinkNoActionLong :: Test +testLinkNoActionLong = testLinkNoAction' "no action long" "--no-action" + + +testLinkNoAction' :: String -> String -> Test +testLinkNoAction' label switch = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ] + waitForProcess procH + + -- Check that the correct output path exists + existsNew <- fileExist topDir + Util.assertFalse (label ++ ": existance of new link") existsNew + + -- Check that old path still exists + existsOld <- fileExist oldPath + assertBool (label ++ ": existance of old link") existsOld + + -- Test output to stdout + assertBool (label ++ ": correct output") + (output =~ newLinkPath :: Bool) + + +testLinkQuiet :: Test +testLinkQuiet = testLinkQuiet' "make link quiet" "-q" + + +testLinkQuietLong :: Test +testLinkQuietLong = testLinkQuiet' "make link quiet long" "--quiet" + + +-- Reusable test code for above short/long versions of the quiet switch +testLinkQuiet' :: String -> String -> Test +testLinkQuiet' label switch = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput [ switch, topDir, oldPath ] + waitForProcess procH + + -- Check that the correct output path exists + existsNew <- fileExist newLinkPath + assertBool (label ++ ": existance of new link") existsNew + + -- Check that old path still exists + existsOld <- fileExist oldPath + assertBool (label ++ ": existance of old link") existsOld + + -- Remove files and dirs that were created + removeDirectoryRecursive topDir + + -- Test output to stdout + Util.assertFalse (label ++ ": no output") + (output =~ newLinkPath :: Bool) + + +testNoExif :: Test +testNoExif = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ topDir, Util.resourcesPath "noExif.jpg" ] + waitForProcess procH + + -- Test output to stdout + assertBool "no EXIF: correct output" + (output =~ "File testsuite/resources/noExif.jpg has no EXIF date." + :: Bool) + + +testNoSerial :: Test +testNoSerial = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ topDir, Util.resourcesPath "noSerial.jpg" ] + waitForProcess procH + + -- Test output to stdout + assertBool "no serial in filename: correct output" + (output =~ "File testsuite/resources/noSerial.jpg has no serial." + :: Bool) + + +testDirForFile :: Test +testDirForFile = TestCase $ do + -- Run the program with known input data + (output, procH) <- Util.getBinaryOutput + [ topDir, Util.resourcesPath ] + waitForProcess procH + + -- Test output to stdout + assertBool "dir as file to change: correct output" + (output =~ "" :: Bool) diff --git a/testsuite/Util.hs b/testsuite/Util.hs new file mode 100644 --- /dev/null +++ b/testsuite/Util.hs @@ -0,0 +1,42 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Util ( + binPath, resourcesPath, + getProcessOutput, getBinaryOutput, + assertFalse +) + where + +import System.IO +import System.Process +import Test.HUnit + + +binPath :: FilePath +binPath = "dist/build/photoname/photoname" + + +resourcesPath :: FilePath +resourcesPath = "testsuite/resources" + + +{- Quick and dirty function to run a process and grab its output. + This evil thing doesn't watch STDERR at all or otherwise do anything + even remotely safe. + XXX Move this somewhere logical like Photoname.Util +-} +getProcessOutput :: FilePath -> [String] -> IO (String, ProcessHandle) +getProcessOutput path args = do + (_, outH, _, procH) <- runInteractiveProcess path args Nothing Nothing + output <- hGetContents outH + return (output, procH) + + +getBinaryOutput :: [String] -> IO (String, ProcessHandle) +getBinaryOutput = getProcessOutput binPath + + +assertFalse :: String -> Bool -> Assertion +assertFalse l b = assertBool l $ not b diff --git a/testsuite/resources/img_1220.jpg b/testsuite/resources/img_1220.jpg new file mode 100644 Binary files /dev/null and b/testsuite/resources/img_1220.jpg differ diff --git a/testsuite/resources/noExif.jpg b/testsuite/resources/noExif.jpg new file mode 100644 --- /dev/null +++ b/testsuite/resources/noExif.jpg @@ -0,0 +1,1 @@ +This is not an image file at all! diff --git a/testsuite/resources/noSerial.jpg b/testsuite/resources/noSerial.jpg new file mode 100644 Binary files /dev/null and b/testsuite/resources/noSerial.jpg differ diff --git a/testsuite/runtests.hs b/testsuite/runtests.hs new file mode 100644 --- /dev/null +++ b/testsuite/runtests.hs @@ -0,0 +1,21 @@ +-- Copyright: 2007, 2008 Dino Morelli +-- License: BSD3 (see LICENSE) +-- Author: Dino Morelli + +module Main + where + +import Test.HUnit +import TestHelp +import TestLink + + +main :: IO Counts +main = runTestTT tests + + +tests :: Test +tests = TestList + [ TestLabel "testHelpAll" testHelpAll + , TestLabel "testLinkAll" testLinkAll + ] diff --git a/util/post-get b/util/post-get new file mode 100644 --- /dev/null +++ b/util/post-get @@ -0,0 +1,3 @@ +#! /bin/sh + +ln -s dist/build/photoname/photoname diff --git a/util/prefs/boring b/util/prefs/boring new file mode 100644 --- /dev/null +++ b/util/prefs/boring @@ -0,0 +1,37 @@ +# Boring file regexps: +\.hi$ +\.o$ +\.o\.cmd$ +# *.ko files aren't boring by default because they might +# be Korean translations rather than kernel modules. +# \.ko$ +\.ko\.cmd$ +\.mod\.c$ +(^|/)\.tmp_versions($|/) +(^|/)CVS($|/) +(^|/)RCS($|/) +~$ +#(^|/)\.[^/] +(^|/)_darcs($|/) +\.bak$ +\.BAK$ +\.orig$ +(^|/)vssver\.scc$ +\.swp$ +(^|/)MT($|/) +(^|/)\{arch\}($|/) +(^|/).arch-ids($|/) +(^|/), +\.class$ +\.prof$ +(^|/)\.DS_Store$ +(^|/)BitKeeper($|/) +(^|/)ChangeSet($|/) +(^|/)\.svn($|/) +\.py[co]$ +\# +\.cvsignore$ +(^|/)Thumbs\.db$ +(^|/)autom4te\.cache($|/) +(^|/)dist($|/) +\.setup-config$