Paste: just a quick "hack" to help with renaming files (maybe useful to you too)
Author: | randy7 |
Mode: | factor |
Date: | Sat, 11 Apr 2009 11:28:57 |
Plain Text |
USING: accessors calendar combinators combinators.short-circuit
io.directories kernel math math.order math.parser sequences ;
IN: quick-date-rename
SYMBOLS: dmy mdy ;
: ~month? ( int -- ? )
now month>> [ 1 - ] [ ] bi between? ;
: matches-month? ( int -- ? )
{ [ 1 12 between? ] [ ~month? ] } 1&& ;
: day-check ( file-str quot1 -- ? )
dip subseq string>number 1 31 between? ;
: month-check ( file-str quot1 -- ? )
dip subseq string>number matches-month? ;
: dmy? ( file-str -- ? )
{ [ [ 0 2 ] day-check ]
[ [ 2 4 ] month-check ] } 1&& ;
: mdy? ( file-str -- ? )
{ [ [ 2 4 ] day-check ]
[ [ 0 2 ] month-check ] } 1&& ;
: determine-format ( file -- symbol/f )
{
{ [ dmy? ] [ dmy ] }
{ [ mdy? ] [ mdy ] }
[ f ]
} cond ;
: get-dmy ( str -- d/m m/d y )
8 head
[ [ 0 2 ] dip subseq ]
[ [ 2 4 ] dip subseq ]
[ [ 4 8 ] dip subseq ] tri ;
: (dmy>ymd) ( d m y -- ymd )
rot swapd 3append ;
: dmy>ymd ( str -- str )
[ get-dmy (dmy>ymd) ]
[ 8 tail ] bi append ;
: mdy>ymd ( str -- str )
[ get-dmy swapd (dmy>ymd) ]
[ 8 tail ] bi append ;
: rename-file ( dir filename-from filename-to -- )
[ dup peek CHAR: / = [ "/" append ] unless ] 2dip
[ [ append ] curry ] bi@ bi move-file ;
: (fix-date) ( dir file -- )
dup dup determine-format
{
{ dmy [ dmy>ymd rename-file ] }
{ mdy [ mdy>ymd rename-file ] }
[ "filename does not match expected format" throw ]
} case ;
: fix-if-needed ( dir filename -- )
dup [ 4 7 ] dip subseq "200" = [ (fix-date) ] [ 2drop ] if ;
: backslash>slash ( str -- str )
[ dup CHAR: \ = [ drop CHAR: / ] [ ] if ] map ;
: old-date>new-date ( dir -- )
backslash>slash [ CHAR: / = ] trim-tail
dup directory-files [ fix-if-needed ] with each ;
New Annotation