#!tclsh
set posturl {http://www.flickr.com/tools/uploader_go.gne}
package require dom
package require http
package require base64
proc getFileInfo {fname} {
set xmlfile "${fname}.xml"
set tagList {}
if {![file exists $fname]} {
return ""
}
set fd [open $xmlfile r]
set xml [read $fd]
close $fd
set tree [dom::parse $xml]
set titleNode [dom::selectNode $tree \
{/image/description/field[@name='title']}]
set title [string trim [dom::node stringValue $titleNode]]
set descripNode [dom::selectNode $tree \
{/image/description/field[@name='description']}]
set description [string trim [dom::node stringValue $descripNode]]
set locationNode [dom::selectNode $tree \
{/image/description/field[@name='location']}]
if {$locationNode != ""} {
set location [string trim [dom::node stringValue $locationNode]]
if {$location != ""} {
lappend tagList "\"$location\""
}
}
set yearNode [dom::selectNode $tree \
{/image/description/field[@name='year']}]
if {$yearNode != ""} {
set year [string trim [dom::node stringValue $yearNode]]
if {$year != ""} {
lappend tagList "\"$year\""
}
}
set countryNode [dom::selectNode $tree \
{/image/description/field[@name='country']}]
if {$countryNode != ""} {
set country [string trim [dom::node stringValue $countryNode]]
if {$country != ""} {
lappend tagList "\"$country\""
}
}
dom::destroy $tree
return [list $title $description $tagList]
}
proc postImage {email password file info} {
global posturl
set fd [open "${file}" r]
fconfigure $fd -translation binary
set photo [read $fd]
close $fd
set title [lindex $info 0]
set description [lindex $info 1]
set tags ""
foreach tag [lindex $info 2] {
append tags "$tag "
}
set tags [string trim $tags]
set outputData {}
set bound "-----NEXT_PART_[clock seconds].[pid]"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"email\"\n\n$email\n"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"password\"\n\n$password\n"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"title\"\n\n$title\n"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"description\"\n\n$description\n"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"tags\"\n\n$tags\n"
append outputData "--$bound\nContent-Disposition: form-data;\
name=\"photo\"; filename=\"[file tail $file]\"\n\n$photo\n"
set token [http::geturl $posturl -type "multipart/form-data; boundary=$bound" \
-query $outputData]
set body [http::data $token]
http::cleanup $token
set tree [dom::parse $body]
set statusNode [dom::selectNode $tree \
{/uploader/status}]
if {$statusNode != ""} {
set status [string trim [dom::node stringValue $statusNode]]
}
set photoidNode [dom::selectNode $tree \
{/uploader/photoid}]
if {$photoidNode != ""} {
set photoid [string trim [dom::node stringValue $photoidNode]]
}
return [list $status $photoid]
}
proc processDir {dir} {
global email password
if {![file isdirectory $dir]} {
error "$dir does not exist or is not a directory"
}
set fileList [glob -nocomplain [file join $dir *.jpg]]
foreach file $fileList {
puts -nonewline "processing $file ... "
flush stdout
set finfo [getFileInfo $file]
set statusList [postImage $email $password $file $finfo]
if {[lindex $statusList 0] != "ok"} {
puts "error: [lindex $statusList 0] [lindex $statusList 1]"
} else {
puts "done"
}
}
}
set email "you@domain.com" ; # Your email to login to flickr
set password "secret" ; # Your flickr password
set dirlist { images/dir1 images/dir2 } ; # Directories that you want to process
foreach dir $dirlist {
processDir $dir
}Category Internet - Category XML