Uploading files to Flickr

TJM

The 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 "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