photoname (empty) → 2.0
raw patch · 20 files changed
+898/−0 lines, 20 filesdep +basedep +exifdep +filepathsetup-changedbinary-added
Dependencies added: base, exif, filepath, mtl, old-locale, parsec, time, unix
Files
- LICENSE +30/−0
- README +28/−0
- Setup.lhs +11/−0
- TODO +32/−0
- doc/dev/notes +66/−0
- doc/hcar-photoname +22/−0
- photoname.cabal +22/−0
- src/Main.hs +179/−0
- src/Photoname/Date.hs +60/−0
- src/Photoname/Opts.hs +77/−0
- src/Photoname/Serial.hs +42/−0
- testsuite/TestHelp.hs +37/−0
- testsuite/TestLink.hs +188/−0
- testsuite/Util.hs +42/−0
- testsuite/resources/img_1220.jpg binary
- testsuite/resources/noExif.jpg +1/−0
- testsuite/resources/noSerial.jpg binary
- testsuite/runtests.hs +21/−0
- util/post-get +3/−0
- util/prefs/boring +37/−0
+ LICENSE view
@@ -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.
+ README view
@@ -0,0 +1,28 @@+photoname+----------++author: Dino Morelli <dino@ui3.info>+++*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
+ Setup.lhs view
@@ -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 ()
+ TODO view
@@ -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
+ doc/dev/notes view
@@ -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/<somefile>++----------+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
+ doc/hcar-photoname view
@@ -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
+ photoname.cabal view
@@ -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 <dino@ui3.info>+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
+ src/Main.hs view
@@ -0,0 +1,179 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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
+ src/Photoname/Date.hs view
@@ -0,0 +1,60 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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
+ src/Photoname/Opts.hs view
@@ -0,0 +1,77 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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 -> <PARENTDIR>/2002/2002-05-02/20020502_790.jpg"+ , ""+ , "The <PARENTDIR> 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 <dino@ui3.info>"+ ]
+ src/Photoname/Serial.hs view
@@ -0,0 +1,42 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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
+ testsuite/TestHelp.hs view
@@ -0,0 +1,37 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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
+ testsuite/TestLink.hs view
@@ -0,0 +1,188 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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)
+ testsuite/Util.hs view
@@ -0,0 +1,42 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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
+ testsuite/resources/img_1220.jpg view
binary file changed (absent → 78486 bytes)
+ testsuite/resources/noExif.jpg view
@@ -0,0 +1,1 @@+This is not an image file at all!
+ testsuite/resources/noSerial.jpg view
binary file changed (absent → 78486 bytes)
+ testsuite/runtests.hs view
@@ -0,0 +1,21 @@+-- Copyright: 2007, 2008 Dino Morelli+-- License: BSD3 (see LICENSE)+-- Author: Dino Morelli <dino@ui3.info>++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+ ]
+ util/post-get view
@@ -0,0 +1,3 @@+#! /bin/sh++ln -s dist/build/photoname/photoname
+ util/prefs/boring view
@@ -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$