1 | #!/usr/bin/perl -w |
---|
2 | |
---|
3 | # wmslashdot.pl v1.3, written by Jeff Meininger |
---|
4 | # http://rive.boxybutgood.com/WMHeadlines/ - jeffm@boxybutgood.com |
---|
5 | # |
---|
6 | # Original concept by Pascal Hofstee... |
---|
7 | # <daeron@shadowmere.student.utwente.nl> |
---|
8 | # |
---|
9 | # Proxy support based on code provided by Dan Gundlach... |
---|
10 | # <dan@msl.net> |
---|
11 | # |
---|
12 | # Proper HTTP/1.1 calls by Kjeld Hoyer Mortensen... |
---|
13 | # <khm@daimi.au.dk> |
---|
14 | # |
---|
15 | # wmslashdot is licensed under the GPL version 2. |
---|
16 | # wmslashdot is Copyright (C) 1999 by Jeff Meininger |
---|
17 | # |
---|
18 | # For setup information, please see the following URL... |
---|
19 | # http://rive.boxybutgood.com/WMHeadlines/ |
---|
20 | # |
---|
21 | # For configuration options, type 'wmslashdot.pl --help' |
---|
22 | # All options are available from the command line. |
---|
23 | # |
---|
24 | # NO NEED TO EDIT THIS FILE FOR CONFIGURATION PURPOSES! |
---|
25 | |
---|
26 | print "Sorry, this doesn't do anything yet..\n"; |
---|
27 | exit 0; |
---|
28 | |
---|
29 | require 5.002; |
---|
30 | use strict; |
---|
31 | use Socket; |
---|
32 | use File::Copy; |
---|
33 | |
---|
34 | # TODO: my ($upkey, $downkey, $enterkey) = ("E", "F", "G"); |
---|
35 | |
---|
36 | # TODO: my @sitenames = ("Slashdot", "Freshmeat", ...); |
---|
37 | # TODO: my @remotes = ("slashdot.org", "freshmeat.net", ...); |
---|
38 | # TODO: my @urls = ("/ultramode.txt", "/whatever.txt", ...); |
---|
39 | my $sitename = "Slashdot"; |
---|
40 | my $scriptname = "slashdot"; |
---|
41 | my $remote = 'slashdot.org'; |
---|
42 | my $url = "/ultramode.txt"; |
---|
43 | |
---|
44 | my @time = localtime(); |
---|
45 | my $garble = scalar(localtime); |
---|
46 | $garble =~ s/\W//g; |
---|
47 | my $randomcrap = rand(900); |
---|
48 | |
---|
49 | my ($iaddr, $paddr, $proto, $line, $menufile, $tmpfile, $newstring, $proxy); |
---|
50 | |
---|
51 | my ($twentyfour, $dayfirst, $proxyflag, $loudflag, $forceupdate) = (0)x5; |
---|
52 | my ($showdate, $newflag) = (1)x2; |
---|
53 | |
---|
54 | my ($frontpage, $deathtext, $datestring) = ("")x3; |
---|
55 | my $nspath = "netscape"; |
---|
56 | $menufile = "$ENV{'HOME'}/.$scriptname" . "menu"; |
---|
57 | |
---|
58 | my $port = 80; |
---|
59 | my $maxlength = 9999; |
---|
60 | my $ampmstring = "AM"; |
---|
61 | my $kick = "\n\n"; |
---|
62 | my $yearstring = "-" . ($time[5] + 1900); |
---|
63 | |
---|
64 | # get configuration from commandline |
---|
65 | my $i; |
---|
66 | for ($i = 0; $i < scalar(@ARGV); $i++) { |
---|
67 | if ($ARGV[$i] eq "--help") { |
---|
68 | print "\nlcd$scriptname.pl usage:\n"; |
---|
69 | print "[-proxy host port] - enables use over a proxy\n"; |
---|
70 | print "[-n] - prevents netscape from opening a new window for each headline\n"; |
---|
71 | print "[-frontpage top|bottom] - adds a persistant item for the $sitename frontpage.\n\tIt can be placed at the top or bottom of the menu.\n"; |
---|
72 | print "[-loud] - useful for debugging problems. Otherwise, the script exits quietly\n\tin the case of an error.\n"; |
---|
73 | print "[-24] - display time in 24 format instead of 12 AM/PM\n"; |
---|
74 | print "[-dayfirst] - display day before month (like 25-12-1999) in date.\n"; |
---|
75 | print "[-nodate] - do not display 'last updated' date in menu title.\n"; |
---|
76 | print "[-noyear] - do not display the year in the 'last updated' date.\n"; |
---|
77 | print "[-proxyfix] - proxy support not working? Try this.\n"; |
---|
78 | print "[-maxlength num] - items will not be shown with more than [num] letters.\n"; |
---|
79 | print "[-nspath /path/to/netscape/executable] - if your 'netscape' is not in the PATH\n\tused by Window Maker, you may specify the full pathname to the netscape\n\texecutable here.\n"; |
---|
80 | print "[-menufile /etc/X11/WindowMaker/menu.$scriptname] - if you want to store the\n\tmenu somewhere other than ~/.$scriptname" . "menu, specify the FULL\n\tpathname with this option. (Keep write permissions in mind...)\n"; |
---|
81 | print "[-forceupdate] - force the menu file to be written even if the headlines have\n\tnot changed. For example, a change in preference options will _NOT_\n\tbe visible without using this option.\n"; |
---|
82 | print "\n"; |
---|
83 | exit(); |
---|
84 | } elsif($ARGV[$i] eq "-proxy") { |
---|
85 | if ((!defined($ARGV[$i + 2])) || ($ARGV[$i + 1] =~ /^-/) || ($ARGV[$i + 2] =~ /^-/) || ($ARGV[$i + 2] =~ /\D/)) { |
---|
86 | print "Please use '-proxy proxy.yourisp.com 3128' or whatever is appropriate.\n"; |
---|
87 | exit(); |
---|
88 | } else { |
---|
89 | $proxyflag = 1; |
---|
90 | $proxy = $ARGV[$i + 1]; |
---|
91 | $port = $ARGV[$i + 2]; |
---|
92 | } |
---|
93 | } elsif($ARGV[$i] eq "-n") { |
---|
94 | $newflag = 0; |
---|
95 | } elsif($ARGV[$i] eq "-frontpage") { |
---|
96 | if ((!defined($ARGV[$i + 1])) || (($ARGV[$i + 1] ne "top") && ($ARGV[$i + 1] ne "bottom"))) { |
---|
97 | print "Please use '-frontpage top' or '-frontpage bottom' to enable this feature.\n"; |
---|
98 | exit(); |
---|
99 | } else { |
---|
100 | $frontpage = $ARGV[$i + 1]; |
---|
101 | } |
---|
102 | } elsif($ARGV[$i] eq "-loud") { |
---|
103 | $deathtext = "ERROR: Could not connect to remote site"; |
---|
104 | } elsif($ARGV[$i] eq "-24") { |
---|
105 | $twentyfour = 1; |
---|
106 | } elsif($ARGV[$i] eq "-dayfirst") { |
---|
107 | $dayfirst = 1; |
---|
108 | } elsif($ARGV[$i] eq "-nodate") { |
---|
109 | $showdate = 0; |
---|
110 | } elsif($ARGV[$i] eq "-noyear") { |
---|
111 | $yearstring = ""; |
---|
112 | } elsif($ARGV[$i] eq "-proxyfix") { |
---|
113 | $kick = "\r\n\r\n"; |
---|
114 | } elsif($ARGV[$i] eq "-maxlength") { |
---|
115 | if ((!defined($ARGV[$i + 1])) || ($ARGV[$i + 1] =~ /\D/)) { |
---|
116 | print "Please use '-maxlength NUM' where NUM is an integer, like 60.\n"; |
---|
117 | exit(); |
---|
118 | } else { |
---|
119 | $maxlength = $ARGV[$i + 1]; |
---|
120 | } |
---|
121 | } elsif($ARGV[$i] eq "-nspath") { |
---|
122 | if (!defined($ARGV[$i + 1]) || ($ARGV[$i + 1] !~ /^\//)) { |
---|
123 | print "Please use '-nspath /opt/netscape-4.5/netscape', or whatever is appropriate.\nNote... you must specify the FULL pathname.\n"; |
---|
124 | exit(); |
---|
125 | } |
---|
126 | $nspath = $ARGV[$i + 1]; |
---|
127 | } elsif($ARGV[$i] eq "-menufile") { |
---|
128 | if (!defined($ARGV[$i + 1]) || ($ARGV[$i + 1] !~ /^\//)) { |
---|
129 | print "Please use '-menufile /etc/X11/WindowMaker/menu.$scriptname', or whatever is\nappropriate. Note... you must specify the FULL pathname.\n"; |
---|
130 | exit(); |
---|
131 | } |
---|
132 | $menufile = $ARGV[$i + 1]; |
---|
133 | } elsif($ARGV[$i] eq "-forceupdate") { |
---|
134 | $forceupdate = 1; |
---|
135 | } |
---|
136 | } |
---|
137 | |
---|
138 | if ($newflag == 0) { |
---|
139 | $newstring = ""; |
---|
140 | } else { |
---|
141 | $newstring = ", new-window"; |
---|
142 | } |
---|
143 | |
---|
144 | if ($twentyfour > 0) { |
---|
145 | $ampmstring = ""; |
---|
146 | } else { |
---|
147 | if ($time[2] > 11) { |
---|
148 | $ampmstring = "PM"; |
---|
149 | } |
---|
150 | |
---|
151 | if ($time[2] > 12) { |
---|
152 | $time[2] = $time[2] - 12; |
---|
153 | } |
---|
154 | } |
---|
155 | |
---|
156 | if ($showdate > 0) { |
---|
157 | if ($dayfirst > 0) { |
---|
158 | $datestring = " [$time[3]-" . ($time[4] + 1) . "$yearstring, " . $time[2] . ":" . sprintf("%02d", $time[1]) . "$ampmstring]"; |
---|
159 | } else { |
---|
160 | $datestring = " [" . ($time[4] + 1) . "-$time[3]$yearstring, " . $time[2] . ":" . sprintf("%02d", $time[1]) . "$ampmstring]"; |
---|
161 | } |
---|
162 | } else { |
---|
163 | $datestring = ""; |
---|
164 | } |
---|
165 | |
---|
166 | # start the fun |
---|
167 | $tmpfile = "/tmp/$scriptname" . "menu$garble$randomcrap"; |
---|
168 | open(TMPFILE, ">$tmpfile"); |
---|
169 | |
---|
170 | print TMPFILE "\"$sitename Headlines$datestring\" MENU\n"; |
---|
171 | |
---|
172 | if ($frontpage eq "top") { |
---|
173 | print TMPFILE "\"$sitename Frontpage\" EXEC $nspath -remote 'openURL(http://$remote/$newstring)' || $nspath 'http://$remote/'\n"; |
---|
174 | } |
---|
175 | |
---|
176 | # network connection portion is pretty much stolen from 'man perlipc' |
---|
177 | if ($proxyflag > 0) { |
---|
178 | $iaddr = inet_aton($proxy) || wmdie($deathtext); |
---|
179 | } else { |
---|
180 | $iaddr = inet_aton($remote) || wmdie($deathtext); |
---|
181 | } |
---|
182 | $paddr = sockaddr_in($port, $iaddr); |
---|
183 | $proto = getprotobyname('tcp'); |
---|
184 | socket(SOCK, PF_INET, SOCK_STREAM, $proto) || wmdie($deathtext); |
---|
185 | connect(SOCK, $paddr) || wmdie($deathtext); |
---|
186 | |
---|
187 | select(SOCK); $| = 1; select(STDOUT); |
---|
188 | |
---|
189 | if ($proxyflag > 0) { |
---|
190 | print SOCK "GET http://$remote$url HTTP/1.1$kick"; |
---|
191 | } else { |
---|
192 | print SOCK "GET $url HTTP/1.1\nHost: $remote:80$kick"; |
---|
193 | } |
---|
194 | |
---|
195 | |
---|
196 | $i = 0; |
---|
197 | my $flag = 0; |
---|
198 | while (defined($line = <SOCK>)) { |
---|
199 | $i++; |
---|
200 | |
---|
201 | if ($line =~ /^%%/) { $i = 1; $flag = 1; } |
---|
202 | |
---|
203 | if ($flag > 0) { |
---|
204 | if ($i == 2) { |
---|
205 | chop($line); |
---|
206 | $line =~ s/"/'/g; # " Balances out quote... |
---|
207 | $line =~ s/<.*?>//g; |
---|
208 | $line =~ s/&.{1,5}?;//g; |
---|
209 | if (length($line) > $maxlength) { |
---|
210 | $line = substr($line, 0, $maxlength) . "..."; |
---|
211 | } |
---|
212 | print TMPFILE "\"$line\" EXEC $nspath -remote 'openURL("; |
---|
213 | } elsif ($i == 3) { |
---|
214 | chop($line); |
---|
215 | print TMPFILE "$line$newstring)' || $nspath '$line'\n"; |
---|
216 | } |
---|
217 | } |
---|
218 | } |
---|
219 | |
---|
220 | if ($frontpage eq "bottom") { |
---|
221 | print TMPFILE "\"$sitename Frontpage\" EXEC $nspath -remote 'openURL(http://$remote/$newstring)' || $nspath 'http://$remote/'\n"; |
---|
222 | } |
---|
223 | |
---|
224 | print TMPFILE "\"$sitename Headlines$datestring\" END\n"; |
---|
225 | |
---|
226 | close(SOCK) || die "Error closing socket: $!"; |
---|
227 | close(TMPFILE); |
---|
228 | |
---|
229 | # compare tmpfile with current menufile and possibly update it. |
---|
230 | if (-e $menufile) { |
---|
231 | my ($tmpline, $menuline, $linecount); |
---|
232 | |
---|
233 | open(MENUFILE, $menufile); |
---|
234 | open(TMPFILE, $tmpfile); |
---|
235 | |
---|
236 | # read in the first 'headline' menu entry from each file. |
---|
237 | if ($frontpage eq "top") { |
---|
238 | $linecount = 3; |
---|
239 | } else { |
---|
240 | $linecount = 2; |
---|
241 | } |
---|
242 | |
---|
243 | for ($i = 0; $i < $linecount; $i++) { |
---|
244 | if (eof(TMPFILE)) { |
---|
245 | if ($forceupdate == 0) { |
---|
246 | |
---|
247 | close(MENUFILE); |
---|
248 | close(TMPFILE); |
---|
249 | unlink($tmpfile); |
---|
250 | |
---|
251 | exit(); |
---|
252 | } |
---|
253 | } else { |
---|
254 | $tmpline = <TMPFILE>; |
---|
255 | } |
---|
256 | |
---|
257 | unless (eof(MENUFILE)) { |
---|
258 | $menuline = <MENUFILE>; |
---|
259 | } |
---|
260 | } |
---|
261 | |
---|
262 | if (($forceupdate == 0) && (($tmpline =~ /^"$sitename Headlines/) || ($tmpline =~ /^"$sitename Frontpage/) || ($tmpline eq $menuline))) { |
---|
263 | close(MENUFILE); |
---|
264 | close(TMPFILE); |
---|
265 | unlink($tmpfile); |
---|
266 | |
---|
267 | exit(); |
---|
268 | } |
---|
269 | } |
---|
270 | |
---|
271 | close(MENUFILE); |
---|
272 | close(TMPFILE); |
---|
273 | copy($tmpfile, $menufile); |
---|
274 | unlink($tmpfile); |
---|
275 | |
---|
276 | exit(); |
---|
277 | |
---|
278 | sub wmdie { |
---|
279 | my $string = shift; |
---|
280 | if ($string ne "") { |
---|
281 | print "$string\n"; |
---|
282 | } |
---|
283 | |
---|
284 | close(SOCK); |
---|
285 | close(TMPFILE); |
---|
286 | unlink($tmpfile); |
---|
287 | |
---|
288 | if ($string eq "") { |
---|
289 | exit(0); |
---|
290 | } else { |
---|
291 | exit(1); |
---|
292 | } |
---|
293 | } |
---|