aniani/elinks
1
0
Fork 0
mirror of https://github.com/rkd77/elinks.git synced 2024-12-04 14:46:47 -05:00
Code
9a0bf83756
elinks/contrib/perl/hooks.pl

1412 lines
43 KiB
Perl
Raw Normal View History

Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
# 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<Developer's usage>: The function I<loadrc()> takes a preference name as its
single argument and returns either an empty string if it is not specified,
I<yes> for a true value (even if specified like I<sure> or I<why not>), I<no>
for a false value (even if like I<nah>, I<off> or I<0>), or the lowercased
preference value (like I<cnn> for C<weather: CNN>).
=cut
sub loadrc($)
{
my ($preference) = @_;
my $configperl = $ENV{'HOME'} . '/.elinks/config.pl';
my $answer = '';
open RC, "<$configperl" or return $answer;
while (<RC>)
{
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<Developer's usage>: The function I<goto_url_hook> 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<goto_url_hook()>
described above maps a certain prefix to C<google> and then asks the
I<search()> mapping routine described below to map the C<google> 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<bugmenot> or B<bn>
=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 = <FILE>;
while (<FILE>)
{
next unless (m/^<dd>(.*)<br \/>(.*)<\/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;
}
############################################################################
# Random URL generator
if ($url eq 'bored' or $url eq 'random')
{
my $word; # You can say *that* again...
srand();
open FILE, '</usr/share/dict/words'
or open FILE, '</usr/share/dict/linux.words'
or open FILE, '</usr/dict/words'
or open FILE, '</usr/dict/linux.words'
or open FILE, '</usr/share/dict/yawl.list'
or open FILE, $ENV{"HOME"} . '/.elinks/elinks.words'
or return 'http://google.com/webhp?hl=xx-bork';
rand($.) < 1 && ($word = $_) while <FILE>;
close FILE;
($word) = $word =~ /(.*)/;
return 'http://' . lc($word) . '.com';
}
=item Web search:
=over
=item Google: B<g> or B<google> (default)
=item Yahoo: B<y> or B<yahoo>
=item Ask Jeeves: B<ask> or B<jeeves>
=item Amazon A9: B<a9>
=item Altavista: B<av> or B<altavista>
=item Microsoft: B<msn> or B<microsoft>
=item Mozilla Open Directory: B<dmoz>, B<odp>, B<mozilla>
=item Dogpile: B<dp> or B<dogpile>
=item Mamma: B<ma> or B<mamma>
=item Webcrawler: B<wc> or B<webcrawler>
=item Netscape: B<ns> or B<netscape>
=item Lycos: B<ly> or B<lycos>
=item Hotbot: B<hb> or B<hotbot>
=item Excite: B<ex> or B<excite>
=item Elgoog: B<eg>, B<elgoog>, B<hcraes>, B<dnif>, B<bew>, B<og>
=back
default engine: B<search>, B<find>, B<www>, B<web>, B<s>, B<f>, B<go>
=over
The I<%search_engines> hash maps each engine name to two URLs, I<home> and
I<search>. With I<search>, the query is appended to the URL.
The search engines mapping is done by the I<search()> 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/;
}
Convert some characters to entities to allow them in a search string.
2005-09-28 16:02:01 -04:00
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;
}
Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
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<bbc> (default)
=item MSNBC: B<msnbc>
=item Cable News Network: B<cnn>
=item FOXNews: B<fox>
=item Google News: B<gn>
=item Yahoo News: B<yn>
=item Reuters: B<rs> or B<reuters>
=item Electronic Frontier Foundation: B<eff>
=item Wired: B<wd> or B<wired>
=item Slashdot: B</.> or B<sd> or B<slashdot>
=item NewsForge: B<nf> or B<newsforge>
=item U.S.News & World Report: B<us> or B<usnews>
=item New Scientist: B<newsci> or B<nsci>
=item Discover Magazine: B<dm>
=item Scientific American: B<sa> or B<sciam>
=back
default agency: B<n>, B<news>
=over
The I<%news_servers> hash maps each engine name to two URLs, I<home> and
I<search>. With I<search>, the query is appended to the mapped URL.
The news servers mapping is done by the I<news()> 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<imdb>, B<movie>, or B<flick>
=item US zip code search: B<zip> or B<usps> (# or address)
=item IP address locator / address space: B<ip>
=item WHOIS / TLD list: B<whois> (current url or specified)
=item Request for Comments: B<rfc> (# or search)
=item Weather: B<w> or B<weather>
=item Yahoo! Finance / NASD Regulation: B<stock>, B<ticker>, or B<quote>
=item Snopes: B<ul>, B<urban>, or B<legend>
=item Torrent search / ISOHunt: B<bt>, B<torrent>, or B<bittorrent>
=item Wayback Machine: B<ia>, B<ar>, B<arc>, or B<archive> (current url or specified)
=item Freshmeat: B<fm> or B<freshmeat>
=item SourceForge: B<sf> or B<sourceforge>
=item Savannah: B<sv> or B<savannah>
=item Gna!: B<gna>
=item BerliOS: B<bl> or B<berlios>
=item Netcraft Uptime Survey: B<whatis> or B<uptime> (current url or specified)
=item Who's Alive and Who's Dead: Wanted, B<dead> or B<alive>!
=item Google Library / Project Gutenberg: B<book> or B<read>
=item Internet Public Library: B<ipl>
=item VIM Tips: B<vt> (# or search)
=item Urban Dictionary: B<urbandict> or B<ud> <I<word>>
=back
=over
The I<%locators> hash maps each engine name to two URLs, I<home> and I<search>.
B<!current!> string in the URL is substitued for the URL of the current
document.
B<!query!> string in the I<search> URL is substitued for the search string. If
no B<!query!> string is found in the URL, the query is appended to the mapped
URL.
The locators mapping is done by the I<location()> 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
Added a usenet binary search prefix.
2005-11-03 01:52:33 -05:00
$locator_prefixes{'^ubs(| .*)$'} = 'ubs'; # Usenet binary search
Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
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='},
Added a usenet binary search prefix.
2005-11-03 01:52:33 -05:00
'ubs' => {
home => 'http://binsearch.info',
search => 'http://binsearch.info/?q='},
Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
);
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<deja>, B<gg>, B<groups>, B<gr>, B<nntp>, B<usenet>, B<nn>
=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<md> or B<mirrordot> <I<URL>>
=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<cc>, B<coral>, or B<nyud> <I<URL>>
=cut
############################################################################
# Coral cache <URL>
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<babelfish>, B<babel>, B<bf>, B<translate>, B<trans>, or B<b> <I<from>> <I<to>>
"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<vhtml> or B<vcss> <I<URL>> (or current url)
=cut
############################################################################
# Page validators [<URL>]
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<el> or B<elinks>
=item Bugzilla: B<bz> or B<bug> (# or search optional)
=item Documentation and FAQ: B<doc(|s|umentation)> or B<faq>
=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')
{
Drop .or from elinks.or.cz.
2005-12-28 23:43:25 -05:00
my $bugzilla = 'http://bugzilla.elinks.cz';
Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
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$';
Drop .or from elinks.or.cz.
2005-12-28 23:43:25 -05:00
return 'http://elinks.cz' . $doc;
Initial commit of the HEAD branch of the ELinks CVS repository, as of Thu Sep 15 15:57:07 CEST 2005. The previous history can be added to this by grafting.
2005-09-15 09:58:31 -04:00
}
}
=item The Dialectizer:
B<dia> <I<dialect>> <I<URL>> (or current url)
Dialects: I<redneck>, I<jive>, I<cockney>, I<fudd>, I<bork>, I<moron>, I<piglatin>, or I<hacker>
=back
=cut
############################################################################
# the Dialectizer (dia <dialect> <url>)
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<send>
=over
Send the current URL to the application specified by the configuration variable
'I<external>'. Optionally, override this by specifying the application as in
'I<send> <I<application>>'.
=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<dict>, B<d>, B<def>, or B<define> <I<word>>
=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, '</usr/share/dict/words'
or open FILE, '</usr/share/dict/linux.words'
or open FILE, '</usr/dict/words'
or open FILE, '</usr/dict/linux.words'
or open FILE, '</usr/share/dict/yawl.list'
or return 'http://ypass.net/dictionary/index.html?random=1';
rand($.) < 1 && ($word = $_) while <FILE>;
close FILE;
}
return $dict . $word;
}