-- tieflegen: Dateinamenteile zu Oberverzeichnissen machen
import System.Directory
import Control.Monad
import Data.Maybe
import System.IO
import System.IO.Error hiding (catch)
import System.Posix
import Data.List
import Text.Regex
import Debug.Trace
import Prelude hiding (catch)
--import Text hiding (zerlegen)
--import Kommandos
--import Arg hiding (d_probe)
--import Hsskripte
--import Datenbank
import HsShellScript hiding (echo)
header = "tieflegen [Optionen] [Verzeichnisse]"
args = unsafe_getargs header descs
descs = [ d_trenner, d_verzl, d_ausrollen, d_verschieben, d_tiefe, d_gk_beachten, d_probe, d_umbenennen, d_ebenen,
d_spalten, d_album
] ++ map za_arg zerlegungsarten
trenner_normal = " - "
trennzeichen = "-_ ~()"
trenner = fromMaybe trenner_normal $ optarg_req args d_trenner
tiefe = if arg_switch args d_album then 2 else read (fromMaybe "1" $ optarg_req args d_tiefe)
pfade = args_req args d_verzl
probe = arg_switch args d_probe
beachten = arg_switch args d_gk_beachten
umbenennen = arg_switch args d_umbenennen
ebenen = if arg_switch args d_album then 1 else read (fromMaybe "0" (optarg_req args d_ebenen))
spalten = arg_switch args d_spalten || arg_switch args d_album
------------------------------------------------------------------------------------------------------------------------------------------------------
-- Möglichkeiten zu zerlegen. Hieraus Kommandozeilenparameter u.a.
-- Wenn nichts anderes gewählt
normalzerleger = trenner_zerleger trenner
normalverschieben = False
zerlegungsarten :: [ ( ArgumentDescription -- Kommandozeilenparameter
, ArgumentDescription -> Arguments -> (Bool -> String -> [String]) -- daraus Zerleger
, Bool -- ob normal verschieben
)
]
zerlegungsarten =
[
-- Nach regulärem Ausdruck
( argdesc [ desc_short 'r'
, desc_long "regex"
, desc_argname "Regex"
, desc_value_required
, desc_description $ "Teile durch reg. Ausdr. auszeichnen. Abgeglichen wird ein passender TEIL des Namens, nicht der ganze Namen.\n\
\ Bei " ++ argname d_verschieben ++ " sind nur die beabsichtigten Verzeichnisteile auszuzeichnen, sonst \n\
\ Verzeichnisteile und Dateinameteil. Außer bei " ++ argname d_ausrollen ++ " wird VERSCHOBEN."
]
, \arg args -> regex_zerleger_t (fromJust (optarg_req args arg)) beachten
, True
)
-- An letztem Vorkommen des Trenners oder eines Spalters
, ( argdesc [ desc_short 's'
, desc_long "spalten-an"
, desc_argname "Spalter"
, desc_value_required
, desc_description $ "Am letzten Vorkommen des Spalters (normal der Trenner) spalten. Trennzeichen "
++ quote trennzeichen ++ " fallenlassen. Außer\n bei " ++ argname d_ausrollen ++ " wird VERSCHOBEN."
]
, \arg args -> let tt = fromJust (optarg_req args arg)
in if null tt then throw (Meldung "Fehler: leerer Spalter")
else regex_zerleger_t ("^(.*)[" ++ trennzeichen ++ "]*" ++ intersperse '\\' tt) beachten
, True
)
-- Vor der ersten Zahl spalten
, ( argdesc [ desc_short 'z'
, desc_long "vor-zahl"
, desc_description $ "Den Teil vor der ersten Zahl zum Verzeichnisnamen machen. Außer bei\n " ++ argname d_ausrollen ++
" wird VERSCHOBEN."
]
, \arg args -> \versch txt -> case regex_zerleger_t "^([^0-9]+)[0-9]" beachten versch txt of
[] -> []
[teil] -> [reverse (dropWhile (`elem` trennzeichen) (reverse teil))]
, True
)
-- Bis zur ersten Zahl zum Verzeichnisnamen machen
, ( argdesc [ desc_long "bis-zahl"
, desc_description $ "Den Teil bis zur ersten Zahl zum Verzeichnisnamen machen. Außer bei\n " ++ argname d_ausrollen ++
" wird VERSCHOBEN."
]
, \arg args -> \versch txt -> case regex_zerleger_t "^([^0-9]+[0-9]*)" beachten versch txt of
[] -> []
[teil] -> [reverse (dropWhile (`elem` trennzeichen) (reverse teil))]
, True
)
-- Vor der letzten Zahl spalten
, ( argdesc [ desc_short 'l'
, desc_long "vor-letzter-zahl"
, desc_description $ "Den Teil vor der letzten Zahl zum Verzeichnisnamen machen. Außer bei\n " ++ argname d_ausrollen ++
" wird VERSCHOBEN."
]
, \arg args -> \versch txt -> case regex_zerleger_t "^(.*[^0-9])[0-9]" beachten versch txt of
[] -> []
[teil] -> [reverse (dropWhile (`elem` trennzeichen) (reverse teil))]
, True
)
-- Die erste Zahl als Verzeichnisname
, ( argdesc [ desc_short 'e'
, desc_long "erste-zahl"
, desc_description $ "Die erste Zahl zum Verzeichnisnamen machen. Außer bei\n " ++ argname d_ausrollen ++
"wird VERSCHOBEN."
]
, \arg args -> regex_zerleger_t "([0-9]+)" beachten
, True
)
]
za_arg (arg, zerlegerf, verschieben) = arg
za_zerlegerf (arg, zerlegerf, verschieben) = zerlegerf
za_verschieben (arg, zerlegerf, verschieben) = verschieben
------------------------------------------------------------------------------------------------------------------------------------------------------
-- Kommandozeilenparameter
d_trenner =
d_trenner_f trenner_normal
d_verzl =
argdesc [ desc_direct
, desc_at_least 1
, desc_description ("Pfade, die getieft werden sollen")
]
d_tiefe =
argdesc [ desc_at_most_once
, desc_long "tiefe"
, desc_value_required
, desc_integer
, desc_argname "Ebenen"
, desc_description ("Bis zu so vielen Ebenen tief in Verzeichnisse verwandeln (normal eine)")
]
d_verschieben =
argdesc [ desc_short 'v'
, desc_long "verschieben"
, desc_description ("Nur verschieben, nicht umbenennen")
]
d_ausrollen =
argdesc [ desc_short 'a'
, desc_long "ausrollen"
, desc_description ("Namensteile zu Verzeichnissen machen und entfernen (normal nur verschieben).")
]
d_gk_beachten =
argdesc [ desc_short 'b'
, desc_long "beachten"
, desc_description ("Groß/Kleinschreibung beachten (normal nicht beachten)")
]
d_probe =
argdesc [ desc_short 'p'
, desc_long "probe"
, desc_description ("Probelauf - ausgeben wie umbenannt würde")
]
d_umbenennen =
argdesc [ desc_at_most_once
, desc_short 'U'
, desc_long "umbenennen"
, desc_description ("Im Falle einer Kollision umbenennen")
]
d_ebenen =
argdesc [ desc_at_most_once
, desc_short 'V'
, desc_long "verschmelzen"
, desc_argname "Ebenen"
, desc_description ("Höchstens so viele Ebenen tief verschmelzen, danach stattdessen umbenennen.")
, desc_nonneg_integer
, desc_value_required
]
d_spalten =
argdesc [ desc_at_most_once
, desc_long "spalten"
, desc_description ("Ein zwei Teile spalten, d.h. alle abgetrennten Teile vereinen")
]
d_album =
argdesc [ desc_at_most_once
, desc_long "album"
, desc_description ("Kurz für \"--spalten --tiefe=2 --verschmelzen=1\"")
]
------------------------------------------------------------------------------------------------------------------------------------------------------
-- Hauptteil
main = mainwrapper $ do
seq args (return ())
args_at_most_one (map za_arg zerlegungsarten) args
args_at_most_one [d_verschieben, d_ausrollen] args
-- ? args_at_most_one [d_tiefe, d_album, d_ebenen, d_verschieben] args
hSetBuffering stdout (BlockBuffering (Just 10000))
outm "-01-" --XX
let -- Zerleger aus den Kommandozeilenparametern bestimmen
(zerleger, zerl_verschieben) =
case filter (\za -> arg_occurs args (za_arg za)) zerlegungsarten of
[za] -> ( za_zerlegerf za (za_arg za) args, za_verschieben za )
[] -> ( normalzerleger, normalverschieben )
-- Ob verschoben wird aus den Kommandozeilenparametern bestimmen
verschieben = arg_occurs args d_album ||
case (arg_switch args d_ausrollen, arg_switch args d_verschieben) of
(True, False) -> False
(False, True) -> True
(False, False) -> zerl_verschieben
outm "-02-" --XX
if probe
then do umbl <- Main.ausfuehren zerleger
verschieben
(\pfad verzteile neudn -> return (pfad, verzteile ++ [neudn]))
pfade
let tab = tabelle (repeat (\st feld -> gelb (linksbuendig st feld)))
[gelb "alt", gelb "Neu"]
(repeat linksbuendig)
(map (\(pfad, teile) -> [pfad, concat (intersperse (hell "/") teile)]) umbl)
putStr (unlines tab)
else do zs <- zeitstempel
outm "-03-" --XX
let log = unsplit_parts ["/home/v/log", zs ++ " tieflegen"]
h <- openFile log AppendMode
cwd <- getCurrentDirectory
hPutStrLn h ("Arbeitsverzeichnis: " ++ quote cwd ++ "\n")
outm "-04-" --XX
Main.ausfuehren
zerleger
verschieben
(\pfad verzteile neudn -> do
-- die neuen Verzeichnisse anlegen
mapM_ (\verz -> (mkdir (unslice_path verz))
`catch` (\ioe -> if isAlreadyExistsError ioe then return () else ioError ioe)
)
(tail (inits verzteile))
-- die Datei verschieben
let zieldn = if verschieben then unslice_path (verzteile ++ [filename_part pfad])
else unslice_path (verzteile ++ [neudn])
ex <- do ex <- path_exists zieldn
if ex then do rp_zieldn <- realpath zieldn
rp_pfad <- realpath pfad
return (rp_zieldn /= rp_pfad)
else return False
if ex && (not umbenennen)
then errm (quote zieldn ++ " gibt es schon.")
else do pfad_echt <- realpath' pfad
zieldn_echt <- realpath' zieldn
when (pfad_echt /= zieldn_echt) $ do
zieldn' <- verschmelzen_n Nothing ebenen umbenennen pfad zieldn
when (pfad /= zieldn') $ do
hPutStrLn h (" " ++ quote pfad ++ "\n-> " ++ quote zieldn' ++ "\n")
hFlush h
)
pfade
outm "-05-" --XX
hClose h
return ()
-- Pfad zerlegen und die Bestandteile des neuen Pfades bestimmen.
-- Dateinameanteil eines Pfades in Scheiben schneiden. Der ganze Verzeichnisteil kommt zusätzlich zur ersten Scheibe. Wenn flach, dann
-- kommt der erste Dateinamensteil zum Verzeichnisteil. Der Rest wird mit Trennern zusammengeklebt. Wenn nach Trenner getrennt wurde, kommt wieder das
-- gleiche dabei heraus. Wenn nicht (sondern mit reg. Ausdr.), dann etwas anderes. I.d.R. wird bei flach ein reg. Ausdr. aber auch nur zwei Teile
-- auszeichnen, dann spielt das keine Rolle.
pfad_zerlegen :: Zerleger
-> String -- Trenner
-> Int -- So viele Ebenen tief ausrollen
-> Bool -- Ob Dateien verschieben, d.h. Dateiname nicht antasten
-> String -- Pfad
-> ( String -- Verzeichnis
, [String] -- neue Verzeichnisse
, String -- neuer Dateiname (das ist wieder der alte bei --verschieben)
)
pfad_zerlegen zerleger trenner tiefe verschieben pfad =
let (verz, dn) =
split_path pfad
(verzteile, dnteil) =
if verschieben
then (zerleger verschieben dn, dn)
else case zerleger verschieben dn of
[] -> ([], dn)
teile -> letzten_ab teile
verzteile_ausrollen = take tiefe verzteile
verzteile_behalten = drop tiefe verzteile
in ( verz
, if spalten && not (null verzteile_ausrollen)
then [concat (intersperse trenner verzteile_ausrollen)]
else verzteile_ausrollen
, concat (intersperse trenner (verzteile_behalten ++ [dnteil]))
)
-- Pfade zerlegen, d.h. Bestandteile der Dateinamen erkennen, und etwas damit machen.
ausfuehren :: Zerleger
-> Bool -- ob Dateien nur verschieben (und nicht umbenennen)
-> ( String -- Pfad
-> [String] -- erkannte Verzeichnisteile
-> String -- erkannter Dateinameteil
-> IO a -- Ergebnis wird durchgereicht an Aufrufer. Kann Weiter werfen, um nichts zurückzugeben.
)
-> [String] -- Pfade
-> IO [a]
ausfuehren zerleger verschieben aktion pfade = do
erg <-
foldM (\erg pfad ->
do let (verz, verzteile, dnteil) = pfad_zerlegen zerleger trenner tiefe verschieben pfad
when (any null (dnteil : verzteile)) $ do
errm $ "Zerlegung liefert leeren Teil. Übersprungen.\n\
\ Dateiname: " ++ quote (filename_part pfad) ++ "\n\
\ Zerlegung: " ++ show verzteile ++ " - " ++ show dnteil
throw Weiter
e_logm ("Zerlegung von " ++ quote pfad ++ " : " ++ show verzteile ++ ", " ++ quote dnteil)
erg1 <- aktion pfad verzteile dnteil
return (erg1 : erg)
`catch` (\Weiter -> return erg)
)
[]
pfade
return (reverse erg)
------------------------------------------------------------------------------------------------------------------------------------------------------
-- Die Zerleger
--
-- Werden auf den Dateiname, ohne Verzeichnisteil, mit Erweiterung, angewendet. Liefern alle vom Benutzer gemeinten Teile. Das sind die direkt
-- angegebenen, bzw. je nachdem ob --verschieben gewählt ist. Sie werden von pfad_zerlegen angewendet.
--
-- Die gemeinten Teile sind bei Verschieben die neuen Oberverzeichnisse, ohne Verschieben die neuen Verzeichnisse und der neue Dateiname.
type Zerleger = Bool -- ob die Datei nur verschoben werden soll
-> String -- Dateiname (ohne Pfad)
-> [String] -- gefundene Teile
-- Text anhand Trenner in Scheiben schneiden.
-- Liefert bei --verschieben alle Teile außer dem letzten, sonst alle.
trenner_zerleger :: String -> Zerleger
trenner_zerleger trenner verschieben txt =
if verschieben then fst (letzten_ab zerlegung)
else zerlegung
where
trenner_zerleger' trenner txt =
case teiltext trenner txt of
Just (davor, danach) -> davor : trenner_zerleger' trenner danach
Nothing -> [txt]
zerlegung = trenner_zerleger' trenner txt
-- Zerleger aus fertig übersetztem regulärem Ausdruck.
regex_zerleger :: Regex -> Zerleger
regex_zerleger re verschieben txt =
case matchRegex re txt of
Just teile -> case teile of
[] -> [txt]
t -> t
Nothing -> []
-- Zerleger aus regulärem Ausdruck, der als String gegeben ist.
regex_zerleger_t :: String -- Reg. Ausdr.
-> Bool -- ob Großkleinschreibung beachten
-> Zerleger
regex_zerleger_t regex beachten =
regex_zerleger (mkRegexWithOpts regex False beachten)
------------------------------------------------------------------------------------------------------------------------------------------------------
-- Allgemeines
-- Letztes Element abtrennen
letzten_ab :: [a] -> ([a], a)
letzten_ab l =
let (z:ys) = reverse l
in (reverse ys, z)