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?
now month>> [ 1 - ] [ ] bi between? ;
: matches-month?
{ [ 1 12 between? ] [ ~month? ] } 1&& ;
: day-check
dip subseq string>number 1 31 between? ;
: month-check
dip subseq string>number matches-month? ;
: dmy?
{ [ [ 0 2 ] day-check ]
[ [ 2 4 ] month-check ] } 1&& ;
: mdy?
{ [ [ 2 4 ] day-check ]
[ [ 0 2 ] month-check ] } 1&& ;
: determine-format
{
{ [ dmy? ] [ dmy ] }
{ [ mdy? ] [ mdy ] }
[ f ]
} cond ;
: get-dmy
8 head
[ [ 0 2 ] dip subseq ]
[ [ 2 4 ] dip subseq ]
[ [ 4 8 ] dip subseq ] tri ;
: (dmy>ymd)
rot swapd 3append ;
: dmy>ymd
[ get-dmy (dmy>ymd) ]
[ 8 tail ] bi append ;
: mdy>ymd
[ get-dmy swapd (dmy>ymd) ]
[ 8 tail ] bi append ;
: rename-file
[ dup peek CHAR: / = [ "/" append ] unless ] 2dip
[ [ append ] curry ] bi@ bi move-file ;
: (fix-date)
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
dup [ 4 7 ] dip subseq "200" = [ (fix-date) ] [ 2drop ] if ;
: backslash>slash
[ dup CHAR: \ = [ drop CHAR: / ] [ ] if ] map ;
: old-date>new-date
backslash>slash [ CHAR: / = ] trim-tail
dup directory-files [ fix-if-needed ] with each ;
New Annotation