?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
pl.po: update
[elinks.git] / contrib / perl / hooks.pl
blobafbc971d6fe7528b97501df59014ee7c0fab5c97
1 # Example ~/.elinks/hooks.pl
2 #
3 # Copyleft by Russ Rowan (See the file "COPYING" for details.)
4 #
5 # To get documentation for this file:
6 # pod2html hooks.pl > hooks.html && elinks hooks.html
7 # or
8 # perldoc hooks.pl
9
10 =head1 NAME
11
12 hooks.pl -- Perl hooks for the ELinks text WWW browser
13
14 =head1 DESCRIPTION
15
16 This file contains the Perl hooks for the ELinks text WWW browser.
17
18 These hooks change the browser's behavior in various ways. They allow
19 shortcuts to be used in the Goto URL dialog, modifying the source of a page,
20 proxy handling, and other things such as displaying a fortune at exit.
21
22 =cut
23 use strict;
24 use warnings;
25 use diagnostics;
26
27 =head1 CONFIGURATION FILE
28
29 This hooks file reads its configuration from I<~/.elinks/config.pl>.
30 The following is an example of the configuration file:
31
32 bork: yep # BORKify Google?
33 collapse: okay # Collapse all XBEL bookmark folders on exit?
34 email: # Set to show one's own bugs with the "bug" prefix.
35 external: wget # Send the current URL to this application.
36 fortune: elinks # *fortune*, *elinks* tip, or *none* on quit?
37 googlebeta: hell no # I miss DejaNews...
38 gotosearch: why not # Anything not a URL in the Goto URL dialog...
39 ipv6: sure # IPV4 or 6 address blocks with "ip" prefix?
40 language: english # "bf nl en" still works, but now "bf nl" does too
41 news: msnbc # Agency to use for "news" and "n" prefixes
42 search: elgoog # Engine for (search|find|www|web|s|f|go) prefixes
43 usenet: google # *google* or *standard* view for news:// URLs
44 weather: cnn # Server for "weather" and "w" prefixes
45
46 # news: bbc, msnbc, cnn, fox, google, yahoo, reuters, eff, wired,
47 # slashdot, newsforge, usnews, newsci, discover, sciam
48 # search: elgoog, google, yahoo, ask jeeves, a9, altavista, msn, dmoz,
49 # dogpile, mamma, webcrawler, netscape, lycos, hotbot, excite
50 # weather: weather underground, google, yahoo, cnn, accuweather,
51 # ask jeeves
52
53 I<Developer's usage>: The function I<loadrc()> takes a preference name as its
54 single argument and returns either an empty string if it is not specified,
55 I<yes> for a true value (even if specified like I<sure> or I<why not>), I<no>
56 for a false value (even if like I<nah>, I<off> or I<0>), or the lowercased
57 preference value (like I<cnn> for C<weather: CNN>).
58
59 =cut
60 sub loadrc($)
61 {
62 my ($preference) = @_;
63 my $configperl = $ENV{'HOME'} . '/.elinks/config.pl';
64 my $answer = '';
65
66 open RC, "<$configperl" or return $answer;
67 while (<RC>)
68 {
69 s/\s*#.*$//;
70 next unless (m/(.*):\s*(.*)/);
71 my $setting = $1;
72 my $switch = $2;
73 next unless ($setting eq $preference);
74
75 if ($switch =~ /^(yes|1|on|yea|yep|sure|ok|okay|yeah|why.*not)$/)
76 {
77 $answer = "yes";
78 }
79 elsif ($switch =~ /^(no|0|off|nay|nope|nah|hell.*no)$/)
80 {
81 $answer = "no";
82 }
83 else
84 {
85 $answer = lc($switch);
86 }
87 }
88 close RC;
89
90 return $answer;
91 }
92
93
94
95 =head1 GOTO URL HOOK
96
97 This is a summary of the shortcuts defined in this file for use in the Goto URL
98 dialog. They are similar to the builtin URL prefixes, but more flexible and
99 powerful.
100
101 =over
102
103 I<Developer's usage>: The function I<goto_url_hook> is called when the hook is
104 triggered, taking the target URL and current URL as its two arguments. It
105 returns the final target URL.
106
107 These routines do a name->URL mapping - for example, the I<goto_url_hook()>
108 described above maps a certain prefix to C<google> and then asks the
109 I<search()> mapping routine described below to map the C<google> string to an
110 appropriate URL.
111
112 There are generally two URLs for each name. One to go to the particular URL's
113 main page, and another for a search on the given site (if any string is
114 specified after the prefix). A few of these prefixes will change their
115 behavior depending on the URL currently beung displayed in the browser.
116
117 =cut
118 # Don't call them "dumb". They hate that. Rather, "interactivity challenged".
119 ################################################################################
120 ### goto_url_hook ##############################################################
121 sub goto_url_hook
122 {
123 my $url = shift;
124 my $current_url = shift;
125
126
127 =item Bugmenot:
128
129 B<bugmenot> or B<bn>
130
131 =cut
132 ############################################################################
133 # "bugmenot" (no blood today, thank you)
134 if ($url =~ '^(bugmenot|bn)$' and $current_url)
135 {
136 ($current_url) = $current_url =~ /^.*:\/\/(.*)/;
137 my $bugmenot = 'http://bugmenot.com/view.php?url=' . $current_url;
138 #my $tempfile = $ENV{'HOME'} . '/.elinks/elinks';
139 #my $matrix = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
140 #for (0..int(rand(7) + 9))
141 #{
142 #$tempfile = $tempfile . substr($matrix, (length($matrix) - 1) - rand(length($matrix) + 1), 1);
143 #}
144 #my ($message, $login, $password);
145 #system('elinks -no-home -source "' . $bugmenot . '" >' . $tempfile . ' 2>/dev/null');
146 #open FILE, "<$tempfile" or return $bugmenot;
147 #$message = <FILE>;
148 #while (<FILE>)
149 #{
150 #next unless (m/^<dd>(.*)<br \/>(.*)<\/dd><\/dl>$/);
151 #$login = $1;
152 #$password = $2;
153 #}
154 #$login =~ s/(^\s*|\n|\s*$)//g if $login;
155 #$password =~ s/(^\s*|\n|\s*$)//g if $password;
156 #close FILE;
157 #unlink $tempfile;
158 #return $bugmenot unless $message =~ /[a-z]+/ and $message !~ /404/;
159 #unless ($message =~ s/.*(No accounts found\.).*/${1}/)
160 #{
161 #if ($login and $password)
162 #{
163 #$message = "Login: " . $login . "\nPassword: " . $password;
164 #}
165 #else
166 #{
167 #$message = 'No accounts found';
168 #}
169 #}
170 #system('elinks -remote "infoBox\(' . $message . ')" >/dev/null 2>&1 &');
171 #return $current_url; #FIXME
172 ##return;
173 return $bugmenot . $current_url;
174 }
175
176
177 ############################################################################
178 # Random URL generator
179 if ($url eq 'bored' or $url eq 'random')
180 {
181 my $word; # You can say *that* again...
182 srand();
183 open FILE, '</usr/share/dict/words'
184 or open FILE, '</usr/share/dict/linux.words'
185 or open FILE, '</usr/dict/words'
186 or open FILE, '</usr/dict/linux.words'
187 or open FILE, '</usr/share/dict/yawl.list'
188 or open FILE, $ENV{"HOME"} . '/.elinks/elinks.words'
189 or return 'http://google.com/webhp?hl=xx-bork';
190 rand($.) < 1 && ($word = $_) while <FILE>;
191 close FILE;
192 ($word) = $word =~ /(.*)/;
193 return 'http://' . lc($word) . '.com';
194 }
195
196
197 =item Web search:
198
199 =over
200
201 =item Google: B<g> or B<google> (default)
202
203 =item Yahoo: B<y> or B<yahoo>
204
205 =item Ask Jeeves: B<ask> or B<jeeves>
206
207 =item Amazon A9: B<a9>
208
209 =item Altavista: B<av> or B<altavista>
210
211 =item Microsoft: B<msn> or B<microsoft>
212
213 =item Mozilla Open Directory: B<dmoz>, B<odp>, B<mozilla>
214
215 =item Dogpile: B<dp> or B<dogpile>
216
217 =item Mamma: B<ma> or B<mamma>
218
219 =item Webcrawler: B<wc> or B<webcrawler>
220
221 =item Netscape: B<ns> or B<netscape>
222
223 =item Lycos: B<ly> or B<lycos>
224
225 =item Hotbot: B<hb> or B<hotbot>
226
227 =item Excite: B<ex> or B<excite>
228
229 =item Elgoog: B<eg>, B<elgoog>, B<hcraes>, B<dnif>, B<bew>, B<og>
230
231 =back
232
233 default engine: B<search>, B<find>, B<www>, B<web>, B<s>, B<f>, B<go>
234
235 =over
236
237 The I<%search_engines> hash maps each engine name to two URLs, I<home> and
238 I<search>. With I<search>, the query is appended to the URL.
239
240 The search engines mapping is done by the I<search()> function, taking the
241 search engine name as its first parameter and optional search string as its
242 second parameter. It returns the mapped target URL.
243
244 =back
245
246 =back
247
248 =cut
249 ############################################################################
250 # Search engines
251 my %search_prefixes;
252 $search_prefixes{'^(g|google)(| .*)$'} = 'google'; # Google (default)
253 $search_prefixes{'^(y|yahoo)(| .*)$'} = 'yahoo'; # Yahoo
254 $search_prefixes{'^(ask|jeeves)(| .*)$'} = 'ask jeeves'; # Ask Jeeves
255 $search_prefixes{'^a9(| .*)$'} = 'a9'; # Amazon A9
256 $search_prefixes{'^(av|altavista)(| .*)$'} = 'altavista'; # Altavista
257 $search_prefixes{'^(msn|microsoft)(| .*)$'} = 'msn'; # Microsoft
258 $search_prefixes{'^(dmoz|odp|mozilla)(| .*)$'} = 'dmoz'; # Mozilla Open Directory
259 $search_prefixes{'^(dp|dogpile)(| .*)$'} = 'dogpile'; # Dogpile
260 $search_prefixes{'^(ma|mamma)(| .*)$'} = 'mamma'; # Mamma
261 $search_prefixes{'^(wc|webcrawler)(| .*)$'} = 'webcrawler'; # Webcrawler
262 $search_prefixes{'^(ns|netscape)(| .*)$'} = 'netscape'; # Netscape
263 $search_prefixes{'^(ly|lycos)(| .*)$'} = 'lycos'; # Lycos
264 $search_prefixes{'^(hb|hotbot)(| .*)$'} = 'hotbot'; # Hotbot
265 $search_prefixes{'^(ex|excite)(| .*)$'} = 'excite'; # Excite
266 $search_prefixes{'^(eg|elgoog|hcraes|dnif|bew|og)(| .*)$'} = 'elgoog'; # Elgoog
267
268 sub search
269 {
270 my %search_engines =
271 (
272 "elgoog" => {
273 home => 'http://alltooflat.com/geeky/elgoog/m/index.cgi',
274 search => 'http://alltooflat.com/geeky/elgoog/m/index.cgi?page=%2fsearch&cgi=get&q='},
275 "google" => {
276 home => 'http://google.com!bork!',
277 search => 'http://google.com/search?!bork!q='},
278 "yahoo" => {
279 home => 'http://yahoo.com',
280 search => 'http://search.yahoo.com/search?p='},
281 "ask jeeves" => {
282 home => 'http://ask.com',
283 search => 'http://web.ask.com/web?q='},
284 "a9" => {
285 home => 'http://a9.com',
286 search => 'http://a9.com/?q='},
287 "altavista" => {
288 home => 'http://altavista.com',
289 search => 'http://altavista.com/web/results?q='},
290 "msn" => {
291 home => 'http://msn.com',
292 search => 'http://search.msn.com/results.aspx?q='},
293 "dmoz" => {
294 home => 'http://dmoz.org',
295 search => 'http://search.dmoz.org/cgi-bin/search?search='},
296 "dogpile" => {
297 home => 'http://dogpile.com',
298 search => 'http://dogpile.com/info.dogpl/search/web/'},
299 "mamma" => {
300 home => 'http://mamma.com',
301 search => 'http://mamma.com/Mamma?query='},
302 "webcrawler" => {
303 home => 'http://webcrawler.com',
304 search => 'http://webcrawler.com/info.wbcrwl/search/web/'},
305 "netscape" => {
306 home => 'http://search.netscape.com',
307 search => 'http://channels.netscape.com/ns/search/default.jsp?query='},
308 "lycos" => {
309 home => 'http://lycos.com',
310 search => 'http://search.lycos.com/default.asp?query='},
311 "hotbot" => {
312 home => 'http://hotbot.com',
313 search => 'http://hotbot.com/default.asp?query='},
314 "excite" => {
315 home => 'http://search.excite.com',
316 search => 'http://search.excite.com/info.xcite/search/web/'},
317 );
318
319 my ($engine, $search) = @_;
320 my $key = $search ? 'search' : 'home';
321 $engine = 'google' unless $search_engines{$engine}
322 and $search_engines{$engine}->{$key};
323 my $url = $search_engines{$engine}->{$key};
324 if ($engine eq 'google')
325 {
326 my $bork = '';
327 if (loadrc('bork') eq 'yes')
328 {
329 if (not $search)
330 {
331 $bork = "/webhp?hl=xx-bork";
332 }
333 else
334 {
335 $bork = "hl=xx-bork&";
336 }
337 }
338 $url =~ s/!bork!/$bork/;
339 }
340 if ($search)
341 {
342 $search =~ s/%/%25/g;
343 $search =~ s/&/%26/g;
344 $search =~ s/\s/%20/g;
345 $search =~ s/\+/%2b/g;
346 $search =~ s/#/%23/g;
347 $url .= $search;
348 }
349 return $url;
350 }
351
352 my ($search) = $url =~ /^\S+\s+(.*)/;
353 if ($url =~ /^(search|find|www|web|s|f|go)(| .*)$/)
354 {
355 return search(loadrc('search'), $search);
356 }
357 foreach my $prefix (keys %search_prefixes)
358 {
359 next unless $url =~ /$prefix/;
360 return search($search_prefixes{$prefix}, $search);
361 }
362
363
364 =over
365
366 =item News agencies:
367
368 =over
369
370 =item British Broadcasting Corporation: B<bbc> (default)
371
372 =item MSNBC: B<msnbc>
373
374 =item Cable News Network: B<cnn>
375
376 =item FOXNews: B<fox>
377
378 =item Google News: B<gn>
379
380 =item Yahoo News: B<yn>
381
382 =item Reuters: B<rs> or B<reuters>
383
384 =item Electronic Frontier Foundation: B<eff>
385
386 =item Wired: B<wd> or B<wired>
387
388 =item Slashdot: B</.> or B<sd> or B<slashdot>
389
390 =item NewsForge: B<nf> or B<newsforge>
391
392 =item U.S.News & World Report: B<us> or B<usnews>
393
394 =item New Scientist: B<newsci> or B<nsci>
395
396 =item Discover Magazine: B<dm>
397
398 =item Scientific American: B<sa> or B<sciam>
399
400 =back
401
402 default agency: B<n>, B<news>
403
404 =over
405
406 The I<%news_servers> hash maps each engine name to two URLs, I<home> and
407 I<search>. With I<search>, the query is appended to the mapped URL.
408
409 The news servers mapping is done by the I<news()> function, taking the search
410 engine name as its first parameter and optional search string as its second
411 parameter. It returns the mapped target URL.
412
413 =back
414
415 =back
416
417 =cut
418 ############################################################################
419 # News
420 my %news_prefixes;
421 $news_prefixes{'^bbc(| .*)$'} = 'bbc'; # British Broadcasting Corporation (default)
422 $news_prefixes{'^msnbc(| .*)$'} = 'msnbc'; # MSNBC
423 $news_prefixes{'^cnn(| .*)$'} = 'cnn'; # Cable News Network
424 $news_prefixes{'^fox(| .*)$'} = 'fox'; # FOXNews
425 $news_prefixes{'^gn(| .*)$'} = 'google'; # Google News
426 $news_prefixes{'^yn(| .*)$'} = 'yahoo'; # Yahoo News
427 $news_prefixes{'^(reuters|rs)(| .*)$'} = 'reuters'; # Reuters
428 $news_prefixes{'^eff(| .*)$'} = 'eff'; # Electronic Frontier Foundation
429 $news_prefixes{'^(wired|wd)(| .*)$'} = 'wired'; # Wired
430 $news_prefixes{'^(\/\.|slashdot|sd)(| .*)$'} = 'slashdot'; # Slashdot
431 $news_prefixes{'^(newsforge|nf)(| .*)$'} = 'newsforge'; # NewsForge
432 $news_prefixes{'^(us|usnews)(| .*)$'} = 'usnews'; # U.S.News & World Report
433 $news_prefixes{'^(nsci|newsci)(| .*)$'} = 'newsci'; # New Scientist
434 $news_prefixes{'^dm(| .*)$'} = 'discover'; # Discover Magazine
435 $news_prefixes{'^(sa|sciam)(| .*)$'} = 'sciam'; # Scientific American
436
437 sub news
438 {
439 my %news_servers =
440 (
441 "bbc" => {
442 home => 'http://news.bbc.co.uk',
443 search => 'http://newssearch.bbc.co.uk/cgi-bin/search/results.pl?q='},
444 "msnbc" => { # The bastard child of Microsoft and the National Broadcasting Corporation
445 home => 'http://msnbc.com',
446 search => 'http://msnbc.msn.com/?id=3053419&action=fulltext&querytext='},
447 "cnn" => {
448 home => 'http://cnn.com',
449 search => 'http://search.cnn.com/pages/search.jsp?query='},
450 "fox" => {
451 home => 'http://foxnews.com',
452 search => 'http://search.foxnews.com/info.foxnws/redirs_all.htm?pgtarg=wbsdogpile&qkw='},
453 "google" => {
454 home => 'http://news.google.com',
455 search => 'http://news.google.com/news?q='},
456 "yahoo" => {
457 home => 'http://news.yahoo.com',
458 search => 'http://news.search.yahoo.com/search/news/?p='},
459 "reuters" => {
460 home => 'http://reuters.com',
461 search => 'http://reuters.com/newsSearchResultsHome.jhtml?query='},
462 "eff" => {
463 home => 'http://eff.org',
464 search => 'http://google.com/search?sitesearch=http://eff.org&q='},
465 "wired" => {
466 home => 'http://wired.com',
467 search => 'http://search.wired.com/wnews/default.asp?query='},
468 "slashdot" => {
469 home => 'http://slashdot.org',
470 search => 'http://slashdot.org/search.pl?query='},
471 "newsforge" => {
472 home => 'http://newsforge.com',
473 search => 'http://newsforge.com/search.pl?query='},
474 "usnews" => {
475 home => 'http://usnews.com',
476 search => 'http://www.usnews.com/search/Search?keywords='},
477 "newsci" => {
478 home => 'http://newscientist.com',
479 search => 'http://www.newscientist.com/search.ns?doSearch=true&articleQuery.queryString='},
480 "discover" => {
481 home => 'http://discover.com',
482 search => 'http://www.discover.com/search-results/?searchStr='},
483 "sciam" => {
484 home => 'http://sciam.com',
485 search => 'http://sciam.com/search/index.cfm?QT=Q&SC=Q&Q='},
486 );
487
488 my ($server, $search) = @_;
489 my $key = $search ? 'search' : 'home';
490 $server = 'bbc' unless $news_servers{$server}
491 and $news_servers{$server}->{$key};
492 my $url = $news_servers{$server}->{$key};
493 $url .= $search if $search;
494 return $url;
495 }
496
497 if ($url =~ /^(news|n)(| .*)$/)
498 {
499 return news(loadrc('news'), $search);
500 }
501 foreach my $prefix (keys %news_prefixes)
502 {
503 next unless $url =~ /$prefix/;
504 return news($news_prefixes{$prefix}, $search);
505 }
506
507
508 =over
509
510 =item Locators:
511
512 =over
513
514 =item Internet Movie Database: B<imdb>, B<movie>, or B<flick>
515
516 =item US zip code search: B<zip> or B<usps> (# or address)
517
518 =item IP address locator / address space: B<ip>
519
520 =item WHOIS / TLD list: B<whois> (current url or specified)
521
522 =item Request for Comments: B<rfc> (# or search)
523
524 =item Weather: B<w> or B<weather>
525
526 =item Yahoo! Finance / NASD Regulation: B<stock>, B<ticker>, or B<quote>
527
528 =item Snopes: B<ul>, B<urban>, or B<legend>
529
530 =item Torrent search / ISOHunt: B<bt>, B<torrent>, or B<bittorrent>
531
532 =item Wayback Machine: B<ia>, B<ar>, B<arc>, or B<archive> (current url or specified)
533
534 =item Freshmeat: B<fm> or B<freshmeat>
535
536 =item SourceForge: B<sf> or B<sourceforge>
537
538 =item Savannah: B<sv> or B<savannah>
539
540 =item Gna!: B<gna>
541
542 =item BerliOS: B<bl> or B<berlios>
543
544 =item Netcraft Uptime Survey: B<whatis> or B<uptime> (current url or specified)
545
546 =item Who's Alive and Who's Dead: Wanted, B<dead> or B<alive>!
547
548 =item Google Library / Project Gutenberg: B<book> or B<read>
549
550 =item Internet Public Library: B<ipl>
551
552 =item VIM Tips: B<vt> (# or search)
553
554 =item Urban Dictionary: B<urbandict> or B<ud> <I<word>>
555
556 =back
557
558 =over
559
560 The I<%locators> hash maps each engine name to two URLs, I<home> and I<search>.
561
562 B<!current!> string in the URL is substitued for the URL of the current
563 document.
564
565 B<!query!> string in the I<search> URL is substitued for the search string. If
566 no B<!query!> string is found in the URL, the query is appended to the mapped
567 URL.
568
569 The locators mapping is done by the I<location()> function, taking the search
570 engine name as its first parameter, optional search string as its second
571 parameter and the current document's URL as its third parameter. It returns
572 the mapped target URL.
573
574 =back
575
576 =cut
577 ############################################################################
578 # Locators
579 my %locator_prefixes;
580 $locator_prefixes{'^(imdb|movie|flick)(| .*)$'} = 'imdb'; # Internet Movie Database
581 $locator_prefixes{'^(stock|ticker|quote)(| .*)$'} = 'stock'; # Yahoo! Finance / NASD Regulation
582 $locator_prefixes{'^(urban|legend|ul)(| .*)$'} = 'bs'; # Snopes
583 $locator_prefixes{'^(bittorrent|torrent|bt)(| .*)$'} = 'torrent'; # Torrent search / ISOHunt
584 $locator_prefixes{'^(archive|arc|ar|ia)(| .*)$'} = 'archive'; # Wayback Machine
585 $locator_prefixes{'^(freshmeat|fm)(| .*)$'} = 'freshmeat'; # Freshmeat
586 $locator_prefixes{'^(sourceforge|sf)(| .*)$'} = 'sourceforge'; # SourceForge
587 $locator_prefixes{'^(savannah|sv)(| .*)$'} = 'savannah'; # Savannah
588 $locator_prefixes{'^gna(| .*)$'} = 'gna'; # Gna!
589 $locator_prefixes{'^(berlios|bl)(| .*)$'} = 'berlios'; # BerliOS
590 $locator_prefixes{'^(alive|dead)(| .*)$'} = 'dead'; # Who's Alive and Who's Dead
591 $locator_prefixes{'^(book|read)(| .*)$'} = 'book'; # Google Library / Project Gutenberg
592 $locator_prefixes{'^ipl(| .*)$'} = 'ipl'; # Internet Public Library
593 $locator_prefixes{'^(urbandict|ud)(| .*)$'} = 'urbandict'; # Urban Dictionary
594 $locator_prefixes{'^ubs(| .*)$'} = 'ubs'; # Usenet binary search
595
596 my %weather_locators =
597 (
598 'weather underground' => 'http://wunderground.com/cgi-bin/findweather/getForecast?query=!query!',
599 'google' => 'http://google.com/search?q=weather+"!query!"',
600 'yahoo' => 'http://search.yahoo.com/search?p=weather+"!query!"',
601 'cnn' => 'http://weather.cnn.com/weather/search?wsearch=!query!',
602 'accuweather' => 'http://wwwa.accuweather.com/adcbin/public/us_getcity.asp?zipcode=!query!',
603 'ask jeeves' => 'http://web.ask.com/web?&q=weather !query!',
604 );
605
606 sub location
607 {
608 my %locators =
609 (
610 'imdb' => {
611 home => 'http://imdb.com',
612 search => 'http://imdb.com/Find?select=All&for='},
613 'stock' => {
614 home => 'http://nasdr.com',
615 search => 'http://finance.yahoo.com/l?s='},
616 'bs' => {
617 home => 'http://snopes.com',
618 search => 'http://search.atomz.com/search/?sp-a=00062d45-sp00000000&sp-q='},
619 'torrent' => {
620 home => 'http://isohunt.com',
621 search => 'http://google.com/search?q=filetype:torrent !query!!bork!'},
622 'archive' => {
623 home => 'http://web.archive.org/web/*/!current!',
624 search => 'http://web.archive.org/web/*/'},
625 'freshmeat' => {
626 home => 'http://freshmeat.net',
627 search => 'http://freshmeat.net/search/?q='},
628 'sourceforge' => {
629 home => 'http://sourceforge.net',
630 search => 'http://sourceforge.net/search/?q='},
631 'savannah' => {
632 home => 'http://savannah.nongnu.org',
633 search => 'http://savannah.nongnu.org/search/?type_of_search=soft&words='},
634 'gna' => {
635 home => 'http://gna.org',
636 search => 'https://gna.org/search/?type_of_search=soft&words='},
637 'berlios' => {
638 home => 'http://www.berlios.de',
639 search => 'http://developer.berlios.de/search/?type_of_search=soft&words='},
640 'dead' => {
641 home => 'http://www.whosaliveandwhosdead.com',
642 search => 'http://google.com/search?btnI&sitesearch=http://whosaliveandwhosdead.com&q='},
643 'book' => {
644 home => 'http://gutenberg.org',
645 search => 'http://google.com/search?q=book+"!query!"'},
646 'ipl' => {
647 home => 'http://ipl.org',
648 search => 'http://ipl.org/div/searchresults/?words='},
649 'urbandict' => {
650 home => 'http://urbandictionary.com/random.php',
651 search => 'http://urbandictionary.com/define.php?term='},
652 'ubs' => {
653 home => 'http://binsearch.info',
654 search => 'http://binsearch.info/?q='},
655 );
656
657 my ($server, $search, $current_url) = @_;
658 my $key = $search ? 'search' : 'home';
659 return unless $locators{$server} and $locators{$server}->{$key};
660 my $url = $locators{$server}->{$key};
661 my $bork = ""; $bork = "&hl=xx-bork" unless (loadrc("bork") ne "yes");
662 $url =~ s/!bork!/$bork/g;
663 $url =~ s/!current!/$current_url/g;
664 $url .= $search if $search and not $url =~ s/!query!/$search/g;
665 return $url;
666 }
667
668 foreach my $prefix (keys %locator_prefixes)
669 {
670 next unless $url =~ /$prefix/;
671 return location($locator_prefixes{$prefix}, $search, $current_url);
672 }
673
674 if ($url =~ '^(zip|usps)(| .*)$'
675 or $url =~ '^ip(| .*)$'
676 or $url =~ '^whois(| .*)$'
677 or $url =~ '^rfc(| .*)$'
678 or $url =~ '^(weather|w)(| .*)$'
679 or $url =~ '^(whatis|uptime)(| .*)$'
680 or $url =~ '^vt(| .*)$')
681 {
682 my ($thingy) = $url =~ /^[a-z]* (.*)/;
683 my ($domain) = $current_url =~ /([a-z0-9-]+\.(com|net|org|edu|gov|mil))/;
684
685 my $locator_zip = 'http://usps.com';
686 my $ipv = "ipv4-address-space"; $ipv = "ipv6-address-space" if loadrc("ipv6") eq "yes";
687 my $locator_ip = 'http://www.iana.org/assignments/' . $ipv;
688 my $whois = 'http://reports.internic.net/cgi/whois?type=domain&whois_nic=';
689 my $locator_whois = 'http://www.iana.org/cctld/cctld-whois.htm';
690 $locator_whois = $whois . $domain if $domain;
691 my $locator_rfc = 'http://ietf.org';
692 my $locator_weather = 'http://weather.noaa.gov';
693 my $locator_whatis = 'http://uptime.netcraft.com';
694 $locator_whatis = 'http://uptime.netcraft.com/up/graph/?host=' . $domain if $domain;
695 my $locator_vim = 'http://www.vim.org/tips';
696 if ($thingy)
697 {
698 $locator_zip = 'http://zip4.usps.com/zip4/zip_responseA.jsp?zipcode=' . $thingy;
699 $locator_zip = 'http://zipinfo.com/cgi-local/zipsrch.exe?zip=' . $thingy if $thingy !~ '^[0-9]*$';
700 $locator_ip = 'http://melissadata.com/lookups/iplocation.asp?ipaddress=' . $thingy;
701 $locator_whois = $whois . $thingy;
702 $locator_rfc = 'http://rfc-editor.org/cgi-bin/rfcsearch.pl?num=37&searchwords=' . $thingy;
703 $locator_rfc = 'http://ietf.org/rfc/rfc' . $thingy . '.txt' unless $thingy !~ '^[0-9]*$';
704 my $weather = loadrc("weather");
705 $locator_weather = $weather_locators{$weather};
706 $locator_weather ||= $weather_locators{'weather underground'};
707 $locator_weather =~ s/!query!/$thingy/;
708 $locator_whatis = 'http://uptime.netcraft.com/up/graph/?host=' . $thingy;
709 $locator_vim = 'http://www.vim.org/tips/tip_search_results.php?order_by=rating&keywords=' . $thingy;
710 $locator_vim = 'http://www.vim.org/tips/tip.php?tip_id=' . $thingy unless $thingy !~ '^[0-9]*$';
711 }
712 return $locator_zip if ($url =~ '^(zip|usps)(| .*)$');
713 return $locator_ip if ($url =~ '^ip(| .*)$');
714 return $locator_whois if ($url =~ '^whois(| .*)$');
715 return $locator_rfc if ($url =~ '^rfc(| .*)$');
716 return $locator_weather if ($url =~ '^(weather|w)(| .*)$');
717 return $locator_whatis if ($url =~ '^(whatis|uptime)(| .*)$');
718 return $locator_vim if ($url =~ '^vt(| .*)$');
719 }
720
721
722 =item Google Groups:
723
724 B<deja>, B<gg>, B<groups>, B<gr>, B<nntp>, B<usenet>, B<nn>
725
726 =cut
727 ############################################################################
728 # Google Groups (DejaNews)
729 if ($url =~ '^(deja|gg|groups|gr|nntp|usenet|nn)(| .*)$')
730 {
731 my ($search) = $url =~ /^[a-z]* (.*)/;
732 my $beta = "groups.google.co.uk";
733 $beta = "groups-beta.google.com" unless (loadrc("googlebeta") ne "yes");
734 my $bork = "";
735 if ($search)
736 {
737 $bork = "&hl=xx-bork" unless (loadrc("bork") ne "yes");
738 my ($msgid) = $search =~ /^<(.*)>$/;
739 return 'http://' . $beta . '/groups?as_umsgid=' . $msgid . $bork if $msgid;
740 return 'http://' . $beta . '/groups?q=' . $search . $bork;
741 }
742 else
743 {
744 $bork = "/groups?hl=xx-bork" unless (loadrc("bork") ne "yes");
745 return 'http://' . $beta . $bork;
746 }
747 }
748
749
750 =item MirrorDot:
751
752 B<md> or B<mirrordot> <I<URL>>
753
754 =cut
755 ############################################################################
756 # MirrorDot
757 if ($url =~ '^(mirrordot|md)(| .*)$')
758 {
759 my ($slashdotted) = $url =~ /^[a-z]* (.*)/;
760 if ($slashdotted)
761 {
762 return 'http://mirrordot.com/find-mirror.html?' . $slashdotted;
763 }
764 else
765 {
766 return 'http://mirrordot.com';
767 }
768 }
769
770
771 ############################################################################
772 # The Bastard Operator from Hell
773 if ($url =~ '^bofh$')
774 {
775 return 'http://prime-mover.cc.waikato.ac.nz/Bastard.html';
776 }
777
778
779 =item Coral cache:
780
781 B<cc>, B<coral>, or B<nyud> <I<URL>>
782
783 =cut
784 ############################################################################
785 # Coral cache <URL>
786 if ($url =~ '^(coral|cc|nyud)( .*)$')
787 {
788 my ($cache) = $url =~ /^[a-z]* (.*)/;
789 $cache =~ s/^http:\/\///;
790 ($url) = $cache =~ s/\//.nyud.net:8090\//;
791 return 'http://' . $cache;
792 }
793
794
795 =item AltaVista Babelfish:
796
797 B<babelfish>, B<babel>, B<bf>, B<translate>, B<trans>, or B<b> <I<from>> <I<to>>
798
799 "babelfish german english" or "bf de en"
800
801 =cut
802 ############################################################################
803 # AltaVista Babelfish ("babelfish german english" or "bf de en")
804 if (($url =~ '^(babelfish|babel|bf|translate|trans|b)(| [a-zA-Z]* [a-zA-Z]*)$')
805 or ($url =~ '^(babelfish|babel|bf|translate|trans|b)(| [a-zA-Z]*(| [a-zA-Z]*))$'
806 and loadrc("language") and $current_url))
807 {
808 $url = 'http://babelfish.altavista.com' if ($url =~ /^[a-z]*$/);
809 if ($url =~ /^[a-z]* /)
810 {
811 my $tongue = loadrc("language");
812 $url = $url . " " . $tongue if ($tongue ne "no" and $url !~ /^[a-z]* [a-zA-Z]* [a-zA-Z]*$/);
813 $url =~ s/ chinese/ zt/i;
814 $url =~ s/ dutch/ nl/i;
815 $url =~ s/ english/ en/i;
816 $url =~ s/ french/ fr/i;
817 $url =~ s/ german/ de/i;
818 $url =~ s/ greek/ el/i;
819 $url =~ s/ italian/ it/i;
820 $url =~ s/ japanese/ ja/i;
821 $url =~ s/ korean/ ko/i;
822 $url =~ s/ portugese/ pt/i;
823 $url =~ s/ russian/ ru/i;
824 $url =~ s/ spanish/ es/i;
825 my ($from_language, $to_language) = $url =~ /^[a-z]* (.*) (.*)$/;
826 ($current_url) = $current_url =~ /^.*:\/\/(.*)/;
827 $url = 'http://babelfish.altavista.com/babelfish/urltrurl?lp='
828 . $from_language . '_' . $to_language . '&url=http%3A%2F%2F' . $current_url;
829 }
830 return $url;
831 }
832
833
834 ############################################################################
835 # XYZZY
836 if ($url =~ '^xyzzy$')
837 {
838 # $url = 'http://sundae.triumf.ca/pub2/cave/node001.html';
839 srand();
840 my $yzzyx;
841 my $xyzzy = int(rand(8));
842 $yzzyx = 1 if ($xyzzy == 0); # Colossal Cave Adventure
843 $yzzyx = 2 if ($xyzzy == 1); # Dungeon
844 $yzzyx = 227 if ($xyzzy == 2); # Zork Zero: The Revenge of Megaboz
845 $yzzyx = 3 if ($xyzzy == 3); # Zork I: The Great Underground Empire
846 $yzzyx = 4 if ($xyzzy == 4); # Zork II: The Wizard of Frobozz
847 $yzzyx = 5 if ($xyzzy == 5); # Zork III: The Dungeon Master
848 $yzzyx = 6 if ($xyzzy == 6); # Zork: The Undiscovered Underground
849 $yzzyx = 249 if ($xyzzy == 7); # Hunt the Wumpus
850 return 'http://ifiction.org/games/play.php?game=' . $yzzyx;
851 }
852
853
854 ############################################################################
855 # ...and now, Deep Thoughts. by Jack Handey
856 if ($url =~ '^(jack|handey)$')
857 {
858 return 'http://glug.com/handey';
859 }
860
861
862 =item W3C page validators:
863
864 B<vhtml> or B<vcss> <I<URL>> (or current url)
865
866 =cut
867 ############################################################################
868 # Page validators [<URL>]
869 if ($url =~ '^vhtml(| .*)$' or $url =~ '^vcss(| .*)$')
870 {
871 my ($page) = $url =~ /^.* (.*)/;
872 $page = $current_url unless $page;
873 return 'http://validator.w3.org/check?uri=' . $page if $url =~ 'html';
874 return 'http://jigsaw.w3.org/css-validator/validator?uri=' . $page if $url =~ 'css';
875 }
876
877
878 =item ELinks:
879
880 =over
881
882 =item Home: B<el> or B<elinks>
883
884 =item Bugzilla: B<bz> or B<bug> (# or search optional)
885
886 =item Documentation and FAQ: B<doc(|s|umentation)> or B<faq>
887
888 =back
889
890 There's no place like home...
891
892 =cut
893 ############################################################################
894 # There's no place like home
895 if ($url =~ '^(el(|inks)|b(ug(|s)|z)(| .*)|doc(|umentation|s)|faq|help|manual)$')
896 {
897 my ($bug) = $url =~ /^.* (.*)/;
898 if ($url =~ '^b')
899 {
900 my $bugzilla = 'http://bugzilla.elinks.cz';
901 if (not $bug)
902 {
903 if (loadrc("email"))
904 {
905 $bugzilla = $bugzilla .
906 '/buglist.cgi?bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&email1='
907 . loadrc("email") . '&emailtype1=exact&emailassigned_to1=1&emailreporter1=1';
908 }
909 return $bugzilla;
910 }
911 elsif ($bug =~ '^[0-9]*$')
912 {
913 return $bugzilla . '/show_bug.cgi?id=' . $bug;
914 }
915 else
916 {
917 return $bugzilla . '/buglist.cgi?short_desc_type=allwordssubstr&short_desc=' . $bug;
918 }
919 }
920 else
921 {
922 my $doc = '';
923 $doc = '/documentation' if $url =~ '^doc';
924 $doc = '/faq.html' if $url =~ '^(faq|help)$';
925 $doc = '/documentation/html/manual.html' if $url =~ '^manual$';
926 return 'http://elinks.cz' . $doc;
927 }
928 }
929
930
931 =item The Dialectizer:
932
933 B<dia> <I<dialect>> <I<URL>> (or current url)
934
935 Dialects: I<redneck>, I<jive>, I<cockney>, I<fudd>, I<bork>, I<moron>, I<piglatin>, or I<hacker>
936
937 =cut
938 ############################################################################
939 # the Dialectizer (dia <dialect> <url>)
940 if ($url =~ '^dia(| [a-z]*(| .*))$')
941 {
942 my ($dialect) = $url =~ /^dia ([a-z]*)/;
943 $dialect = "hckr" if $dialect and $dialect eq 'hacker';
944 my ($victim) = $url =~ /^dia [a-z]* (.*)$/;
945 $victim = $current_url if (!$victim and $current_url and $dialect);
946 $url = 'http://rinkworks.com/dialect';
947 if ($dialect and $dialect =~ '^(redneck|jive|cockney|fudd|bork|moron|piglatin|hckr)$' and $victim)
948 {
949 $victim =~ s/^http:\/\///;
950 $url = $url . '/dialectp.cgi?dialect=' . $dialect . '&url=http%3a%2f%2f' . $victim . '&inside=1';
951 }
952 return $url;
953 }
954
955
956 =item Sender:
957
958 B<send>
959
960 =over
961
962 Send the current URL to the application specified by the configuration variable
963 'I<external>'. Optionally, override this by specifying the application as in
964 'I<send> <I<application>>'.
965
966 =back
967
968 =cut
969 ############################################################################
970 # send the current URL to another application
971 if ($url =~ '^send(| .*)$' and $current_url)
972 {
973 my ($external) = $url =~ /^send (.*)/;
974 if ($external)
975 {
976 system($external . ' "' . $current_url . '" 2>/dev/null &');
977 return $current_url; #FIXME
978 #return;
979 }
980 else
981 {
982 if (loadrc("external"))
983 {
984 system(loadrc("external") . ' "' . $current_url . '" 2>/dev/null &');
985 return $current_url; #FIXME
986 #return;
987 }
988 }
989 }
990
991
992 =item Dictionary:
993
994 B<dict>, B<d>, B<def>, or B<define> <I<word>>
995
996 =cut
997 ############################################################################
998 # Dictionary
999 if ($url =~ '^(dict|d|def|define)(| .*)$')
1000 {
1001 my $dict = 'http://dict.org/bin/Dict?Form=Dict1&Strategy=*&Database=*&Query=';
1002 my ($word) = $url =~ /^[a-z]* (.*)/;
1003 unless ($word)
1004 {
1005 open FILE, '</usr/share/dict/words'
1006 or open FILE, '</usr/share/dict/linux.words'
1007 or open FILE, '</usr/dict/words'
1008 or open FILE, '</usr/dict/linux.words'
1009 or open FILE, '</usr/share/dict/yawl.list'
1010 or return 'http://ypass.net/dictionary/index.html?random=1';
1011 rand($.) < 1 && ($word = $_) while <FILE>;
1012 close FILE;
1013 }
1014 return $dict . $word;
1015 }
1016
1017
1018 =item Google site search
1019
1020 B<ss> <I<domain>> <I<string>>
1021
1022 =over
1023
1024 Use Google to search the current site or a specified site. If a domain is not
1025 given, use the current one.
1026
1027 =back
1028
1029 =cut
1030 ############################################################################
1031 # Google site search
1032 if ($url =~ '^ss(| .*)$')
1033 {
1034 my ($site, $search) = $url =~ /^ss\s(\S+)\s(.*)/;
1035 if (isurl($site) =~ 'false')
1036 {
1037 $search = $site . $search if $site;
1038 $site = undef;
1039 }
1040 unless ($site and $search)
1041 {
1042 ($search) = $url =~ /^ss\s(.*)/;
1043 $site = $current_url if $current_url and $current_url !~ '^file://';
1044 }
1045 if ($site and $search and $site ne 1 and $search ne 1)
1046 {
1047 return 'http://google.com/search?sitesearch=' . $site . '&q=' . $search;
1048 }
1049 return $current_url; #FIXME
1050 #return;
1051 }
1052
1053
1054 =item Anything not a prefix, URL, or local file will be treated as a search
1055 using the search engine defined by the 'search' configuration option if
1056 'gotosearch' is set to some variation of 'yes'.
1057
1058 =cut
1059 ############################################################################
1060 # Anything not otherwise useful is a search
1061 if ($current_url and loadrc("gotosearch") eq "yes")
1062 {
1063 return search(loadrc("search"), $url) if isurl($url) =~ 'false';
1064 }
1065
1066
1067 return $url;
1068 }
1069
1070
1071 =back
1072
1073
1074 =head1 FOLLOW URL HOOK
1075
1076 These hooks effect a URL before ELinks has a chance to load it.
1077
1078 =over
1079
1080 I<Developer's usage>: The function I<follow_url_hook> is called when the hook
1081 is triggered, taking the target URL as its only argument. It returns the final
1082 target URL.
1083
1084 =cut
1085 ################################################################################
1086 ### follow_url_hook ############################################################
1087 sub follow_url_hook
1088 {
1089 my $url = shift;
1090
1091 =item Bork! Bork! Bork!
1092
1093 Rewrites many I<google.com> URLs.
1094
1095 =cut
1096 # Bork! Bork! Bork!
1097 if ($url =~ 'google\.com' and loadrc("bork") eq "yes")
1098 {
1099 if ($url =~ '^http://(|www\.|search\.)google\.com(|/search)(|/)$')
1100 {
1101 return 'http://google.com/webhp?hl=xx-bork';
1102 }
1103 elsif ($url =~ '^http://(|www\.)groups\.google\.com(|/groups)(|/)$'
1104 or $url =~ '^http://(|www\.|search\.)google\.com/groups(|/)$')
1105 {
1106 return 'http://google.com/groups?hl=xx-bork';
1107 }
1108 }
1109
1110 =item NNTP over Google
1111
1112 Translates any I<nntp:> or I<news:> URLs to Google Groups HTTP URLs.
1113
1114 =cut
1115 # nntp? try Google Groups
1116 if ($url =~ '^(nntp|news):' and loadrc("usenet") ne "standard")
1117 {
1118 my $beta = "groups.google.co.uk";
1119 $beta = "groups-beta.google.com" unless (loadrc("googlebeta") ne "yes");
1120 $url =~ s/\///g;
1121 my ($group) = $url =~ /[a-zA-Z]:(.*)/;
1122 my $bork = "";
1123 $bork = "hl=xx-bork&" unless (loadrc("bork") ne "yes");
1124 return 'http://' . $beta . '/groups?' . $bork . 'group=' . $group;
1125 }
1126
1127 # strip trailing spaces
1128 $url =~ s/\s*$//;
1129
1130 return $url;
1131 }
1132
1133
1134 =back
1135
1136
1137 =head1 PRE FORMAT HTML HOOK
1138
1139 When an HTML document is downloaded and is about to undergo the final
1140 rendering, this hook is called. This is frequently used to get rid of ads, but
1141 also various ELinks-unfriendly HTML code and HTML snippets which are irrelevant
1142 to ELinks but can obfuscate the rendered document.
1143
1144 Note that these hooks are applied B<only> before the final rendering, not
1145 before the gradual re-renderings which happen when only part of the document is
1146 available.
1147
1148 =over
1149
1150 I<Developer's usage>: The function I<pre_format_html_hook> is called when the
1151 hook is triggered, taking the document's URL and the HTML source as its two
1152 arguments. It returns the rewritten HTML code.
1153
1154 =cut
1155 ################################################################################
1156 ### pre_format_html_hook #######################################################
1157 sub pre_format_html_hook
1158 {
1159 my $url = shift;
1160 my $html = shift;
1161 # my $content_type = shift;
1162
1163
1164 =item Slashdot Sanitation
1165
1166 Kills Slashdot's Advertisements. (This one is disabled due to weird behavior
1167 with fragments.)
1168
1169 =cut
1170 # /. sanitation
1171 if ($url =~ 'slashdot\.org')
1172 {
1173 # $html =~ s/^<!-- Advertisement code. -->.*<!-- end ad code -->$//sm;
1174 # $html =~ s/<iframe.*><\/iframe>//g;
1175 # $html =~ s/<B>Advertisement<\/B>//;
1176 }
1177
1178
1179 =item Obvious Google Tips Annihilator
1180
1181 Kills some irritating Google tips.
1182
1183 =cut
1184 # yes, I heard you the first time
1185 if ($url =~ 'google\.com')
1186 {
1187 $html =~ s/Teep: In must broosers yuoo cun joost heet zee retoorn key insteed ooff cleecking oon zee seerch boottun\. Bork bork bork!//;
1188 $html =~ s/Tip:<\/font> Save time by hitting the return key instead of clicking on "search"/<\/font>/;
1189 }
1190
1191
1192 =item SourceForge AdSmasher
1193
1194 Wipes out SourceForge's Ads.
1195
1196 =cut
1197 # SourceForge ad smasher
1198 if ($url =~ 'sourceforge\.net')
1199 {
1200 $html =~ s/<!-- AD POSITION \d+ -->.*?<!-- END AD POSITION \d+ -->//smg;
1201 $html =~ s/<b>&nbsp\;&nbsp\;&nbsp\;Site Sponsors<\/b>//g;
1202 }
1203
1204
1205 =item Gmail's Experience
1206
1207 Gmail has obviously never met ELinks...
1208
1209 =cut
1210 # Gmail has obviously never met ELinks
1211 if ($url =~ 'gmail\.google\.com')
1212 {
1213 $html =~ s/^<b>For a better Gmail experience, use a.+?Learn more<\/a><\/b>$//sm;
1214 }
1215
1216
1217 =item Source readability improvements
1218
1219 Rewrites some evil characters to entities and vice versa. These will be
1220 disabled until such time as pre_format_html_hook only gets called for
1221 content-type:text/html.
1222
1223 =cut
1224 # demoronizer
1225 # if ($content_type =~ 'text/html')
1226 # {
1227 # $html =~ s/Ñ/\&mdash;/g;
1228 # $html =~ s/\&#252/ü/g;
1229 # $html =~ s/\&#039(?!;)/'/g;
1230 # $html =~ s/]\n>$//gsm;
1231 #$html =~ s/%5B/[/g;
1232 #$html =~ s/%5D/]/g;
1233 #$html =~ s/%20/ /g;
1234 #$html =~ s/%2F/\//g;
1235 #$html =~ s/%23/#/g;
1236 # }
1237
1238
1239 return $html;
1240 }
1241
1242
1243 =back
1244
1245
1246 =head1 PROXY FOR HOOK
1247
1248 The Perl hooks are asked whether to use a proxy for a given URL (or what proxy
1249 to actually use). You can use it if you don't want to use a proxy for certain
1250 Intranet servers but you need to use it in order to get to the Internet, or if
1251 you want to use some anonymizer for access to certain sites.
1252
1253 =over
1254
1255 I<Developer's usage>: The function I<proxy_for_hook> is called when the hook is
1256 triggered, taking the target URL as its only argument. It returns the proxy
1257 URL, empty string to use no proxy or I<undef> to use the default proxy URL.
1258
1259 =cut
1260 ################################################################################
1261 ### proxy_for_hook #############################################################
1262 sub proxy_for_hook
1263 {
1264 my $url = shift;
1265
1266
1267 =item No proxy for local files
1268
1269 Prevents proxy usage for local files and C<http://localhost>.
1270
1271 =cut
1272 # no proxy for local files
1273 if ($url =~ '^(file://|(http://|)(localhost|127\.0\.0\.1)(/|:|$))')
1274 {
1275 return "";
1276 }
1277
1278 return;
1279 }
1280
1281
1282 =back
1283
1284
1285 =head1 QUIT HOOK
1286
1287 The Perl hooks can also perform various actions when ELinks quits. These can
1288 be things like retouching the just saved "information files", or doing some fun
1289 stuff.
1290
1291 =over
1292
1293 I<Developer's usage>: The function I<quit_hook> is called when the hook is
1294 triggered, taking no arguments nor returning anything. ('cause, you know, what
1295 would be the point?)
1296
1297 =cut
1298 ################################################################################
1299 ### quit_hook ##################################################################
1300 sub quit_hook
1301 {
1302
1303
1304 =item Collapse XBEL Folders
1305
1306 Collapses XBEL bookmark folders. This is obsoleted by
1307 I<bookmarks.folder_state>.
1308
1309 =cut
1310 # collapse XBEL bookmark folders (obsoleted by bookmarks.folder_state)
1311 my $bookmarkfile = $ENV{'HOME'} . '/.elinks/bookmarks.xbel';
1312 if (-f $bookmarkfile and loadrc('collapse') eq 'yes')
1313 {
1314 open BOOKMARKS, "+<$bookmarkfile";
1315 my $bookmark;
1316 while (<BOOKMARKS>)
1317 {
1318 s/<folder folded="no">/<folder folded="yes">/;
1319 $bookmark .= $_;
1320 }
1321 seek(BOOKMARKS, 0, 0);
1322 print BOOKMARKS $bookmark;
1323 truncate(BOOKMARKS, tell(BOOKMARKS));
1324 close BOOKMARKS;
1325 }
1326
1327
1328 =item Words of Wisdom
1329
1330 A few words of wisdom from ELinks the Sage.
1331
1332 =cut
1333 # words of wisdom from ELinks the Sage
1334 if (loadrc('fortune') eq 'fortune')
1335 {
1336 system('echo ""; fortune -sa 2>/dev/null');
1337 die;
1338 }
1339 die if (loadrc('fortune') =~ /^(none|quiet)$/);
1340 my $cookiejar = 'elinks.fortune';
1341 my $ohwhynot = `ls /usr/share/doc/elinks*/$cookiejar 2>/dev/null`;
1342 open COOKIES, $ENV{"HOME"} . '/.elinks/' . $cookiejar
1343 or open COOKIES, '/etc/elinks/' . $cookiejar
1344 or open COOKIES, '/usr/share/elinks/' . $cookiejar
1345 or open COOKIES, $ohwhynot
1346 or die system('echo ""; fortune -sa 2>/dev/null');
1347 my (@line, $fortune);
1348 $line[0] = 0;
1349 while (<COOKIES>)
1350 {
1351 $line[$#line + 1] = tell if /^%$/;
1352 }
1353 srand();
1354 while (not $fortune)
1355 {
1356 seek(COOKIES, $line[int rand($#line + 1)], 0);
1357 while (<COOKIES>)
1358 {
1359 last if /^%$/;
1360 $fortune .= $_;
1361 }
1362 }
1363 close COOKIES;
1364 print "\n", $fortune;
1365 }
1366
1367
1368 =back
1369
1370
1371 =head1 SEE ALSO
1372
1373 elinks(1), perl(1)
1374
1375
1376 =head1 AUTHORS
1377
1378 Russ Rowan, Petr Baudis
1379
1380 =cut
1381
1382
1383
1384 sub isurl
1385 {
1386 my ($url) = @_;
1387 return 'false' if not $url;
1388 opendir(DIR, '.');
1389 my @files = readdir(DIR);
1390 closedir(DIR);
1391 foreach my $file (@files)
1392 {
1393 return 'true' if $url eq $file;
1394 }
1395 return 'true' if $url =~ /^(\/|~)/;
1396 return 'true' if $url =~ /([0-9]{1,3}\.){3}[0-9]{1,3}($|\/|\?|:[0-9]{1,5})/;
1397 return 'true' if $url =~ /^((::|)[[:xdigit:]]{1,4}(:|::|)){1,8}($|\/|\?|:[0-9]{1,5})/ and $url =~ /:/;
1398 if ( $url =~ /^(([a-zA-Z]{3,}(|4|6):\/\/|(www|ftp)\.)|)[a-zA-Z0-9]+/
1399 and ($url =~ /[a-zA-Z0-9-]+\.(com|org|net|edu|gov|int|mil)($|\/|\?|:[0-9]{1,5})/
1400 or $url =~ /[a-zA-Z0-9-]+\.(biz|info|name|pro|aero|coop|museum)($|\/|\?|:[0-9]{1,5})/
1401 or $url =~ /[a-zA-Z0-9-]+\.[a-zA-Z]{2}($|\/|\?|:[0-9]{1,5})/))
1402 {
1403 return 'true';
1404 }
1405 return 'true' if $url =~ /^about:/;
1406
1407 return 'false';
1408 }
1409
1410
1411
1412 # vim: ts=4 sw=4 sts=0 nowrap
The ultimate text WWW browser