1.71.5.204-B20160823
I love my Amiga <hug> Everything is so easy on it.
I finished off everything I mentioned in my last message. These three scripts (when launched from a cron, poll script, whatever) will:
1. Grab and store webcam images (some minor changes to script fragment I posted earlier).
2. Generate HTML indexes for them.
3. Upload the lot (using DOpus5 FTP) to a website - it only uploads new images, skipping existing ones, but currently re-uploads all the HTML (the HTML
files are tiny; this isn't a problem).
The third party tools used are:
1. HTTPresume (any HTTP get command could be used)
2. rexxtricks.library
3. DOpus 5 Magellan 2 (only for FTP uploads)
4. Some Miami specific command are used in the webcams.rexx script. Easily changable for Genesis or something, I'd imagine.
The most time consuming part of writing these scripts was in learning the DOpus
ARexx port. I've never used it before, and have decided it's beautiful.
If you have a webcam somewhere you want to archive for yourself, feel free to use these scripts. All I ask is recognition of my work :)
If you *do* use these for something, make sure you change all the references. The paths/websites/text/etc. are all hardcoded. I'm sure you don't want two dull cams from Bangor, for example, and anyway, I now have an archive of them available :)
To see all this in action, visit the "Webcam Archives" link near the bottom of the page on
http://www.tkgbbs.freeserve.co.uk/. It's updated every day at 3am BST / 2am GMT.
-[ webcams.rexx ]--------------------------------------
/* Grab webcams
*/
options results
failat 21
call addlib("rexxsupport.library",0,-30,0)
address 'MIAMI.1'
if exists( 'ENV:CAMSACTIVE' ) then do
say '* Cam mirroring already running! Exiting'
exit
end
address command 'echo >ENV:CAMSACTIVE 1'
isonline 'ppp0'
onl = RC
do while onl
/* Webcams: grab, date, store. */
address command "delete quiet work:graphics/pics/Cams/Ffridd/road.tmp work:graphics/pics/Cams/Ffridd/bar.tmp"
address command "Work:comms/HTTPResume/HTTPResume
http://www.welcomebangor.co.uk/webcam/webcam.jpg work:graphics/pics/Cams/Ffridd/road.tmp attempts 1"
address command "Work:comms/HTTPResume/HTTPResume
http://www.welcomebangor.co.uk/webcam/webcam2.jpg work:graphics/pics/Cams/Ffridd/bar.tmp attempts 1"
barsize = word( statef('work:graphics/pics/Cams/Ffridd/bar.tmp'), 2 )
roadsize = word( statef('work:graphics/pics/Cams/Ffridd/road.tmp'), 2 )
/* First, store Bar image
*/
ft = 'Bar.'|| date(S)
fn = 'Bar.'|| date(S) ||'.000'
n=1
newpic=1
do while exists( 'Work:Graphics/Pics/Cams/Ffridd/'||fn||'.jpg' )
if word( statef( 'Work:Graphics/Pics/Cams/Ffridd/'||fn||'.jpg' ), 2 ) = barsize then do
newpic=0
say '* Duplicate picture'
break
end
fn = ft || '.' || right( n, 3, '0' )
n=n+1
end
if newpic = 1 then do
address command 'Copy work:graphics/pics/Cams/Ffridd/bar.tmp to Work:Graphics/Pics/Cams/Ffridd/'|| fn ||'.jpg CLONE'
end
/* Next, store Road image
*/
ft = 'Road.'|| date(S)
fn = 'Road.'|| date(S) ||'.000'
n=1
newpic=1
do while exists( 'Work:Graphics/Pics/Cams/Ffridd/'||fn||'.jpg' )
if word( statef( 'Work:Graphics/Pics/Cams/Ffridd/'||fn||'.jpg' ), 2 ) = roadsize then do
newpic=0
say '* Duplicate picture'
break
end
fn = ft || '.' || right( n, 3, '0' )
n=n+1
end
if newpic = 1 then do
address command 'Copy work:graphics/pics/Cams/Ffridd/road.tmp to Work:Graphics/Pics/Cams/Ffridd/'|| fn ||'.jpg CLONE'
end
address command "delete quiet work:graphics/pics/Cams/Ffridd/road.tmp work:graphics/pics/Cams/Ffridd/bar.tmp"
delay( 5*60*60 ) /* Five minute delay */
isonline 'ppp0'
onl = rc
end /* do while online */
say 'No Internet connection on PPP0 - stopping webcam archiving'
address command 'delete >ENV:CAMSACTIVE quiet'
-[ END ]--------------------------------------
-[ genpixdb.rexx ]--------------------------------------
/* "Generate Pictures Database" in HTML
* Neil Williams
*
neil@zeusdev.co.uk or
neil@tkgbbs.freeserve.co.uk
* Also 2:442/107 @ FidoNet
*
* arg pics is the path to the pictures, also where
* we store the HTML.
* e.g. genpixdb.rexx work:webpage/campics/
* ENSURE THE PATH ENDS WITH : OR /
*
* Pictures in format "name.YYYYMMDD.XXX.JPG"
* where X is a number for each picture in a day.
* 000<=X<=999
*/
parse arg pics
options cache
options failat 99
options results
call addlib("rexxsupport.library",0,-30,0)
if( ~show( 'l', "rexxtricks.library" ) ) then do
if( ~addlib( "rexxtricks.library", 0, -30, 0 ) ) then do
say "Could not open rexxtricks.library"
exit 10
end
end
Main:
idx = pics || 'index.html'
imagecount = getdir( pics, '#?.????????.???.jpg', 'IMAGESRAW', 'FILES', 'NAME' )
if imagecount>0 then do
QSORT( 'IMAGESRAW', 'IMAGES', 'NOCASE' )
drop imagesraw.
drop imagedb.
imagedb.0 = 0
/* Generate a database of images in stem IMAGEDB.
* where imagedb.0 is the number of entries,
* imagedb.<n> is a base name of "Image Label.YYYYMM.<week of month number>
* Under imagedb.<n>, .0 is the number of entries and each entry is a
* file name of a picture matching the base description of imagedb.<n>.
*/
do i=1 to images.0
parse var images.i iname '.' idate '.' inum
week = findweek( right(idate, 2) )
base = iname || '.' || left( idate, 6 ) || '.' || week
found = 0
if imagedb.0 > 0 then do
do j = 1 to imagedb.0
if imagedb.j = base then do
found = 1
imagedb.j.0 = imagedb.j.0+1
k = imagedb.j.0
imagedb.j.k = images.i
end
end
end
if ~found then do
imagedb.0 = imagedb.0+1
k = imagedb.0
imagedb.k = base
imagedb.k.0 = 1
imagedb.k.1 = images.i
end
end /* do images */
/* This prints a tree of our database.
* Uncomment this and look at the output
* to understand what structure we're
* building!
*
do i = 1 to imagedb.0
say imagedb.i
do j = 1 to imagedb.i.0 by 3
img1 = imagedb.i.j
k=j+1
if imagedb.i.k ~= 'IMAGEDB.'||i||'.'||k then
img2 = imagedb.i.k
else
img2 = ''
k=j+2
if imagedb.i.k ~= 'IMAGEDB.'||i||'.'||k then
img3 = imagedb.i.k
else
img3 = ''
say '- 'img1 img2 img3
end
end
exit */
/* Build HTML.
* Yes, this wastefully recreates all HTML files.
* I haven't yet optimised it.
*/
/* master index file */
if Open( mfh, pics || 'index.html', 'w' ) then do
writeln( mfh, '<html><head><title>Webcam archives at TKG</title></head> <body bgcolor=#ffffff text=#000000>' )
writeln( mfh, '<p><font face="tahoma,sans-serif,helvetica" size=6>The TKG
Webcam Archives</font><br>')
writeln( mfh, '<font face="verdana,arial,sans-serif,helvetica" size=2>Webcams currently archived here are the two on the Ffriddoedd Accommodation Site (University of Wales, Bangor) from <a href="
http://www.welcomebangor.co.uk/">http://www.welcomebangor.co.uk/</a>. These are much more exciting during term time (I hope). The 320x240 pixel images are presented in rows of three, so you''ll need a screen resolution of around 1024 or better to view the pages well.<br>' )
writeln( mfh, 'Each page has pictures from the date specified (7 day periods, day 1-7, 8-14, etc. of each calender month). It goes without saying that these are graphically heavy.</font><br></p>' )
writeln( mfh, '<font face="courier new, courier" size=2>' )
do i = 1 to imagedb.0
parse var imagedb.i iname '.' idate '.' inum
month = findmonth( right(idate,2) )
writeln( mfh, '<a href="'imagedb.i || '.html">'||iname' webcam - '||month||', '|| left(idate,4) ||', week '|| inum ||'</a>. '|| imagedb.i.0 ||' images<br>' )
if Open( fh, pics || imagedb.i || '.html', 'w' ) then do
call makehtmlheader( fh )
writeln( fh, iname' webcam - '||month||', '|| left(idate,4) ||', week '|| inum ||'</a>. '|| imagedb.i.0 ||' images<br><table border=0 cellpadding=0 cellspacing=10 width="100%">' )
/* create table rows of 3 images at a time
*/
do j = 1 to imagedb.i.0 by 3
img1 = imagedb.i.j
k=j+1
if imagedb.i.k ~= 'IMAGEDB.'||i||'.'||k then
img2 = imagedb.i.k
else
img2 = ''
k=j+2
if imagedb.i.k ~= 'IMAGEDB.'||i||'.'||k then
img3 = imagedb.i.k
else
img3 = ''
call makerow( fh, pics, img1, img2, img3 )
end
call makehtmlfooter( fh )
call close( fh )
end
end
writeln( mfh, '</font><br>' )
writeln( mfh, '<font face="verdana,arial,sans-serif,helvetica" size=2>Images processed and HTML indexes generated by ARexx scripts written by nOw2 on 30/8/2001. Extra features and nicer pages Real Soon Now. NB: duplicate images are removed only if downloaded during the same day; no dupe checking is performed between days so if the image stays the same for two or more days, you''ll see two or more identical images here. Copyright of images remains with
welcomebangor.co.uk.' )
writeln( mfh, '<p><a href="../">Home</a>, <a href="mailto:
neil@zeusdev.co.uk">e-mail the archiver</a></p></font></body></html>' )
call close( mfh )
end
else
say 'Error opening master index for writing!'
end /* if any images */
exit
/* Procedures
*/
/*
Originally written (in OS/2 Rexx) by:
Newsgroups comp.lang.rexx
Message-ID <
gunaalzrvfgrelnubbpbz.ga1ygc0.pminews@netnews.worldnet.att.net> Date Sun, 11 Mar 2001 21:31:25 GMT
"Mike Ruskai" <
retsiemynnaht@spammoc.beoohaygone.net>
Remove 'spambegone.net' and reverse to send e-mail.
Determine image dimensions */
getimagesize: procedure
parse arg fname
if open(sfh, fname, 'r') then do
fhead=readch(sfh,10)
notrecog = 0
select
when substr(fhead,7,4)='JFIF' then type='JFIF'
when translate(substr(fhead,7,4))='EXIF' then type='EXIF'
when left(fhead,5)='GIF87' then type='GIF87'
when left(fhead,5)='GIF89' then type='GIF89'
/* faked - jpegs without either header above but
valid size data appear to have this recognition
string. I am not a JPEG expert :) */
when left(fhead,3) = 'ff'x||'d8'x||'ff'x then type='JFIF'
otherwise notrecog = 1
end
width=0
height=0
if ~notrecog then do
select
when type='GIF87' | type='GIF89' then do
width=c2d(reverse(substr(fhead,7,2)))
height=c2d(reverse(substr(fhead,9,2)))
end
when type='JFIF' | type='EXIF' then do
chunk=640
lpos=0
found=0
do i=1 while ~eof(sfh)
data=readch(sfh,chunk)
check=pos('ffc0'x,data)
if check>0 then do
if type='EXIF' then do
if found=0 then do
found=1
iterate i
end
end
lpos=check
ldata=data
leave i
end
end
if lpos>0 then do
parse var ldata =lpos +5 height +2 width +2 .
height=c2d(height)
width=c2d(width)
end
end
otherwise nop
end
end
call close(sfh)
if notrecog then return ''
return ' width='|| width ||' height='|| height
end
else
return ''
/* Start a HTML index */
makehtmlheader: procedure
parse arg fh
writeln( fh, '<html><head><title>Webcam</title></head> <body bgcolor=#ffffff
text=#000000>' )
return
/* End a HTML index */
makehtmlfooter: procedure
parse arg fh
writeln( fh, '</table></body></html>' )
return
/* return basic (non-calender) week number [1..5] of month */
findweek:
parse arg day
select
when day>=1 & day<=7 then return 1
when day>=8 & day<=14 then return 2
when day>=15 & day<=21 then return 3
when day>=22 & day<=28 then return 4
otherwise return 5
end
/* Add a row of images, min one and max three across, to an open
* html file. */
makerow: procedure
parse arg fh, pics, img1, img2, img3
fn = pics || img1
size = getimagesize( fn )
parse var img1 iname '.' idate '.' inum
writech( fh, '<tr><td><img src="'img1'"'size'><br>'|| right(idate,2) ||'/'||
left(right(idate,4),2) ||'/'|| left( idate,4 ) ||' - image '|| left(inum,3) ||'</td>' )
if img2 = '' then
writech( fh, '<td></td>' )
else do
size = getimagesize( pics || img2 )
parse var img2 iname '.' idate '.' inum
writech( fh, '<tr><td><img src="'img2'"'size'><br>'|| right(idate,2) ||'/'|| left(right(idate,4),2) ||'/'|| left( idate,4 ) ||' - image '|| left(inum,3) ||'</td>' )
end
if img3 = '' then
writech( fh, '<td></td>' )
else do
size = getimagesize( pics || img3 )
parse var img3 iname '.' idate '.' inum
writech( fh, '<tr><td><img src="'img3'"'size'><br>'|| right(idate,2) ||'/'|| left(right(idate,4),2) ||'/'|| left( idate,4 ) ||' - image '|| left(inum,3) ||'</td>' )
end
return
/* returns month name from month number */
findmonth: procedure
parse arg month
select
when month = 1 then return 'January'
when month = 2 then return 'February'
when month = 3 then return 'March'
when month = 4 then return 'April'
when month = 5 then return 'May'
when month = 6 then return 'June'
when month = 7 then return 'July'
when month = 8 then return 'August'
when month = 9 then return 'September'
when month = 10 then return 'October'
when month = 11 then return 'November'
when month = 12 then return 'December'
otherwise return 'eek! error'
end
-[ END ]--------------------------------------
-[ webcamupload.rexx ]--------------------------------------
/* web cam archive uploader, uses Directory Opus 5
* as it's got the only FTP client with all the
* features this needs.
*/
options results
options failat 21
address DOPUS.1
signal on break_c
signal on break_d
signal on break_e
signal on break_f
signal on halt
signal on ioerr
signal on syntax
lister new invisible
handle = result
if handle ~= 0 then do
lister wait handle quick
'command wait ftpconnect lister 'handle' host USER:
PASSWORD@UPLOADHOST.COM/PATH'
if result = 1 then do
'lister new invisible inactive 10/10/10/50'
shandle = result
if shandle ~= 0 then do
lister wait shandle quick
'command wait source 'handle' select name #?.html'
'command wait source 'handle' delete quiet'
'lister read 'shandle' "Work:Graphics/Pics/Cams/Ffridd/" force'
'command wait source 'shandle' select name #?.jpg'
'command wait source 'shandle' dest 'handle' copy quiet update'
'command wait source 'shandle' none'
'command wait source 'shandle' select name #?.html'
'command wait source 'shandle' dest 'handle' copy quiet'
lister close shandle
shandle=0
end /* source lister */
end /*ftp connect */
lister close handle
handle=0
end /* dest lister */
exit
break_c:; break_d:; break_e:; break_f:; halt:
signal off break_c
signal off break_d
signal off break_e
signal off break_f
signal off halt
signal off syntax
call QuitScr
ioerr:
signal off ioerr
say 'IO error' rc 'at line' sigl '['errortext(rc)']')
call QuitScr
syntax:
signal off syntax
say 'Syntax-error' rc 'at line' sigl '['errortext(rc)']'
call QuitScr
QuitScr:
if shandler ~= 'SHANDLE' then
lister close shandle
if handler ~= 'HANDLE' then
lister close handle
exit
-[ END ]--------------------------------------
--
Neil Williams,
neil@zeusdev.co.uk - ICQ UINs: 18223711 & 116110052
FidoNet 2:442/107.0 - Part time BBS: telnet:tkgbbs.darktech.org
--- Zeus BBS 1.5
# Origin: .:]Zeus[:. (2:442/107.0)
* Origin: LiveWire BBS - Synchronet - LiveWireBBS.com (1:2320/100)
