#!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
}