contrib/perl/hooks.pl

   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