ExtremeFitness Forums: MediaQueue Thread

For people who are extra nervous about installing binaries off the 'net, here's a script version using Tcl. Cut and paste lists of URLs into the prompt when it asks for them, end with a ".", then go do something for a while.

Tested on Windows 2000 with Tcl 8.3. Feel free to adapt to Perl, Python, Java, whatever... Tcl binaries and/or source available for download off the net. Requires Tcl8.3 or above, and the HTTP package (included in most Tcl distros).
Not a user-friendly program, just a utility to fill a gap.

Enjoy...

-B

--- everything below this line is the script ---
#!/bin/sh
# -*- tcl -*-
# The next line is executed by /bin/sh, but not tcl \
exec tclsh "$0" ${1+"$@"}

# Simple Downloader which uses MediaQueue short-form
# syntax for URLs.
#
# Example syntax:
# http://foo.bar/path/image[<first>,<last>,?opt dir?].jpg
#
# Example use:
# ./mediaqueue.tcl
# Base directory? ($basedir)"
# d:/foobar
# Paste URL(s), last line must be '.':"
# http://foo.com/stuff/[01,100,stuff].jpg
# .
# ... lots of download status crap here...

# Clear any previous errors
catch "unset set_errors" err

# Prompt for the base directory
# - create it if it doesn't exist
set basedir "c:/mediaqueue"
puts "Base directory? ($basedir)"
set tmpdir [string trim [gets stdin]]
if {[string length $tmpdir] > 2} {set basedir $tmpdir}
if {![file isdirectory $basedir]} {
file mkdir $basedir
}

# Ask user for the URL syntax
# - "." on a line by itself tells code all done with URL entry
puts "Paste URL(s), last line must be '.':"
set url_list ""
set n 0
while {$n<3000} {
incr n
gets stdin row
puts $row
if { [string equal $row "."] } { break };
append url_list $row "\n"
}

# Load Tcl HTTP package to do connection stuff
package require http
catch {namespace import http::*} err

# Basic routines
proc http_copy { url file {chunk 4096} } {
set out [open $file w+]
##
# This is the call that does all the work with the unaliased URL
##
set token [geturl $url -channel $out -progress http_Progress \
-blocksize $chunk]
##
close $out
puts stderr ""
upvar #0 $token state
set max 0
foreach {name value} $state(meta) {
if {[string length $name] > $max} {
set max [string length $name]
}
if {[regexp -nocase ^location$ $name]} {
puts "Bypassing location redirect for $file, removing tmp file"
file delete $file
return ""
}
}
incr max
foreach {name value} $state(meta) {
puts [format "%-*s %s" $max $name: $value]
}

return $token
}
proc http_Progress {args} {
puts -nonewline stderr . ; flush stderr
}

# Process the urls from mediaqueue syntax to standard URLs
foreach url [split $url_list \n] {
set optdir ""
set prefix ""
### this regexp sucks, but hey, it works.
if {![regexp {(.+\/)(.*?)\[(.+)\](.+)} $url x path prefix range_data ext]} {
puts "Error: URL $url doesn't match expected pattern"
puts "Format expected:"
puts { <base url><opt prefix>[<start>,<end>,<opt dir>]<opt postfix>.<ext>] }
continue
}

# Cheat and split off optdir if present
foreach {start end optdir} [split $range_data ","] {}

# Create image format string
set zeros [string length $start]
set fmtstring "%0${zeros}i"

# Optional directory provided?
if {$optdir != ""} {
set localdir [file join $basedir $optdir]
} else {
set localdir "[file join $basedir [file tail $path]]"
}

if {![file exists $localdir]} {file mkdir $localdir}
puts "Starting download, base url $path + incr + .$ext"
puts "starting with $start, going to $end"

# Loop through images
set status 1
set current [string trimleft $start 0]
set end [string trimleft $end 0]
while {$status} {
set img "$prefix[format $fmtstring $current]$ext"
set url "$path$img"
set local [file join $localdir $img]
puts "Copying $url to $local"
if {[http_copy $url $local] == "error"} {
puts "Got copy error, skipping set remainder.."
lappend set_errors "$url"
break
}
incr current
set status [expr $current <= $end]
}

puts "Url $url done, last was $current"
}

if {[info exists set_errors]} {
puts "following errors happened:"
foreach item $set_errors {
puts "$item"
}
}