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

! assuming zero padded day/month and full year.

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 ;

! : fix-if-needed ( dir filename -- )
!    dup [ 4 7 ] dip subseq string>number 200 201 between? [ (fix-date) ] [ 2drop ] if ;
  
: backslash>slash ( str -- str ) ! win style to unix style path
    [ dup CHAR: \ = [ drop CHAR: / ] [ ] if ] map ;  
  
: old-date>new-date ( dir -- )
    backslash>slash [ CHAR: / = ] trim-tail
    dup directory-files [ fix-if-needed ] with each ;


! cleanups are welcome 

New Annotation

Summary:
Author:
Mode:
Body: