# Example ~/.elinks/hooks.pl # # Copyleft by Russ Rowan (See the file "COPYING" for details.) # # To get documentation for this file: # pod2html hooks.pl > hooks.html && elinks hooks.html # or # perldoc hooks.pl =head1 NAME hooks.pl -- Perl hooks for the ELinks text WWW browser =head1 DESCRIPTION This file contains the Perl hooks for the ELinks text WWW browser. These hooks change the browser's behavior in various ways. They allow shortcuts to be used in the Goto URL dialog, modifying the source of a page, proxy handling, and other things such as displaying a fortune at exit. =cut use strict; use warnings; use diagnostics; =head1 CONFIGURATION FILE This hooks file reads its configuration from I<~/.elinks/config.pl>. The following is an example of the configuration file: bork: yep # BORKify Google? collapse: okay # Collapse all XBEL bookmark folders on exit? email: # Set to show one's own bugs with the "bug" prefix. external: wget # Send the current URL to this application. fortune: elinks # *fortune*, *elinks* tip, or *none* on quit? googlebeta: hell no # I miss DejaNews... gotosearch: why not # Anything not a URL in the Goto URL dialog... ipv6: sure # IPV4 or 6 address blocks with "ip" prefix? language: english # "bf nl en" still works, but now "bf nl" does too news: msnbc # Agency to use for "news" and "n" prefixes search: elgoog # Engine for (search|find|www|web|s|f|go) prefixes usenet: google # *google* or *standard* view for news:// URLs weather: cnn # Server for "weather" and "w" prefixes # news: bbc, msnbc, cnn, fox, google, yahoo, reuters, eff, wired, # slashdot, newsforge, usnews, newsci, discover, sciam # search: elgoog, google, yahoo, ask jeeves, a9, altavista, msn, dmoz, # dogpile, mamma, webcrawler, netscape, lycos, hotbot, excite # weather: weather underground, google, yahoo, cnn, accuweather, # ask jeeves I: The function I takes a preference name as its single argument and returns either an empty string if it is not specified, I for a true value (even if specified like I or I), I for a false value (even if like I, I or I<0>), or the lowercased preference value (like I for C). =cut sub loadrc($) { my ($preference) = @_; my $configperl = $ENV{'HOME'} . '/.elinks/config.pl'; my $answer = ''; open RC, "<$configperl" or return $answer; while () { s/\s*#.*$//; next unless (m/(.*):\s*(.*)/); my $setting = $1; my $switch = $2; next unless ($setting eq $preference); if ($switch =~ /^(yes|1|on|yea|yep|sure|ok|okay|yeah|why.*not)$/) { $answer = "yes"; } elsif ($switch =~ /^(no|0|off|nay|nope|nah|hell.*no)$/) { $answer = "no"; } else { $answer = lc($switch); } } close RC; return $answer; } =head1 GOTO URL HOOK This is a summary of the shortcuts defined in this file for use in the Goto URL dialog. They are similar to the builtin URL prefixes, but more flexible and powerful. =over I: The function I is called when the hook is triggered, taking the target URL and current URL as its two arguments. It returns the final target URL. These routines do a name->URL mapping - for example, the I described above maps a certain prefix to C and then asks the I mapping routine described below to map the C string to an appropriate URL. There are generally two URLs for each name. One to go to the particular URL's main page, and another for a search on the given site (if any string is specified after the prefix). A few of these prefixes will change their behavior depending on the URL currently beung displayed in the browser. =cut # Don't call them "dumb". They hate that. Rather, "interactivity challenged". ################################################################################ ### goto_url_hook ############################################################## sub goto_url_hook { my $url = shift; my $current_url = shift; =item Bugmenot: B or B =cut ############################################################################ # "bugmenot" (no blood today, thank you) if ($url =~ '^(bugmenot|bn)$' and $current_url) { ($current_url) = $current_url =~ /^.*:\/\/(.*)/; my $bugmenot = 'http://bugmenot.com/view.php?url=' . $current_url; #my $tempfile = $ENV{'HOME'} . '/.elinks/elinks'; #my $matrix = '1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'; #for (0..int(rand(7) + 9)) #{ #$tempfile = $tempfile . substr($matrix, (length($matrix) - 1) - rand(length($matrix) + 1), 1); #} #my ($message, $login, $password); #system('elinks -no-home -source "' . $bugmenot . '" >' . $tempfile . ' 2>/dev/null'); #open FILE, "<$tempfile" or return $bugmenot; #$message = ; #while () #{ #next unless (m/^
(.*)
(.*)<\/dd><\/dl>$/); #$login = $1; #$password = $2; #} #$login =~ s/(^\s*|\n|\s*$)//g if $login; #$password =~ s/(^\s*|\n|\s*$)//g if $password; #close FILE; #unlink $tempfile; #return $bugmenot unless $message =~ /[a-z]+/ and $message !~ /404/; #unless ($message =~ s/.*(No accounts found\.).*/${1}/) #{ #if ($login and $password) #{ #$message = "Login: " . $login . "\nPassword: " . $password; #} #else #{ #$message = 'No accounts found'; #} #} #system('elinks -remote "infoBox\(' . $message . ')" >/dev/null 2>&1 &'); #return $current_url; #FIXME ##return; return $bugmenot . $current_url; } ############################################################################ # Random URL generator if ($url eq 'bored' or $url eq 'random') { my $word; # You can say *that* again... srand(); open FILE, '; close FILE; ($word) = $word =~ /(.*)/; return 'http://' . lc($word) . '.com'; } =item Web search: =over =item Google: B or B (default) =item Yahoo: B or B =item Ask Jeeves: B or B =item Amazon A9: B =item Altavista: B or B =item Microsoft: B or B =item Mozilla Open Directory: B, B, B =item Dogpile: B or B =item Mamma: B or B =item Webcrawler: B or B =item Netscape: B or B =item Lycos: B or B =item Hotbot: B or B =item Excite: B or B =item Elgoog: B, B, B, B, B, B =back default engine: B, B, B, B, B, B, B =over The I<%search_engines> hash maps each engine name to two URLs, I and I. With I, the query is appended to the URL. The search engines mapping is done by the I function, taking the search engine name as its first parameter and optional search string as its second parameter. It returns the mapped target URL. =back =back =cut ############################################################################ # Search engines my %search_prefixes; $search_prefixes{'^(g|google)(| .*)$'} = 'google'; # Google (default) $search_prefixes{'^(y|yahoo)(| .*)$'} = 'yahoo'; # Yahoo $search_prefixes{'^(ask|jeeves)(| .*)$'} = 'ask jeeves'; # Ask Jeeves $search_prefixes{'^a9(| .*)$'} = 'a9'; # Amazon A9 $search_prefixes{'^(av|altavista)(| .*)$'} = 'altavista'; # Altavista $search_prefixes{'^(msn|microsoft)(| .*)$'} = 'msn'; # Microsoft $search_prefixes{'^(dmoz|odp|mozilla)(| .*)$'} = 'dmoz'; # Mozilla Open Directory $search_prefixes{'^(dp|dogpile)(| .*)$'} = 'dogpile'; # Dogpile $search_prefixes{'^(ma|mamma)(| .*)$'} = 'mamma'; # Mamma $search_prefixes{'^(wc|webcrawler)(| .*)$'} = 'webcrawler'; # Webcrawler $search_prefixes{'^(ns|netscape)(| .*)$'} = 'netscape'; # Netscape $search_prefixes{'^(ly|lycos)(| .*)$'} = 'lycos'; # Lycos $search_prefixes{'^(hb|hotbot)(| .*)$'} = 'hotbot'; # Hotbot $search_prefixes{'^(ex|excite)(| .*)$'} = 'excite'; # Excite $search_prefixes{'^(eg|elgoog|hcraes|dnif|bew|og)(| .*)$'} = 'elgoog'; # Elgoog sub search { my %search_engines = ( "elgoog" => { home => 'http://alltooflat.com/geeky/elgoog/m/index.cgi', search => 'http://alltooflat.com/geeky/elgoog/m/index.cgi?page=%2fsearch&cgi=get&q='}, "google" => { home => 'http://google.com!bork!', search => 'http://google.com/search?!bork!q='}, "yahoo" => { home => 'http://yahoo.com', search => 'http://search.yahoo.com/search?p='}, "ask jeeves" => { home => 'http://ask.com', search => 'http://web.ask.com/web?q='}, "a9" => { home => 'http://a9.com', search => 'http://a9.com/?q='}, "altavista" => { home => 'http://altavista.com', search => 'http://altavista.com/web/results?q='}, "msn" => { home => 'http://msn.com', search => 'http://search.msn.com/results.aspx?q='}, "dmoz" => { home => 'http://dmoz.org', search => 'http://search.dmoz.org/cgi-bin/search?search='}, "dogpile" => { home => 'http://dogpile.com', search => 'http://dogpile.com/info.dogpl/search/web/'}, "mamma" => { home => 'http://mamma.com', search => 'http://mamma.com/Mamma?query='}, "webcrawler" => { home => 'http://webcrawler.com', search => 'http://webcrawler.com/info.wbcrwl/search/web/'}, "netscape" => { home => 'http://search.netscape.com', search => 'http://channels.netscape.com/ns/search/default.jsp?query='}, "lycos" => { home => 'http://lycos.com', search => 'http://search.lycos.com/default.asp?query='}, "hotbot" => { home => 'http://hotbot.com', search => 'http://hotbot.com/default.asp?query='}, "excite" => { home => 'http://search.excite.com', search => 'http://search.excite.com/info.xcite/search/web/'}, ); my ($engine, $search) = @_; my $key = $search ? 'search' : 'home'; $engine = 'google' unless $search_engines{$engine} and $search_engines{$engine}->{$key}; my $url = $search_engines{$engine}->{$key}; if ($engine eq 'google') { my $bork = ''; if (loadrc('bork') eq 'yes') { if (not $search) { $bork = "/webhp?hl=xx-bork"; } else { $bork = "hl=xx-bork&"; } } $url =~ s/!bork!/$bork/; } if ($search) { $search =~ s/%/%25/g; $search =~ s/&/%26/g; $search =~ s/\s/%20/g; $search =~ s/\+/%2b/g; $search =~ s/#/%23/g; $url .= $search; } return $url; } my ($search) = $url =~ /^\S+\s+(.*)/; if ($url =~ /^(search|find|www|web|s|f|go)(| .*)$/) { return search(loadrc('search'), $search); } foreach my $prefix (keys %search_prefixes) { next unless $url =~ /$prefix/; return search($search_prefixes{$prefix}, $search); } =over =item News agencies: =over =item British Broadcasting Corporation: B (default) =item MSNBC: B =item Cable News Network: B =item FOXNews: B =item Google News: B =item Yahoo News: B =item Reuters: B or B =item Electronic Frontier Foundation: B =item Wired: B or B =item Slashdot: B or B or B =item NewsForge: B or B =item U.S.News & World Report: B or B =item New Scientist: B or B =item Discover Magazine: B =item Scientific American: B or B =back default agency: B, B =over The I<%news_servers> hash maps each engine name to two URLs, I and I. With I, the query is appended to the mapped URL. The news servers mapping is done by the I function, taking the search engine name as its first parameter and optional search string as its second parameter. It returns the mapped target URL. =back =back =cut ############################################################################ # News my %news_prefixes; $news_prefixes{'^bbc(| .*)$'} = 'bbc'; # British Broadcasting Corporation (default) $news_prefixes{'^msnbc(| .*)$'} = 'msnbc'; # MSNBC $news_prefixes{'^cnn(| .*)$'} = 'cnn'; # Cable News Network $news_prefixes{'^fox(| .*)$'} = 'fox'; # FOXNews $news_prefixes{'^gn(| .*)$'} = 'google'; # Google News $news_prefixes{'^yn(| .*)$'} = 'yahoo'; # Yahoo News $news_prefixes{'^(reuters|rs)(| .*)$'} = 'reuters'; # Reuters $news_prefixes{'^eff(| .*)$'} = 'eff'; # Electronic Frontier Foundation $news_prefixes{'^(wired|wd)(| .*)$'} = 'wired'; # Wired $news_prefixes{'^(\/\.|slashdot|sd)(| .*)$'} = 'slashdot'; # Slashdot $news_prefixes{'^(newsforge|nf)(| .*)$'} = 'newsforge'; # NewsForge $news_prefixes{'^(us|usnews)(| .*)$'} = 'usnews'; # U.S.News & World Report $news_prefixes{'^(nsci|newsci)(| .*)$'} = 'newsci'; # New Scientist $news_prefixes{'^dm(| .*)$'} = 'discover'; # Discover Magazine $news_prefixes{'^(sa|sciam)(| .*)$'} = 'sciam'; # Scientific American sub news { my %news_servers = ( "bbc" => { home => 'http://news.bbc.co.uk', search => 'http://newssearch.bbc.co.uk/cgi-bin/search/results.pl?q='}, "msnbc" => { # The bastard child of Microsoft and the National Broadcasting Corporation home => 'http://msnbc.com', search => 'http://msnbc.msn.com/?id=3053419&action=fulltext&querytext='}, "cnn" => { home => 'http://cnn.com', search => 'http://search.cnn.com/pages/search.jsp?query='}, "fox" => { home => 'http://foxnews.com', search => 'http://search.foxnews.com/info.foxnws/redirs_all.htm?pgtarg=wbsdogpile&qkw='}, "google" => { home => 'http://news.google.com', search => 'http://news.google.com/news?q='}, "yahoo" => { home => 'http://news.yahoo.com', search => 'http://news.search.yahoo.com/search/news/?p='}, "reuters" => { home => 'http://reuters.com', search => 'http://reuters.com/newsSearchResultsHome.jhtml?query='}, "eff" => { home => 'http://eff.org', search => 'http://google.com/search?sitesearch=http://eff.org&q='}, "wired" => { home => 'http://wired.com', search => 'http://search.wired.com/wnews/default.asp?query='}, "slashdot" => { home => 'http://slashdot.org', search => 'http://slashdot.org/search.pl?query='}, "newsforge" => { home => 'http://newsforge.com', search => 'http://newsforge.com/search.pl?query='}, "usnews" => { home => 'http://usnews.com', search => 'http://www.usnews.com/search/Search?keywords='}, "newsci" => { home => 'http://newscientist.com', search => 'http://www.newscientist.com/search.ns?doSearch=true&articleQuery.queryString='}, "discover" => { home => 'http://discover.com', search => 'http://www.discover.com/search-results/?searchStr='}, "sciam" => { home => 'http://sciam.com', search => 'http://sciam.com/search/index.cfm?QT=Q&SC=Q&Q='}, ); my ($server, $search) = @_; my $key = $search ? 'search' : 'home'; $server = 'bbc' unless $news_servers{$server} and $news_servers{$server}->{$key}; my $url = $news_servers{$server}->{$key}; $url .= $search if $search; return $url; } if ($url =~ /^(news|n)(| .*)$/) { return news(loadrc('news'), $search); } foreach my $prefix (keys %news_prefixes) { next unless $url =~ /$prefix/; return news($news_prefixes{$prefix}, $search); } =over =item Locators: =over =item Internet Movie Database: B, B, or B =item US zip code search: B or B (# or address) =item IP address locator / address space: B =item WHOIS / TLD list: B (current url or specified) =item Request for Comments: B (# or search) =item Weather: B or B =item Yahoo! Finance / NASD Regulation: B, B, or B =item Snopes: B
    , B, or B =item Torrent search / ISOHunt: B, B, or B =item Wayback Machine: B, B, B, or B (current url or specified) =item Freshmeat: B or B =item SourceForge: B or B =item Savannah: B or B =item Gna!: B =item BerliOS: B or B =item Netcraft Uptime Survey: B or B (current url or specified) =item Who's Alive and Who's Dead: Wanted, B or B! =item Google Library / Project Gutenberg: B or B =item Internet Public Library: B =item VIM Tips: B (# or search) =item Urban Dictionary: B or B > =back =over The I<%locators> hash maps each engine name to two URLs, I and I. B string in the URL is substitued for the URL of the current document. B string in the I URL is substitued for the search string. If no B string is found in the URL, the query is appended to the mapped URL. The locators mapping is done by the I function, taking the search engine name as its first parameter, optional search string as its second parameter and the current document's URL as its third parameter. It returns the mapped target URL. =back =cut ############################################################################ # Locators my %locator_prefixes; $locator_prefixes{'^(imdb|movie|flick)(| .*)$'} = 'imdb'; # Internet Movie Database $locator_prefixes{'^(stock|ticker|quote)(| .*)$'} = 'stock'; # Yahoo! Finance / NASD Regulation $locator_prefixes{'^(urban|legend|ul)(| .*)$'} = 'bs'; # Snopes $locator_prefixes{'^(bittorrent|torrent|bt)(| .*)$'} = 'torrent'; # Torrent search / ISOHunt $locator_prefixes{'^(archive|arc|ar|ia)(| .*)$'} = 'archive'; # Wayback Machine $locator_prefixes{'^(freshmeat|fm)(| .*)$'} = 'freshmeat'; # Freshmeat $locator_prefixes{'^(sourceforge|sf)(| .*)$'} = 'sourceforge'; # SourceForge $locator_prefixes{'^(savannah|sv)(| .*)$'} = 'savannah'; # Savannah $locator_prefixes{'^gna(| .*)$'} = 'gna'; # Gna! $locator_prefixes{'^(berlios|bl)(| .*)$'} = 'berlios'; # BerliOS $locator_prefixes{'^(alive|dead)(| .*)$'} = 'dead'; # Who's Alive and Who's Dead $locator_prefixes{'^(book|read)(| .*)$'} = 'book'; # Google Library / Project Gutenberg $locator_prefixes{'^ipl(| .*)$'} = 'ipl'; # Internet Public Library $locator_prefixes{'^(urbandict|ud)(| .*)$'} = 'urbandict'; # Urban Dictionary $locator_prefixes{'^ubs(| .*)$'} = 'ubs'; # Usenet binary search my %weather_locators = ( 'weather underground' => 'http://wunderground.com/cgi-bin/findweather/getForecast?query=!query!', 'google' => 'http://google.com/search?q=weather+"!query!"', 'yahoo' => 'http://search.yahoo.com/search?p=weather+"!query!"', 'cnn' => 'http://weather.cnn.com/weather/search?wsearch=!query!', 'accuweather' => 'http://wwwa.accuweather.com/adcbin/public/us_getcity.asp?zipcode=!query!', 'ask jeeves' => 'http://web.ask.com/web?&q=weather !query!', ); sub location { my %locators = ( 'imdb' => { home => 'http://imdb.com', search => 'http://imdb.com/Find?select=All&for='}, 'stock' => { home => 'http://nasdr.com', search => 'http://finance.yahoo.com/l?s='}, 'bs' => { home => 'http://snopes.com', search => 'http://search.atomz.com/search/?sp-a=00062d45-sp00000000&sp-q='}, 'torrent' => { home => 'http://isohunt.com', search => 'http://google.com/search?q=filetype:torrent !query!!bork!'}, 'archive' => { home => 'http://web.archive.org/web/*/!current!', search => 'http://web.archive.org/web/*/'}, 'freshmeat' => { home => 'http://freshmeat.net', search => 'http://freshmeat.net/search/?q='}, 'sourceforge' => { home => 'http://sourceforge.net', search => 'http://sourceforge.net/search/?q='}, 'savannah' => { home => 'http://savannah.nongnu.org', search => 'http://savannah.nongnu.org/search/?type_of_search=soft&words='}, 'gna' => { home => 'http://gna.org', search => 'https://gna.org/search/?type_of_search=soft&words='}, 'berlios' => { home => 'http://www.berlios.de', search => 'http://developer.berlios.de/search/?type_of_search=soft&words='}, 'dead' => { home => 'http://www.whosaliveandwhosdead.com', search => 'http://google.com/search?btnI&sitesearch=http://whosaliveandwhosdead.com&q='}, 'book' => { home => 'http://gutenberg.org', search => 'http://google.com/search?q=book+"!query!"'}, 'ipl' => { home => 'http://ipl.org', search => 'http://ipl.org/div/searchresults/?words='}, 'urbandict' => { home => 'http://urbandictionary.com/random.php', search => 'http://urbandictionary.com/define.php?term='}, 'ubs' => { home => 'http://binsearch.info', search => 'http://binsearch.info/?q='}, ); my ($server, $search, $current_url) = @_; my $key = $search ? 'search' : 'home'; return unless $locators{$server} and $locators{$server}->{$key}; my $url = $locators{$server}->{$key}; my $bork = ""; $bork = "&hl=xx-bork" unless (loadrc("bork") ne "yes"); $url =~ s/!bork!/$bork/g; $url =~ s/!current!/$current_url/g; $url .= $search if $search and not $url =~ s/!query!/$search/g; return $url; } foreach my $prefix (keys %locator_prefixes) { next unless $url =~ /$prefix/; return location($locator_prefixes{$prefix}, $search, $current_url); } if ($url =~ '^(zip|usps)(| .*)$' or $url =~ '^ip(| .*)$' or $url =~ '^whois(| .*)$' or $url =~ '^rfc(| .*)$' or $url =~ '^(weather|w)(| .*)$' or $url =~ '^(whatis|uptime)(| .*)$' or $url =~ '^vt(| .*)$') { my ($thingy) = $url =~ /^[a-z]* (.*)/; my ($domain) = $current_url =~ /([a-z0-9-]+\.(com|net|org|edu|gov|mil))/; my $locator_zip = 'http://usps.com'; my $ipv = "ipv4-address-space"; $ipv = "ipv6-address-space" if loadrc("ipv6") eq "yes"; my $locator_ip = 'http://www.iana.org/assignments/' . $ipv; my $whois = 'http://reports.internic.net/cgi/whois?type=domain&whois_nic='; my $locator_whois = 'http://www.iana.org/cctld/cctld-whois.htm'; $locator_whois = $whois . $domain if $domain; my $locator_rfc = 'http://ietf.org'; my $locator_weather = 'http://weather.noaa.gov'; my $locator_whatis = 'http://uptime.netcraft.com'; $locator_whatis = 'http://uptime.netcraft.com/up/graph/?host=' . $domain if $domain; my $locator_vim = 'http://www.vim.org/tips'; if ($thingy) { $locator_zip = 'http://zip4.usps.com/zip4/zip_responseA.jsp?zipcode=' . $thingy; $locator_zip = 'http://zipinfo.com/cgi-local/zipsrch.exe?zip=' . $thingy if $thingy !~ '^[0-9]*$'; $locator_ip = 'http://melissadata.com/lookups/iplocation.asp?ipaddress=' . $thingy; $locator_whois = $whois . $thingy; $locator_rfc = 'http://rfc-editor.org/cgi-bin/rfcsearch.pl?num=37&searchwords=' . $thingy; $locator_rfc = 'http://ietf.org/rfc/rfc' . $thingy . '.txt' unless $thingy !~ '^[0-9]*$'; my $weather = loadrc("weather"); $locator_weather = $weather_locators{$weather}; $locator_weather ||= $weather_locators{'weather underground'}; $locator_weather =~ s/!query!/$thingy/; $locator_whatis = 'http://uptime.netcraft.com/up/graph/?host=' . $thingy; $locator_vim = 'http://www.vim.org/tips/tip_search_results.php?order_by=rating&keywords=' . $thingy; $locator_vim = 'http://www.vim.org/tips/tip.php?tip_id=' . $thingy unless $thingy !~ '^[0-9]*$'; } return $locator_zip if ($url =~ '^(zip|usps)(| .*)$'); return $locator_ip if ($url =~ '^ip(| .*)$'); return $locator_whois if ($url =~ '^whois(| .*)$'); return $locator_rfc if ($url =~ '^rfc(| .*)$'); return $locator_weather if ($url =~ '^(weather|w)(| .*)$'); return $locator_whatis if ($url =~ '^(whatis|uptime)(| .*)$'); return $locator_vim if ($url =~ '^vt(| .*)$'); } =item Google Groups: B, B, B, B, B, B, B =cut ############################################################################ # Google Groups (DejaNews) if ($url =~ '^(deja|gg|groups|gr|nntp|usenet|nn)(| .*)$') { my ($search) = $url =~ /^[a-z]* (.*)/; my $beta = "groups.google.co.uk"; $beta = "groups-beta.google.com" unless (loadrc("googlebeta") ne "yes"); my $bork = ""; if ($search) { $bork = "&hl=xx-bork" unless (loadrc("bork") ne "yes"); my ($msgid) = $search =~ /^<(.*)>$/; return 'http://' . $beta . '/groups?as_umsgid=' . $msgid . $bork if $msgid; return 'http://' . $beta . '/groups?q=' . $search . $bork; } else { $bork = "/groups?hl=xx-bork" unless (loadrc("bork") ne "yes"); return 'http://' . $beta . $bork; } } =item MirrorDot: B or B > =cut ############################################################################ # MirrorDot if ($url =~ '^(mirrordot|md)(| .*)$') { my ($slashdotted) = $url =~ /^[a-z]* (.*)/; if ($slashdotted) { return 'http://mirrordot.com/find-mirror.html?' . $slashdotted; } else { return 'http://mirrordot.com'; } } ############################################################################ # The Bastard Operator from Hell if ($url =~ '^bofh$') { return 'http://prime-mover.cc.waikato.ac.nz/Bastard.html'; } =item Coral cache: B, B, or B > =cut ############################################################################ # Coral cache if ($url =~ '^(coral|cc|nyud)( .*)$') { my ($cache) = $url =~ /^[a-z]* (.*)/; $cache =~ s/^http:\/\///; ($url) = $cache =~ s/\//.nyud.net:8090\//; return 'http://' . $cache; } =item AltaVista Babelfish: B, B, B, B, B, or B > > "babelfish german english" or "bf de en" =cut ############################################################################ # AltaVista Babelfish ("babelfish german english" or "bf de en") if (($url =~ '^(babelfish|babel|bf|translate|trans|b)(| [a-zA-Z]* [a-zA-Z]*)$') or ($url =~ '^(babelfish|babel|bf|translate|trans|b)(| [a-zA-Z]*(| [a-zA-Z]*))$' and loadrc("language") and $current_url)) { $url = 'http://babelfish.altavista.com' if ($url =~ /^[a-z]*$/); if ($url =~ /^[a-z]* /) { my $tongue = loadrc("language"); $url = $url . " " . $tongue if ($tongue ne "no" and $url !~ /^[a-z]* [a-zA-Z]* [a-zA-Z]*$/); $url =~ s/ chinese/ zt/i; $url =~ s/ dutch/ nl/i; $url =~ s/ english/ en/i; $url =~ s/ french/ fr/i; $url =~ s/ german/ de/i; $url =~ s/ greek/ el/i; $url =~ s/ italian/ it/i; $url =~ s/ japanese/ ja/i; $url =~ s/ korean/ ko/i; $url =~ s/ portugese/ pt/i; $url =~ s/ russian/ ru/i; $url =~ s/ spanish/ es/i; my ($from_language, $to_language) = $url =~ /^[a-z]* (.*) (.*)$/; ($current_url) = $current_url =~ /^.*:\/\/(.*)/; $url = 'http://babelfish.altavista.com/babelfish/urltrurl?lp=' . $from_language . '_' . $to_language . '&url=http%3A%2F%2F' . $current_url; } return $url; } ############################################################################ # XYZZY if ($url =~ '^xyzzy$') { # $url = 'http://sundae.triumf.ca/pub2/cave/node001.html'; srand(); my $yzzyx; my $xyzzy = int(rand(8)); $yzzyx = 1 if ($xyzzy == 0); # Colossal Cave Adventure $yzzyx = 2 if ($xyzzy == 1); # Dungeon $yzzyx = 227 if ($xyzzy == 2); # Zork Zero: The Revenge of Megaboz $yzzyx = 3 if ($xyzzy == 3); # Zork I: The Great Underground Empire $yzzyx = 4 if ($xyzzy == 4); # Zork II: The Wizard of Frobozz $yzzyx = 5 if ($xyzzy == 5); # Zork III: The Dungeon Master $yzzyx = 6 if ($xyzzy == 6); # Zork: The Undiscovered Underground $yzzyx = 249 if ($xyzzy == 7); # Hunt the Wumpus return 'http://ifiction.org/games/play.php?game=' . $yzzyx; } ############################################################################ # ...and now, Deep Thoughts. by Jack Handey if ($url =~ '^(jack|handey)$') { return 'http://glug.com/handey'; } =item W3C page validators: B or B > (or current url) =cut ############################################################################ # Page validators [] if ($url =~ '^vhtml(| .*)$' or $url =~ '^vcss(| .*)$') { my ($page) = $url =~ /^.* (.*)/; $page = $current_url unless $page; return 'http://validator.w3.org/check?uri=' . $page if $url =~ 'html'; return 'http://jigsaw.w3.org/css-validator/validator?uri=' . $page if $url =~ 'css'; } =item ELinks: =over =item Home: B or B =item Bugzilla: B or B (# or search optional) =item Documentation and FAQ: B or B =back There's no place like home... =cut ############################################################################ # There's no place like home if ($url =~ '^(el(|inks)|b(ug(|s)|z)(| .*)|doc(|umentation|s)|faq|help|manual)$') { my ($bug) = $url =~ /^.* (.*)/; if ($url =~ '^b') { my $bugzilla = 'http://bugzilla.elinks.cz'; if (not $bug) { if (loadrc("email")) { $bugzilla = $bugzilla . '/buglist.cgi?bug_status=NEW&bug_status=ASSIGNED&bug_status=REOPENED&email1=' . loadrc("email") . '&emailtype1=exact&emailassigned_to1=1&emailreporter1=1'; } return $bugzilla; } elsif ($bug =~ '^[0-9]*$') { return $bugzilla . '/show_bug.cgi?id=' . $bug; } else { return $bugzilla . '/buglist.cgi?short_desc_type=allwordssubstr&short_desc=' . $bug; } } else { my $doc = ''; $doc = '/documentation' if $url =~ '^doc'; $doc = '/faq.html' if $url =~ '^(faq|help)$'; $doc = '/documentation/html/manual.html' if $url =~ '^manual$'; return 'http://elinks.cz' . $doc; } } =item The Dialectizer: B > > (or current url) Dialects: I, I, I, I, I, I, I, or I =cut ############################################################################ # the Dialectizer (dia ) if ($url =~ '^dia(| [a-z]*(| .*))$') { my ($dialect) = $url =~ /^dia ([a-z]*)/; $dialect = "hckr" if $dialect and $dialect eq 'hacker'; my ($victim) = $url =~ /^dia [a-z]* (.*)$/; $victim = $current_url if (!$victim and $current_url and $dialect); $url = 'http://rinkworks.com/dialect'; if ($dialect and $dialect =~ '^(redneck|jive|cockney|fudd|bork|moron|piglatin|hckr)$' and $victim) { $victim =~ s/^http:\/\///; $url = $url . '/dialectp.cgi?dialect=' . $dialect . '&url=http%3a%2f%2f' . $victim . '&inside=1'; } return $url; } =item Sender: B =over Send the current URL to the application specified by the configuration variable 'I'. Optionally, override this by specifying the application as in 'I >'. =back =cut ############################################################################ # send the current URL to another application if ($url =~ '^send(| .*)$' and $current_url) { my ($external) = $url =~ /^send (.*)/; if ($external) { system($external . ' "' . $current_url . '" 2>/dev/null &'); return $current_url; #FIXME #return; } else { if (loadrc("external")) { system(loadrc("external") . ' "' . $current_url . '" 2>/dev/null &'); return $current_url; #FIXME #return; } } } =item Dictionary: B, B, B, or B > =cut ############################################################################ # Dictionary if ($url =~ '^(dict|d|def|define)(| .*)$') { my $dict = 'http://dict.org/bin/Dict?Form=Dict1&Strategy=*&Database=*&Query='; my ($word) = $url =~ /^[a-z]* (.*)/; unless ($word) { open FILE, '; close FILE; } return $dict . $word; } =item Google site search B > > =over Use Google to search the current site or a specified site. If a domain is not given, use the current one. =back =cut ############################################################################ # Google site search if ($url =~ '^ss(| .*)$') { my ($site, $search) = $url =~ /^ss\s(\S+)\s(.*)/; if (isurl($site) =~ 'false') { $search = $site . $search if $site; $site = undef; } unless ($site and $search) { ($search) = $url =~ /^ss\s(.*)/; $site = $current_url if $current_url and $current_url !~ '^file://'; } if ($site and $search and $site ne 1 and $search ne 1) { return 'http://google.com/search?sitesearch=' . $site . '&q=' . $search; } return $current_url; #FIXME #return; } =item Anything not a prefix, URL, or local file will be treated as a search using the search engine defined by the 'search' configuration option if 'gotosearch' is set to some variation of 'yes'. =cut ############################################################################ # Anything not otherwise useful is a search if ($current_url and loadrc("gotosearch") eq "yes") { return search(loadrc("search"), $url) if isurl($url) =~ 'false'; } return $url; } =back =head1 FOLLOW URL HOOK These hooks effect a URL before ELinks has a chance to load it. =over I: The function I is called when the hook is triggered, taking the target URL as its only argument. It returns the final target URL. =cut ################################################################################ ### follow_url_hook ############################################################ sub follow_url_hook { my $url = shift; =item Bork! Bork! Bork! Rewrites many I URLs. =cut # Bork! Bork! Bork! if ($url =~ 'google\.com' and loadrc("bork") eq "yes") { if ($url =~ '^http://(|www\.|search\.)google\.com(|/search)(|/)$') { return 'http://google.com/webhp?hl=xx-bork'; } elsif ($url =~ '^http://(|www\.)groups\.google\.com(|/groups)(|/)$' or $url =~ '^http://(|www\.|search\.)google\.com/groups(|/)$') { return 'http://google.com/groups?hl=xx-bork'; } } =item NNTP over Google Translates any I or I URLs to Google Groups HTTP URLs. =cut # nntp? try Google Groups if ($url =~ '^(nntp|news):' and loadrc("usenet") ne "standard") { my $beta = "groups.google.co.uk"; $beta = "groups-beta.google.com" unless (loadrc("googlebeta") ne "yes"); $url =~ s/\///g; my ($group) = $url =~ /[a-zA-Z]:(.*)/; my $bork = ""; $bork = "hl=xx-bork&" unless (loadrc("bork") ne "yes"); return 'http://' . $beta . '/groups?' . $bork . 'group=' . $group; } # strip trailing spaces $url =~ s/\s*$//; return $url; } =back =head1 PRE FORMAT HTML HOOK When an HTML document is downloaded and is about to undergo the final rendering, this hook is called. This is frequently used to get rid of ads, but also various ELinks-unfriendly HTML code and HTML snippets which are irrelevant to ELinks but can obfuscate the rendered document. Note that these hooks are applied B before the final rendering, not before the gradual re-renderings which happen when only part of the document is available. =over I: The function I is called when the hook is triggered, taking the document's URL and the HTML source as its two arguments. It returns the rewritten HTML code. =cut ################################################################################ ### pre_format_html_hook ####################################################### sub pre_format_html_hook { my $url = shift; my $html = shift; # my $content_type = shift; =item Slashdot Sanitation Kills Slashdot's Advertisements. (This one is disabled due to weird behavior with fragments.) =cut # /. sanitation if ($url =~ 'slashdot\.org') { # $html =~ s/^.*$//sm; # $html =~ s/<\/iframe>//g; # $html =~ s/Advertisement<\/B>//; } =item Obvious Google Tips Annihilator Kills some irritating Google tips. =cut # yes, I heard you the first time if ($url =~ 'google\.com') { $html =~ s/Teep: In must broosers yuoo cun joost heet zee retoorn key insteed ooff cleecking oon zee seerch boottun\. Bork bork bork!//; $html =~ s/Tip:<\/font> Save time by hitting the return key instead of clicking on "search"/<\/font>/; } =item SourceForge AdSmasher Wipes out SourceForge's Ads. =cut # SourceForge ad smasher if ($url =~ 'sourceforge\.net') { $html =~ s/.*?//smg; $html =~ s/ \; \; \;Site Sponsors<\/b>//g; } =item Gmail's Experience Gmail has obviously never met ELinks... =cut # Gmail has obviously never met ELinks if ($url =~ 'gmail\.google\.com') { $html =~ s/^For a better Gmail experience, use a.+?Learn more<\/a><\/b>$//sm; } =item Source readability improvements Rewrites some evil characters to entities and vice versa. These will be disabled until such time as pre_format_html_hook only gets called for content-type:text/html. =cut # demoronizer # if ($content_type =~ 'text/html') # { # $html =~ s/Ñ/\—/g; # $html =~ s/\ü/ü/g; # $html =~ s/\'(?!;)/'/g; # $html =~ s/]\n>$//gsm; #$html =~ s/%5B/[/g; #$html =~ s/%5D/]/g; #$html =~ s/%20/ /g; #$html =~ s/%2F/\//g; #$html =~ s/%23/#/g; # } return $html; } =back =head1 PROXY FOR HOOK The Perl hooks are asked whether to use a proxy for a given URL (or what proxy to actually use). You can use it if you don't want to use a proxy for certain Intranet servers but you need to use it in order to get to the Internet, or if you want to use some anonymizer for access to certain sites. =over I: The function I is called when the hook is triggered, taking the target URL as its only argument. It returns the proxy URL, empty string to use no proxy or I to use the default proxy URL. =cut ################################################################################ ### proxy_for_hook ############################################################# sub proxy_for_hook { my $url = shift; =item No proxy for local files Prevents proxy usage for local files and C. =cut # no proxy for local files if ($url =~ '^(file://|(http://|)(localhost|127\.0\.0\.1)(/|:|$))') { return ""; } return; } =back =head1 QUIT HOOK The Perl hooks can also perform various actions when ELinks quits. These can be things like retouching the just saved "information files", or doing some fun stuff. =over I: The function I is called when the hook is triggered, taking no arguments nor returning anything. ('cause, you know, what would be the point?) =cut ################################################################################ ### quit_hook ################################################################## sub quit_hook { =item Collapse XBEL Folders Collapses XBEL bookmark folders. This is obsoleted by I. =cut # collapse XBEL bookmark folders (obsoleted by bookmarks.folder_state) my $bookmarkfile = $ENV{'HOME'} . '/.elinks/bookmarks.xbel'; if (-f $bookmarkfile and loadrc('collapse') eq 'yes') { open BOOKMARKS, "+<$bookmarkfile"; my $bookmark; while () { s///; $bookmark .= $_; } seek(BOOKMARKS, 0, 0); print BOOKMARKS $bookmark; truncate(BOOKMARKS, tell(BOOKMARKS)); close BOOKMARKS; } =item Words of Wisdom A few words of wisdom from ELinks the Sage. =cut # words of wisdom from ELinks the Sage if (loadrc('fortune') eq 'fortune') { system('echo ""; fortune -sa 2>/dev/null'); die; } die if (loadrc('fortune') =~ /^(none|quiet)$/); my $cookiejar = 'elinks.fortune'; my $ohwhynot = `ls /usr/share/doc/elinks*/$cookiejar 2>/dev/null`; open COOKIES, $ENV{"HOME"} . '/.elinks/' . $cookiejar or open COOKIES, '/etc/elinks/' . $cookiejar or open COOKIES, '/usr/share/elinks/' . $cookiejar or open COOKIES, $ohwhynot or die system('echo ""; fortune -sa 2>/dev/null'); my (@line, $fortune); $line[0] = 0; while () { $line[$#line + 1] = tell if /^%$/; } srand(); while (not $fortune) { seek(COOKIES, $line[int rand($#line + 1)], 0); while () { last if /^%$/; $fortune .= $_; } } close COOKIES; print "\n", $fortune; } =back =head1 SEE ALSO elinks(1), perl(1) =head1 AUTHORS Russ Rowan, Petr Baudis =cut sub isurl { my ($url) = @_; return 'false' if not $url; opendir(DIR, '.'); my @files = readdir(DIR); closedir(DIR); foreach my $file (@files) { return 'true' if $url eq $file; } return 'true' if $url =~ /^(\/|~)/; return 'true' if $url =~ /([0-9]{1,3}\.){3}[0-9]{1,3}($|\/|\?|:[0-9]{1,5})/; return 'true' if $url =~ /^((::|)[[:xdigit:]]{1,4}(:|::|)){1,8}($|\/|\?|:[0-9]{1,5})/ and $url =~ /:/; if ( $url =~ /^(([a-zA-Z]{3,}(|4|6):\/\/|(www|ftp)\.)|)[a-zA-Z0-9]+/ and ($url =~ /[a-zA-Z0-9-]+\.(com|org|net|edu|gov|int|mil)($|\/|\?|:[0-9]{1,5})/ or $url =~ /[a-zA-Z0-9-]+\.(biz|info|name|pro|aero|coop|museum)($|\/|\?|:[0-9]{1,5})/ or $url =~ /[a-zA-Z0-9-]+\.[a-zA-Z]{2}($|\/|\?|:[0-9]{1,5})/)) { return 'true'; } return 'true' if $url =~ /^about:/; return 'false'; } # vim: ts=4 sw=4 sts=0 nowrap