33
54
use Fcntl ':flock'; # import LOCK_* constants
34
55
use POSIX qw(strftime);
57
use bytes; # Larry can take Unicode and shove it up his ass sideways.
58
# Perl 5.8.0 causes us to start getting incomprehensible
59
# errors about UTF-8 all over the place without this.
37
62
my $progname = $0; $progname =~ s@.*/@@g;
38
my $version = q{ $Revision: 1.78 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
39
my $copyright = "WebCollage $version, Copyright (c) 1999-2001" .
63
my $version = q{ $Revision: 1.125 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
64
my $copyright = "WebCollage $version, Copyright (c) 1999-2005" .
40
65
" Jamie Zawinski <jwz\@jwz.org>\n" .
41
" http://www.jwz.org/xscreensaver/\n";
45
my @search_methods = ( 30, "imagevista", \&pick_from_alta_vista_images,
46
28, "altavista", \&pick_from_alta_vista_text,
47
18, "yahoorand", \&pick_from_yahoo_random_link,
48
14, "googleimgs", \&pick_from_google_images,
49
2, "yahoonews", \&pick_from_yahoo_news_text,
50
8, "lycos", \&pick_from_lycos_text,
52
# Hotbot gives me "no matches" just about every time.
53
# Then I try the same URL again, and it works. I guess
54
# it caches searches, and webcollage always busts its
55
# cache and time out? Or it just sucks.
56
# 0, "hotbot", \&pick_from_hotbot_text,
66
" http://www.jwz.org/webcollage/\n";
70
my @search_methods = ( 58, "altavista", \&pick_from_alta_vista_random_link,
71
11, "livejournal", \&pick_from_livejournal_images,
72
7, "yahoorand", \&pick_from_yahoo_random_link,
73
10, "googlephotos", \&pick_from_google_image_photos,
74
6, "googleimgs", \&pick_from_google_images,
75
3, "googlenums", \&pick_from_google_image_numbers,
76
5, "flickr", \&pick_from_flickr,
78
# In Apr 2002, Google asked me to stop searching them.
79
# I asked them to add a "random link" url. They said
80
# "that would be easy, we'll think about it" and then
81
# never wrote back. Booo Google! Booooo! So, screw
82
# those turkeys, I've turned Google searching back on.
83
# I'm sure they can take it. (Jan 2005.)
85
# Jan 2005: Yahoo fucked up their search form so that
86
# it's no longer possible to do "or" searches on news
87
# images, so we rarely get any hits there any more.
89
# 0, "yahoonews", \&pick_from_yahoo_news_text,
91
# Dec 2004: the ircimages guy's server can't take the
92
# heat, so he started banning the webcollage user agent.
93
# I tried to convince him to add a lighter-weight page to
94
# support webcollage better, but he doesn't care.
96
# 0, "ircimages", \&pick_from_ircimages,
98
# Dec 2002: Alta Vista has a new "random link" URL now.
99
# They added it specifically to better support webcollage!
100
# That was super cool of them. This is how we used to do
103
# 0, "avimages", \&pick_from_alta_vista_images,
104
# 0, "avtext", \&pick_from_alta_vista_text,
106
# This broke in 2004. Eh, Lycos sucks anyway.
108
# 0, "lycos", \&pick_from_lycos_text,
110
# This broke in 2003, I think. I suspect Hotbot is
111
# actually the same search engine data as Lycos.
113
# 0, "hotbot", \&pick_from_hotbot_text,
59
#@search_methods=(100, "lycos", \&pick_from_lycos_text);
60
@search_methods=(100, "googleimgs",\&pick_from_google_images);
62
116
# programs we can use to write to the root window (tried in ascending order.)
64
my @root_displayers = (
118
my @root_displayers = (
119
"xscreensaver-getimage -root -file",
120
"chbg -once -xscreensaver -max_size 100",
121
"xv -root -quit -viewonly +noresetroot -quick24 -rmode 5" .
122
" -rfg black -rbg black",
123
"xli -quiet -onroot -center -border black",
65
124
"xloadimage -quiet -onroot -center -border black",
66
"xli -quiet -onroot -center -border black",
67
"xv -root -quit -viewonly +noresetroot -rmode 5" .
68
" -rfg black -rbg black",
69
"chbg -once -xscreensaver",
71
126
# this lame program wasn't built with vroot.h:
72
127
# "xsri -scale -keep-aspect -center-horizontal -center-vertical",
656
795
# returns a random word from the dictionary
658
797
sub random_word {
661
if (open (IN, "<$wordlist")) {
662
my $size = (stat(IN))[7];
663
my $pos = rand $size;
664
if (seek (IN, $pos, 0)) {
665
$word = <IN>; # toss partial line
666
$word = <IN>; # keep next line
675
return 0 if (!$word);
677
$word =~ s/^[ \t\n\r]+//;
678
$word =~ s/[ \t\n\r]+$//;
683
$word =~ s/ally$/al/;
684
$word =~ s/izes$/ize/;
685
$word =~ tr/A-Z/a-z/;
687
if ( $word =~ s/[ \t\n\r]/\+/g ) { # convert intra-word spaces to "+".
688
$word = "\%22$word\%22"; # And put quotes (%22) around it.
800
if (! open (IN, "<$wordlist")) {
804
my $size = (stat(IN))[7];
809
error ("looping ($count) while reading $wordlist")
812
my $pos = int (rand ($size));
813
if (seek (IN, $pos, 0)) {
814
$word = <IN>; # toss partial line
815
$word = <IN>; # keep next line
819
next if ($word =~ m/^[-\']/);
823
$word =~ s/^[^a-z]+//s;
824
$word =~ s/[^a-z]+$//s;
830
$word =~ s/ally$/al/s;
831
$word =~ s/izes$/ize/s;
832
$word =~ s/esses$/ess/s;
833
$word =~ s/(.{5})ing$/$1/s;
835
next if (length ($word) > 14);
841
if ( $word =~ s/\s/\+/gs ) { # convert intra-word spaces to "+".
842
$word = "\%22$word\%22"; # And put quotes (%22) around it.
694
849
sub random_words {
695
return (random_word . "%20" .
696
random_word . "%20" .
697
random_word . "%20" .
698
random_word . "%20" .
851
my $sep = ($or_p ? "%20OR%20" : "%20");
852
return (random_word . $sep .
862
$s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge;
869
$s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige;
878
$s =~ s/\"/"/gi;
884
$s =~ s/</</gi; # far from exhaustive...
886
$s =~ s/"/\"/gi;
703
892
# Loads the given URL (a search on some search engine) and returns:
704
893
# - the total number of hits the search engine claimed it had;
705
894
# - a list of URLs from the page that the search engine returned;
1010
1254
pick_from_search_engine ($timeout, $search_url, $words);
1012
1256
my @candidates = ();
1013
1258
foreach my $u (@subpages) {
1014
1259
next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this
1015
1260
next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins
1017
1262
if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) {
1019
LOG ($verbose_filter, " candidate: $urlf");
1020
push @candidates, $urlf;
1265
$img = "http://$img" unless ($img =~ m/^http:/i);
1267
LOG ($verbose_filter, " candidate: $ref");
1268
push @candidates, $img;
1269
$referers{$img} = $ref;
1024
return pick_image_from_pages ($search_url, $search_hit_count, $#subpages+1,
1025
$timeout, @candidates);
1273
@candidates = depoison (@candidates);
1274
return () if ($#candidates < 0);
1275
my $i = int(rand($#candidates+1));
1276
my $img = $candidates[$i];
1277
my $ref = $referers{$img};
1279
LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)");
1280
return ($ref, $img);
1285
############################################################################
1287
# Pick images by feeding random numbers into Google Image Search.
1288
# By jwz, suggested by Ian O'Donnell.
1290
############################################################################
1294
sub pick_from_google_image_numbers {
1295
my ( $timeout ) = @_;
1298
my $number = int(rand($max));
1300
$number = sprintf("%04d", $number)
1303
pick_from_google_images ($timeout, "$number");
1308
############################################################################
1310
# Pick images by feeding random digital camera file names into
1311
# Google Image Search.
1312
# By jwz, inspired by the excellent Random Personal Picture Finder
1313
# at http://www.diddly.com/random/
1315
############################################################################
1319
# Common digital camera file name formats, as described at
1320
# http://www.diddly.com/random/about.html
1322
sub { sprintf ("dcp%05d.jpg", int(rand(4000))); }, # Kodak
1323
sub { sprintf ("dsc%05d.jpg", int(rand(4000))); }, # Nikon
1324
sub { sprintf ("dscn%04d.jpg", int(rand(4000))); }, # Nikon
1325
sub { sprintf ("mvc-%03d.jpg", int(rand(999))); }, # Sony Mavica
1326
sub { sprintf ("mvc%05d.jpg", int(rand(9999))); }, # Sony Mavica
1327
sub { sprintf ("P101%04d.jpg", int(rand(9999))); }, # Olympus w/ date=101
1328
sub { sprintf ("P%x%02d%04d.jpg", # Olympus
1329
int(rand(0xC)), int(rand(30))+1,
1331
sub { sprintf ("IMG_%03d.jpg", int(rand(999))); }, # ?
1332
sub { sprintf ("IMAG%04d.jpg", int(rand(9999))); }, # RCA and Samsung
1333
sub { my $n = int(rand(9999)); # Canon
1334
sprintf ("1%02d-%04d.jpg", int($n/100), $n); },
1335
sub { my $n = int(rand(9999)); # Canon
1336
sprintf ("1%02d-%04d_IMG.jpg",
1337
int($n/100), $n); },
1338
sub { sprintf ("IMG_%04d.jpg", int(rand(9999))); }, # Canon
1339
sub { sprintf ("dscf%04d.jpg", int(rand(9999))); }, # Fuji Finepix
1340
sub { sprintf ("pdrm%04d.jpg", int(rand(9999))); }, # Toshiba PDR
1341
sub { sprintf ("IM%06d.jpg", int(rand(9999))); }, # HP Photosmart
1342
sub { sprintf ("EX%06d.jpg", int(rand(9999))); }, # HP Photosmart
1343
# sub { my $n = int(rand(3)); # Kodak DC-40,50,120
1344
# sprintf ("DC%04d%s.jpg", int(rand(9999)),
1345
# $n == 0 ? 'S' : $n == 1 ? 'M' : 'L'); },
1346
sub { sprintf ("pict%04d.jpg", int(rand(9999))); }, # Minolta Dimage
1347
sub { sprintf ("P%07d.jpg", int(rand(9999))); }, # Kodak DC290
1348
# sub { sprintf ("%02d%02d%04d.jpg", # Casio QV3000, QV4000
1349
# int(rand(12))+1, int(rand(31))+1,
1350
# int(rand(999))); },
1351
# sub { sprintf ("%02d%x%02d%04d.jpg", # Casio QV7000
1352
# int(rand(6)), # year
1353
# int(rand(12))+1, int(rand(31))+1,
1354
# int(rand(999))); },
1355
sub { sprintf ("IMGP%04d.jpg", int(rand(9999))); }, # Pentax Optio S
1356
sub { sprintf ("PANA%04d.jpg", int(rand(9999))); }, # Panasonic vid still
1357
sub { sprintf ("HPIM%04d.jpg", int(rand(9999))); }, # HP Photosmart
1358
sub { sprintf ("PCDV%04d.jpg", int(rand(9999))); }, # ?
1363
sub pick_from_google_image_photos {
1364
my ( $timeout ) = @_;
1366
my $i = int(rand($#photomakers + 1));
1367
my $fn = $photomakers[$i];
1369
my $words .= $file . "%20filetype:jpg";
1371
pick_from_google_images ($timeout, $words);
1589
############################################################################
1591
# Pick images from LiveJournal's list of recently-posted images.
1593
############################################################################
1595
my $livejournal_img_url = "http://www.livejournal.com/stats/latest-img.bml";
1597
# With most of our image sources, we get a random page and then select
1598
# from the images on it. However, in the case of LiveJournal, the page
1599
# of images tends to update slowly; so we'll remember the last N entries
1600
# on it and randomly select from those, to get a wider variety each time.
1602
my $lj_cache_size = 1000;
1603
my @lj_cache = (); # fifo, for ordering by age
1604
my %lj_cache = (); # hash, for detecting dups
1607
sub pick_from_livejournal_images {
1608
my ( $timeout ) = @_;
1610
$last_search = $livejournal_img_url; # for warnings
1612
my ( $base, $body ) = get_document ($livejournal_img_url, undef, $timeout);
1613
return () unless $body;
1616
$body =~ s/(<recent-image)\b/\n$1/gsi;
1618
foreach (split (/\n/, $body)) {
1619
next unless (m/^<recent-image\b/);
1620
next unless (m/\bIMG=[\'\"]([^\'\"]+)[\'\"]/si);
1621
my $img = html_unquote ($1);
1623
next if ($lj_cache{$img}); # already have it
1625
next unless (m/\bURL=[\'\"]([^\'\"]+)[\'\"]/si);
1626
my $page = html_unquote ($1);
1627
my @pair = ($img, $page);
1628
LOG ($verbose_filter, " candidate: $img");
1629
push @lj_cache, \@pair;
1630
$lj_cache{$img} = \@pair;
1633
return () if ($#lj_cache == -1);
1635
my $n = $#lj_cache+1;
1636
my $i = int(rand($n));
1637
my ($img, $page) = @{$lj_cache[$i]};
1639
# delete this one from @lj_cache and from %lj_cache.
1641
@lj_cache = ( @lj_cache[0 .. $i-1],
1642
@lj_cache[$i+1 .. $#lj_cache] );
1643
delete $lj_cache{$img};
1645
# Keep the size of the cache under the limit by nuking older entries
1647
while ($#lj_cache >= $lj_cache_size) {
1648
my $pairP = shift @lj_cache;
1649
my $img = $pairP->[0];
1650
delete $lj_cache{$img};
1653
LOG ($verbose_load, "picked image " .($i+1) . "/$n: $img");
1655
return ($page, $img);
1659
############################################################################
1661
# Pick images from ircimages.com (images that have been in the /topic of
1662
# various IRC channels.)
1664
############################################################################
1666
my $ircimages_url = "http://ircimages.com/";
1669
sub pick_from_ircimages {
1670
my ( $timeout ) = @_;
1672
$last_search = $ircimages_url; # for warnings
1674
my $n = int(rand(2900));
1675
my $search_url = $ircimages_url . "page-$n";
1677
my ( $base, $body ) = get_document ($search_url, undef, $timeout);
1678
return () unless $body;
1680
my @candidates = ();
1683
$body =~ s/(<A)\b/\n$1/gsi;
1685
foreach (split (/\n/, $body)) {
1687
my ($u) = m@<A\s.*\bHREF\s*=\s*([^>]+)>@i;
1690
if ($u =~ m/^\"([^\"]*)\"/) { $u = $1; } # quoted string
1691
elsif ($u =~ m/^([^\s]*)\s/) { $u = $1; } # or token
1693
next unless ($u =~ m/^http:/i);
1694
next if ($u =~ m@^http://(searchirc\.com\|ircimages\.com)@i);
1695
next unless ($u =~ m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@i);
1697
LOG ($verbose_http, " HREF: $u");
1698
push @candidates, $u;
1701
LOG ($verbose_filter, "" . $#candidates+1 . " links on $search_url");
1703
return () if ($#candidates == -1);
1705
my $i = int(rand($#candidates+1));
1706
my $img = $candidates[$i];
1708
LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) .
1711
$search_url = $img; # hmm...
1712
return ($search_url, $img);
1716
############################################################################
1718
# Pick images from Flickr's page of recently-posted photos.
1720
############################################################################
1722
my $flickr_img_url = "http://www.flickr.com/photos/";
1724
# Like LiveJournal, the Flickr page of images tends to update slowly,
1725
# so remember the last N entries on it and randomly select from those.
1727
# I know that Flickr has an API (http://www.flickr.com/services/api/)
1728
# but it was easy enough to scrape the HTML, so I didn't bother exploring.
1730
my $flickr_cache_size = 1000;
1731
my @flickr_cache = (); # fifo, for ordering by age
1732
my %flickr_cache = (); # hash, for detecting dups
1736
sub pick_from_flickr {
1737
my ( $timeout ) = @_;
1739
my $start = 16 * int(rand(100));
1741
$last_search = $flickr_img_url; # for warnings
1742
$last_search .= "?start=$start" if ($start > 0);
1744
my ( $base, $body ) = get_document ($last_search, undef, $timeout);
1745
return () unless $body;
1747
$body =~ s/[\r\n]/ /gs;
1748
$body =~ s/(<a)\b/\n$1/gsi;
1752
foreach (split (/\n/, $body)) {
1753
my ($page, $thumb) = m@<A \s [^<>]* \b HREF=\"([^<>\"]+)\" [^<>]* > \s*
1754
<IMG \s [^<>]* \b SRC=\"([^<>\"]+)\" @xsi;
1755
next unless defined ($thumb);
1756
$page = html_unquote ($page);
1757
$thumb = html_unquote ($thumb);
1759
next unless ($thumb =~ m@^http://photos\d*\.flickr\.com/@);
1761
my $base = "http://www.flickr.com/";
1762
$page =~ s@^/@$base@;
1763
$thumb =~ s@^/@$base@;
1766
$img =~ s/_[a-z](\.[a-z\d]+)$/$1/si; # take off "thumb" suffix
1769
next if ($flickr_cache{$img}); # already have it
1771
my @pair = ($img, $page, $start);
1772
LOG ($verbose_filter, " candidate: $img");
1773
push @flickr_cache, \@pair;
1774
$flickr_cache{$img} = \@pair;
1778
return () if ($#flickr_cache == -1);
1780
my $n = $#flickr_cache+1;
1781
my $i = int(rand($n));
1782
my ($img, $page) = @{$flickr_cache[$i]};
1784
# delete this one from @flickr_cache and from %flickr_cache.
1786
@flickr_cache = ( @flickr_cache[0 .. $i-1],
1787
@flickr_cache[$i+1 .. $#flickr_cache] );
1788
delete $flickr_cache{$img};
1790
# Keep the size of the cache under the limit by nuking older entries
1792
while ($#flickr_cache >= $flickr_cache_size) {
1793
my $pairP = shift @flickr_cache;
1794
my $img = $pairP->[0];
1795
delete $flickr_cache{$img};
1798
LOG ($verbose_load, "picked image " .($i+1) . "/$n: $img");
1800
return ($page, $img);
1804
############################################################################
1806
# Pick images by waiting for driftnet to populate a temp dir with files.
1807
# Requires driftnet version 0.1.5 or later.
1808
# (Driftnet is a program by Chris Lightfoot that sniffs your local ethernet
1809
# for images being downloaded by others.)
1810
# Driftnet/webcollage integration by jwz.
1812
############################################################################
1815
sub pick_from_driftnet {
1816
my ( $timeout ) = @_;
1818
my $id = $driftnet_magic;
1819
my $dir = $driftnet_dir;
1823
error ("\$driftnet_dir unset?") unless ($dir);
1826
error ("$dir unreadable") unless (-d "$dir/.");
1828
$timeout = $http_timeout unless ($timeout);
1831
while ($now = time, $now < $start + $timeout) {
1833
opendir (DIR, $dir) || error ("$dir: $!");
1834
while (my $file = readdir(DIR)) {
1835
next if ($file =~ m/^\./);
1836
$file = "$dir/$file";
1838
LOG ($verbose_load, "picked file $file ($id)");
1839
return ($id, $file);
1843
LOG (($verbose_net || $verbose_load), "timed out for $id");
1848
sub get_driftnet_file {
1851
error ("\$driftnet_dir unset?") unless ($driftnet_dir);
1853
my $id = $driftnet_magic;
1854
my $re = qr/$driftnet_dir/;
1855
error ("$id: $file not in $driftnet_dir?")
1856
unless ($file =~ m@^$re@o);
1859
open (IN, $file) || error ("$id: $file: $!");
1861
while (<IN>) { $body .= $_; }
1862
close IN || error ("$id: $file: $!");
1863
unlink ($file) || error ("$id: $file: rm: $!");
1864
return ($id, $body);
1868
sub spawn_driftnet {
1871
# make a directory to use.
1873
my $tmp = $ENV{TEMPDIR} || "/tmp";
1874
$driftnet_dir = sprintf ("$tmp/driftcollage-%08x", rand(0xffffffff));
1875
LOG ($verbose_exec, "mkdir $driftnet_dir");
1876
last if mkdir ($driftnet_dir, 0700);
1879
if (! ($cmd =~ m/\s/)) {
1880
# if the command didn't have any arguments in it, then it must be just
1881
# a pointer to the executable. Append the default args to it.
1882
my $dargs = $default_driftnet_cmd;
1883
$dargs =~ s/^[^\s]+//;
1887
# point the driftnet command at our newly-minted private directory.
1889
$cmd .= " -d $driftnet_dir";
1890
$cmd .= ">/dev/null" unless ($verbose_exec);
1893
if ($pid < 0) { error ("fork: $!\n"); }
1896
push @pids_to_kill, $pid;
1897
LOG ($verbose_exec, "forked for \"$cmd\"");
1900
nontrapping_system ($cmd) || error ("exec: $!");
1903
# wait a bit, then make sure the process actually started up.
1906
error ("pid $pid failed to start \"$cmd\"")
1907
unless (1 == kill (0, $pid));
1196
1911
############################################################################
1779
2583
$ppm_to_root_window_cmd = pick_root_displayer();
1782
$SIG{HUP} = \&x_cleanup;
1783
$SIG{INT} = \&x_cleanup;
1784
$SIG{QUIT} = \&x_cleanup;
1785
$SIG{ABRT} = \&x_cleanup;
1786
$SIG{KILL} = \&x_cleanup;
1787
$SIG{TERM} = \&x_cleanup;
1789
# Need this so that if giftopnm dies, we don't die.
1790
$SIG{PIPE} = 'IGNORE';
2585
if (defined ($window_id)) {
2586
error ("-window-id only works if xscreensaver-getimage is installed")
2587
unless ($ppm_to_root_window_cmd =~ m/^xscreensaver-getimage\b/);
2589
error ("unparsable window id: $window_id")
2590
unless ($window_id =~ m/^\d+$|^0x[\da-f]+$/i);
2591
$ppm_to_root_window_cmd =~ s/--?root\b/$window_id/ ||
2592
error ("unable to munge displayer: $ppm_to_root_window_cmd");
1792
2595
if (!$img_width || !$img_height) {
1794
which ($_) || error "$_ not found on \$PATH.";
1796
($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
1797
if (!defined($img_height)) {
1798
error "xdpyinfo failed.";
2597
if (!defined ($window_id) &&
2598
defined ($ENV{XSCREENSAVER_WINDOW})) {
2599
$window_id = $ENV{XSCREENSAVER_WINDOW};
2602
if (!defined ($window_id)) {
2604
which ($_) || error "$_ not found on \$PATH.";
2606
($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /;
2607
if (!defined($img_height)) {
2608
error "xdpyinfo failed.";
2610
} else { # we have a window id
2612
which ($_) || error "$_ not found on \$PATH.";
2613
$_ .= " -id $window_id";
2615
($img_width, $img_height) = m/^\s*Width:\s*(\d+)\n\s*Height:\s*(\d+)\n/m;
2617
if (!defined($img_height)) {
2618
error "xwininfo failed.";
3031
sub update_imagemap {
3032
my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_;
3034
$current_state = "imagemap";
3036
my $max_areas = 200;
3038
$url = html_quote ($url);
3041
my $area = "<AREA SHAPE=RECT COORDS=\"$x,$y,$x2,$y2\" HREF=\"$url\">";
3042
unshift @imagemap_areas, $area; # put one on the front
3043
if ($#imagemap_areas >= $max_areas) {
3044
pop @imagemap_areas; # take one off the back.
3047
LOG ($verbose_pbm, "area: $x,$y,$x2,$y2 (${w}x$h)");
3049
my $map_name = $imagemap_base;
3050
$map_name =~ s@^.*/@@;
3051
$map_name = 'collage' if ($map_name eq '');
3053
my $imagemap_html = $imagemap_base . ".html";
3054
my $imagemap_jpg = $imagemap_base . ".jpg";
3056
if (!defined ($imagemap_html_tmp)) {
3057
$imagemap_html_tmp = $imagemap_html . sprintf (".%08x", rand(0xffffffff));
3058
$imagemap_jpg_tmp = $imagemap_jpg . sprintf (".%08x", rand(0xffffffff));
3061
# Read the imagemap html file (if any) to get a template.
3063
my $template_html = '';
3066
if (open (IN, "<$imagemap_html")) {
3067
while (<IN>) { $template_html .= $_; }
3069
LOG ($verbose_pbm, "read template $imagemap_html");
3072
if ($template_html =~ m/^\s*$/s) {
3073
$template_html = ("<MAP NAME=\"$map_name\"></MAP>\n" .
3074
"<IMG SRC=\"$imagemap_base.jpg\"" .
3075
" USEMAP=\"$map_name\">\n");
3076
LOG ($verbose_pbm, "created dummy template");
3080
# Write the jpg to a tmp file
3084
if (defined ($webcollage_helper)) {
3085
$cmd = "cp -p $image_ppm $imagemap_jpg_tmp";
3087
$cmd = "cjpeg < $image_ppm > $imagemap_jpg_tmp";
3089
my $rc = nontrapping_system ($cmd);
3091
error ("imagemap jpeg failed: \"$cmd\"\n");
3095
# Write the html to a tmp file
3098
my $body = $template_html;
3099
my $areas = join ("\n\t", @imagemap_areas);
3100
my $map = ("<MAP NAME=\"$map_name\">\n\t$areas\n</MAP>");
3101
my $img = ("<IMG SRC=\"$imagemap_base.jpg\" " .
3103
"WIDTH=$image_width HEIGHT=$image_height " .
3104
"USEMAP=\"#$map_name\">");
3105
$body =~ s@(<MAP\s+NAME=\"[^\"]*\"\s*>).*?(</MAP>)@$map@is;
3106
$body =~ s@<IMG\b[^<>]*\bUSEMAP\b[^<>]*>@$img@is;
3108
# if there are magic webcollage spans in the html, update those too.
3111
my @st = stat ($imagemap_jpg_tmp);
3112
my $date = strftime("%d-%b-%Y %l:%M:%S %p %Z", localtime($st[9]));
3113
my $size = int(($st[7] / 1024) + 0.5) . "K";
3114
$body =~ s@(<SPAN\s+CLASS=\"webcollage_date\">).*?(</SPAN>)@$1$date$2@si;
3115
$body =~ s@(<SPAN\s+CLASS=\"webcollage_size\">).*?(</SPAN>)@$1$size$2@si;
3119
open (OUT, ">$imagemap_html_tmp") || error ("$imagemap_html_tmp: $!");
3120
print OUT $body || error ("$imagemap_html_tmp: $!");
3121
close OUT || error ("$imagemap_html_tmp: $!");
3122
LOG ($verbose_pbm, "wrote $imagemap_html_tmp");
3125
# Rename the two tmp files to the real files
3127
rename ($imagemap_html_tmp, $imagemap_html) ||
3128
error "renaming $imagemap_html_tmp to $imagemap_html";
3129
LOG ($verbose_pbm, "wrote $imagemap_html");
3130
rename ($imagemap_jpg_tmp, $imagemap_jpg) ||
3131
error "renaming $imagemap_jpg_tmp to $imagemap_jpg";
3132
LOG ($verbose_pbm, "wrote $imagemap_jpg");
3138
$SIG{HUP} = \&signal_cleanup;
3139
$SIG{INT} = \&signal_cleanup;
3140
$SIG{QUIT} = \&signal_cleanup;
3141
$SIG{ABRT} = \&signal_cleanup;
3142
$SIG{KILL} = \&signal_cleanup;
3143
$SIG{TERM} = \&signal_cleanup;
3145
# Need this so that if giftopnm dies, we don't die.
3146
$SIG{PIPE} = 'IGNORE';
3149
END { exit_cleanup(); }
2137
3154
srand(time ^ $$);
2139
3156
my $verbose = 0;
3158
my $driftnet_cmd = 0;
2142
3160
$current_state = "init";
2143
3161
$load_method = "none";
2145
3163
my $root_p = 0;
3164
my $window_id = undef;
2147
3166
# historical suckage: the environment variable name is lower case.
2148
3167
$http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
added
removed
hacks/webcollage
