TJMThe following Tcl code can be used to automate the uploading of files to
Flickr [
1]. You will need to have
tcllib installed to use this.
I already had a web site that had lots of photos in a gallery. To manage this, I used bins [
2]. One of the nice things about bins is that it keeps all of the information about images (title, location, comments, etc.) in XML files. This allows me to provide the same information to Flickr when uploading files without any manual labor.
#!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 "[email protected]" ; # 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
}