Merge branch 'master' of git://factorcode.org/git/factor

db4
Slava Pestov 2009-03-28 22:14:27 -05:00
commit 2344660811
6 changed files with 177 additions and 65 deletions

View File

@ -65,9 +65,9 @@ ERROR: file-not-found ;
_ [ _ _ find-file [ file-not-found ] unless* ] attempt-all
] [
drop f
] recover ;
] recover ; inline
: find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
'[ _ _ find-all-files ] map concat ;
'[ _ _ find-all-files ] map concat ; inline
os windows? [ "io.directories.search.windows" require ] when

View File

@ -0,0 +1,21 @@
! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test tools.scaffold unicode.case kernel
multiline tools.scaffold.private io.streams.string ;
IN: tools.scaffold.tests
: undocumented-word ( obj1 obj2 -- obj3 obj4 )
[ >lower ] [ >upper ] bi* ;
[
<" HELP: undocumented-word
{ $values
{ "obj1" object } { "obj2" object }
{ "obj3" object } { "obj4" object }
}
{ $description "" } ;
">
]
[
[ \ undocumented-word (help.) ] with-string-writer
] unit-test

View File

@ -134,7 +134,7 @@ ERROR: no-vocab vocab ;
vocabulary>> using get [ conjoin ] [ drop ] if* ;
: ($values.) ( array -- )
[
[ bl ] [
"{ " write
dup array? [ first ] when
dup lookup-type [
@ -145,7 +145,7 @@ ERROR: no-vocab vocab ;
null add-using
] if
" }" write
] each ;
] interleave ;
: 4bl ( -- )
" " write ; inline

View File

@ -1,23 +1,113 @@
! Copyright (C) 2008 Tim Wawrzynczak
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax sequences kernel accessors ;
USING: help.markup help.syntax sequences kernel accessors
id3.private strings ;
IN: id3
HELP: file-id3-tags
HELP: mp3>id3
{ $values
{ "path" "a path string" }
{ "id3v2-info/f" "a tuple storing ID3v2 metadata or f" } }
{ $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Currently, the parser supports the following tags: "
$nl { $link title>> }
$nl { $link artist>> }
$nl { $link album>> }
$nl { $link year>> }
$nl { $link genre>> }
$nl { $link comment>> } } ;
{ $description "Return a tuple containing the ID3 information parsed out of the MP3 file, or " { $link f } " if no metadata is present. Words to access the ID3v1 information are here:"
{ $list
{ $link title }
{ $link artist }
{ $link album }
{ $link year }
{ $link genre }
{ $link comment }
}
"For other fields, use the " { $link find-id3-frame } " word."
} ;
HELP: album
{ $values
{ "id3" id3v2-info }
{ "album/f" "string or f" }
}
{ $description "Returns the album, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: artist
{ $values
{ "id3" id3v2-info }
{ "artist/f" "string or f" }
}
{ $description "Returns the artist, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: comment
{ $values
{ "id3" id3v2-info }
{ "comment/f" "string or f" }
}
{ $description "Returns the comment, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: genre
{ $values
{ "id3" id3v2-info }
{ "genre/f" "string or f" }
}
{ $description "Returns the genre, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: title
{ $values
{ "id3" id3v2-info }
{ "title/f" "string or f" }
}
{ $description "Returns the title, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: year
{ $values
{ "id3" id3v2-info }
{ "year/f" "string or f" }
}
{ $description "Returns the year, or " { $link f } " if this field is missing, from a parsed id3 tag." } ;
HELP: find-id3-frame
{ $values
{ "id3" id3v2-info } { "name" string }
{ "obj/f" "object or f" }
}
{ $description "Returns the " { $slot "data" } " slot of the ID3 frame with the given name, or " { $link f } "." } ;
HELP: mp3-paths>id3s
{ $values
{ "seq" sequence }
{ "seq'" sequence }
}
{ $description "From a sequence of pathnames, parses each ID3 header and returns a sequence of key/value pairs of pathnames and ID3 objects." } ;
HELP: find-mp3s
{ $values
{ "path" "a pathname string" }
{ "seq" sequence }
}
{ $description "Returns a sequence of MP3 pathnames from a directory and all of its subdirectories." } ;
HELP: parse-mp3-directory
{ $values
{ "path" "a pathname string" }
{ "seq" sequence }
}
{ $description "Returns a sequence of key/value pairs where the key is the path of an MP3 and the value is the parsed ID3 header or " { $link f } " recursively for each MP3 file in the directory and all subdirectories." } ;
ARTICLE: "id3" "ID3 tags"
"The " { $vocab-link "id3" } " vocabulary contains words for parsing " { $emphasis "ID3" } " tags, which are textual fields storing an MP3's title, artist, and other metadata." $nl
"Parsing ID3 tags from an MP3 file:"
{ $subsection file-id3-tags } ;
"Parsing ID3 tags for a directory of MP3s, recursively:"
{ $subsection parse-mp3-directory }
"Finding MP3 files recursively:"
{ $subsection find-mp3s }
"Parsing a sequence of MP3 pathnames:"
{ $subsection mp3-paths>id3s }
"Parsing an MP3 file's ID3 tags:"
{ $subsection mp3>id3 }
"ID3v1 frame tag accessors:"
{ $subsection album }
{ $subsection artist }
{ $subsection comment }
{ $subsection genre }
{ $subsection title }
{ $subsection year }
"Access any frame tag:"
{ $subsection find-id3-frame } ;
ABOUT: "id3"

View File

@ -5,12 +5,12 @@ IN: id3.tests
: id3-params ( id3 -- title artist album year comment genre )
{
[ id3-title ]
[ id3-artist ]
[ id3-album ]
[ id3-year ]
[ id3-comment ]
[ id3-genre ]
[ title ]
[ artist ]
[ album ]
[ year ]
[ comment ]
[ genre ]
} cleave ;
[
@ -20,7 +20,7 @@ IN: id3.tests
"2009"
"COMMENT"
"Bluegrass"
] [ "vocab:id3/tests/blah.mp3" file-id3-tags id3-params ] unit-test
] [ "vocab:id3/tests/blah.mp3" mp3>id3 id3-params ] unit-test
[
"Anthem of the Trinity"
@ -29,7 +29,7 @@ IN: id3.tests
f
f
"Classical"
] [ "vocab:id3/tests/blah2.mp3" file-id3-tags id3-params ] unit-test
] [ "vocab:id3/tests/blah2.mp3" mp3>id3 id3-params ] unit-test
[
"Stormy Weather"
@ -38,5 +38,5 @@ IN: id3.tests
f
"eng, AG# 08E1C12E"
"Big Band"
] [ "vocab:id3/tests/blah3.mp3" file-id3-tags id3-params ] unit-test
] [ "vocab:id3/tests/blah3.mp3" mp3>id3 id3-params ] unit-test

View File

@ -48,15 +48,14 @@ TUPLE: id3v2-info header frames ;
TUPLE: id3v1-info title artist album year comment genre ;
: <id3v1-info> ( -- object ) id3v1-info new ;
: <id3v1-info> ( -- object ) id3v1-info new ; inline
: <id3v2-info> ( header frames -- object )
[ [ frame-id>> ] keep ] H{ } map>assoc
id3v2-info boa ;
[ [ frame-id>> ] keep ] H{ } map>assoc id3v2-info boa ;
: <header> ( -- object ) header new ;
: <header> ( -- object ) header new ; inline
: <frame> ( -- object ) frame new ;
: <frame> ( -- object ) frame new ; inline
: id3v2? ( mmap -- ? ) "ID3" head? ; inline
@ -66,7 +65,7 @@ TUPLE: id3v1-info title artist album year comment genre ;
: id3v1-frame ( string key -- frame )
<frame>
swap >>frame-id
swap >>data ;
swap >>data ; inline
: id3v1>id3v2 ( id3v1 -- id3v2 )
[
@ -78,7 +77,7 @@ TUPLE: id3v1-info title artist album year comment genre ;
[ comment>> "COMM" id3v1-frame ]
[ genre>> "TCON" id3v1-frame ]
} cleave
] output>array f swap <id3v2-info> ;
] output>array f swap <id3v2-info> ; inline
: >28bitword ( seq -- int )
0 [ [ 7 shift ] dip bitor ] reduce ; inline
@ -104,11 +103,11 @@ TUPLE: id3v1-info title artist album year comment genre ;
[ [ 4 8 ] dip subseq >28bitword >>size ]
[ [ 8 10 ] dip subseq >byte-array >>flags ]
[ read-frame-data decode-text >>data ]
} cleave ;
} cleave ; inline
: read-frame ( mmap -- frame/f )
dup 4 head-slice valid-frame-id?
[ (read-frame) ] [ drop f ] if ;
[ (read-frame) ] [ drop f ] if ; inline
: remove-frame ( mmap frame -- mmap )
size>> 10 + tail-slice ; inline
@ -116,10 +115,8 @@ TUPLE: id3v1-info title artist album year comment genre ;
: read-frames ( mmap -- frames )
[ dup read-frame dup ]
[ [ remove-frame ] keep ]
produce 2nip ;
produce 2nip ; inline
! header stuff
: read-v2-header ( seq -- id3header )
[ <header> ] dip
{
@ -133,8 +130,6 @@ TUPLE: id3v1-info title artist album year comment genre ;
[ read-v2-header ]
[ read-frames ] bi* <id3v2-info> ; inline
! v1 information
: skip-to-v1-data ( seq -- seq ) 125 tail-slice* ; inline
: (read-v1-tag-data) ( seq -- mp3-file )
@ -159,28 +154,7 @@ TUPLE: id3v1-info title artist album year comment genre ;
drop
] if ; inline
PRIVATE>
: frame-named ( id3 name quot -- obj )
[ swap frames>> at* ] dip
[ data>> ] prepose [ drop f ] if ; inline
: id3-title ( id3 -- title/f ) "TIT2" [ ] frame-named ; inline
: id3-artist ( id3 -- artist/f ) "TPE1" [ ] frame-named ; inline
: id3-album ( id3 -- album/f ) "TALB" [ ] frame-named ; inline
: id3-year ( id3 -- year/f ) "TYER" [ ] frame-named ; inline
: id3-comment ( id3 -- comment/f ) "COMM" [ ] frame-named ; inline
: id3-genre ( id3 -- genre/f )
"TCON" [ parse-genre ] frame-named ; inline
: id3-frame ( id3 key -- value/f ) [ ] frame-named ; inline
: (file-id3-tags) ( path -- id3v2-info/f )
: (mp3>id3) ( path -- id3v2-info/f )
[
{
{ [ dup id3v2? ] [ read-v2-tag-data ] }
@ -189,9 +163,36 @@ PRIVATE>
} cond
] with-mapped-uchar-file ;
: file-id3-tags ( path -- id3v2-info/f )
dup file-info size>> 0 <= [ drop f ] [ (file-id3-tags) ] if ;
: (find-id3-frame) ( id3 name quot: ( obj -- obj' ) -- obj' )
[ swap frames>> at* ] dip
[ data>> ] prepose [ drop f ] if ; inline
: parse-id3s ( path -- seq )
[ >lower ".mp3" tail? ] find-all-files
[ dup file-id3-tags ] { } map>assoc ;
PRIVATE>
: mp3>id3 ( path -- id3v2-info/f )
dup file-info size>> 0 <= [ drop f ] [ (mp3>id3) ] if ; inline
: find-id3-frame ( id3 name -- obj/f )
[ ] (find-id3-frame) ; inline
: title ( id3 -- title/f ) "TIT2" find-id3-frame ; inline
: artist ( id3 -- artist/f ) "TPE1" find-id3-frame ; inline
: album ( id3 -- album/f ) "TALB" find-id3-frame ; inline
: year ( id3 -- year/f ) "TYER" find-id3-frame ; inline
: comment ( id3 -- comment/f ) "COMM" find-id3-frame ; inline
: genre ( id3 -- genre/f )
"TCON" [ parse-genre ] (find-id3-frame) ; inline
: find-mp3s ( path -- seq )
[ >lower ".mp3" tail? ] find-all-files ; inline
: mp3-paths>id3s ( seq -- seq' )
[ dup mp3>id3 ] { } map>assoc ; inline
: parse-mp3-directory ( path -- seq )
find-mp3s mp3-paths>id3s ;