3 # Exchange.pl - currency exchange 'module'
5 # Last update: 990818 08:30:10, bobby@bofh.dk
6 # 20021111 Tim Riker <Tim@Rikers.org>
17 use HTTP::Request::Common qw(POST GET);
20 $no_exchange++ if ($@);
24 my ( $LookFor, %Hash ) = @_;
26 my $Found = ( grep /$LookFor/i, keys %Hash )[0];
27 $Found =~ m/\((\w\w\w)\)/;
36 'AS', 'AMERICAN SAMOA',
41 'AG', 'ANTIGUA AND BARBUDA',
59 'BA', 'BOSNIA AND HERZEGOWINA',
61 'BV', 'BOUVET ISLAND',
63 'IO', 'BRITISH INDIAN OCEAN TERRITORY',
64 'BN', 'BRUNEI DARUSSALAM',
72 'KY', 'CAYMAN ISLANDS',
73 'CF', 'CENTRAL AFRICAN REPUBLIC',
77 'CX', 'CHRISTMAS ISLAND',
78 'CC', 'COCOS (KEELING) ISLANDS',
82 'CD', 'CONGO, THE DEMOCRATIC REPUBLIC OF THE',
85 'CI', "COTE D'IVOIRE",
86 'HR', 'CROATIA (local name: Hrvatska)',
89 'CZ', 'CZECH REPUBLIC',
93 'DO', 'DOMINICAN REPUBLIC',
98 'GQ', 'EQUATORIAL GUINEA',
102 'FK', 'FALKLAND ISLANDS (MALVINAS)',
103 'FO', 'FAROE ISLANDS',
107 'FX', 'FRANCE, METROPOLITAN',
108 'GF', 'FRENCH GUIANA',
109 'PF', 'FRENCH POLYNESIA',
110 'TF', 'FRENCH SOUTHERN TERRITORIES',
124 'GW', 'GUINEA-BISSAU',
127 'HM', 'HEARD AND MC DONALD ISLANDS',
128 'VA', 'HOLY SEE (VATICAN CITY STATE)',
135 'IR', 'IRAN (ISLAMIC REPUBLIC OF)',
146 'KP', "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF",
147 'KR', 'KOREA, REPUBLIC OF',
150 'LA', "LAO PEOPLE'S DEMOCRATIC REPUBLIC",
155 'LY', 'LIBYAN ARAB JAMAHIRIYA',
156 'LI', 'LIECHTENSTEIN',
160 'MK', 'MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF',
167 'MH', 'MARSHALL ISLANDS',
173 'FM', 'MICRONESIA, FEDERATED STATES OF',
174 'MD', 'MOLDOVA, REPUBLIC OF',
185 'AN', 'NETHERLANDS ANTILLES',
186 'NC', 'NEW CALEDONIA',
192 'NF', 'NORFOLK ISLAND',
193 'MP', 'NORTHERN MARIANA ISLANDS',
199 'PG', 'PAPUA NEW GUINEA',
210 'RU', 'RUSSIAN FEDERATION',
212 'KN', 'SAINT KITTS AND NEVIS',
214 'VC', 'SAINT VINCENT AND THE GRENADINES',
217 'ST', 'SAO TOME AND PRINCIPE',
218 'SA', 'SAUDI ARABIA',
221 'SL', 'SIERRA LEONE',
223 'SK', 'SLOVAKIA (Slovak Republic)',
225 'SB', 'SOLOMON ISLANDS',
227 'ZA', 'SOUTH AFRICA',
228 'GS', 'SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS',
232 'PM', 'ST. PIERRE AND MIQUELON',
235 'SJ', 'SVALBARD AND JAN MAYEN ISLANDS',
239 'SY', 'SYRIAN ARAB REPUBLIC',
240 'TW', 'TAIWAN, PROVINCE OF CHINA',
242 'TZ', 'TANZANIA, UNITED REPUBLIC OF',
247 'TT', 'TRINIDAD AND TOBAGO',
250 'TM', 'TURKMENISTAN',
251 'TC', 'TURKS AND CAICOS ISLANDS',
255 'AE', 'UNITED ARAB EMIRATES',
256 'GB', 'UNITED KINGDOM',
257 'US', 'UNITED STATES',
258 'UM', 'UNITED STATES MINOR OUTLYING ISLANDS',
264 'VG', 'VIRGIN ISLANDS (BRITISH)',
265 'VI', 'VIRGIN ISLANDS (U.S.)',
266 'WF', 'WALLIS AND FUTUNA ISLANDS',
267 'EH', 'WESTERN SAHARA',
278 &::DEBUG("exchange(@_)");
280 return 'Exchange.pl needs LWP::UserAgent and HTTP::Request::Common'
283 my ( $From, $To, $Amount, $Country );
285 if ( $message =~ /^([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/i ) {
286 ( $Amount, $From, $To ) = ( $1, $2, $3 );
290 elsif ( $message =~ /^for\s(?:the\s)?([\w\s]+)/i ) {
292 # looking up the currency for a country
296 return "that doesn't look right";
299 my $ua = new LWP::UserAgent;
302 #$ua->agent('Mozilla/5.0 ' . $ua->agent);
303 $ua->agent('Mozilla/5.0');
304 $ua->proxy( 'http', $::param{'httpProxy'} ) if ( &::IsParam('httpProxy') );
307 my $Referer = 'http://www.xe.net/ucc/full.shtml';
308 my $Converter = 'http://www.xe.net/ucc/convert.cgi';
310 # Get a list of currency abbreviations...
311 my $grab = GET $Referer;
312 my $reply = $ua->request($grab);
313 if ( !$reply->is_success ) {
314 return 'EXCHANGE: ' . $reply->status_line;
316 my $html = $reply->as_string;
318 ( grep /\S+/, ( $html =~ /option value="([^"]+)">.*?,\s*([^<]+)</gi ) );
320 my %CurrLookup = reverse( $html =~ /option value="([^"]+)">([^<]+)</gi );
325 # crysflame++ for the space fix.
327 foreach my $Found ( grep /$Country/i, keys %CurrLookup ) {
328 $Found =~ s/,/ uses/g;
329 $retval .= "$Found, ";
331 $retval =~ s/(?:, )?\|?$//;
332 return substr( $retval, 0, 510 );
335 my %tld2country = &GetTlds;
336 if ( $From =~ /^\.(\w\w)$/ ) { # Probably a tld
337 $From = $tld2country{ uc $1 };
339 if ( $To =~ /^\.(\w\w)$/ ) { # Probably a tld
340 $To = $tld2country{ uc $1 };
343 # Make sure that $Amount is of the form \d+(\.\d\d)?
344 $Amount = sprintf( "%.2f", $Amount );
346 # Get the exact currency abbreviations
347 my $newFrom = &GetAbb( $From, %CurrLookup );
348 my $newTo = &GetAbb( $To, %CurrLookup );
350 $From = $newFrom if $newFrom;
351 $To = $newTo if $newTo;
353 if ( exists $Currencies{$From} and exists $Currencies{$To} ) {
355 my $req = POST $Converter,
363 # Falsify where we came from
364 $req->referer($Referer);
367 my $res = $ua->request($req);
369 if ( $res->is_success ) {
372 my $html = $res->as_string;
374 # parse each one to avoid undefined warnings
377 m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)/gi );
378 my ($Cfrom) = ( $html =~ m/(\d[\d,.]+)\s*$From/gi );
379 my ($Cto) = ( $html =~ m/(\d[\d,.]+)\s*$To/gi );
381 #my ($When, $Cfrom, $Cto) =
382 # grep /\S+/, ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)|(\d[\d,.]+)\s*$From|(\d[\d,.]+)\s* $To/gi);
385 return "$Cfrom $Currencies{$From} makes "
386 . "$Cto $Currencies{$To} (from http://www.xe.com/)"
390 return 'i got some error trying that';
396 return "EXCHANGE: " . $res->status_line;
400 return "Don't know about \"$From\" as a currency"
401 if ( !exists $Currencies{$From} );
402 return "Don't know about \"$To\" as a currency"
403 if ( !exists $Currencies{$To} );
410 &::performStrictReply( &exchange($args) );
414 #print &exchange('1 usd to eur') . "\n";
421 Exchange.pl - Exchange between currencies
426 HTTP::Request::Common
432 =head1 PUBLIC INTERFACE
434 Exchange <amount> <currency> for|[in]to <currency>
438 Contacts C<www.xe.net> and grabs the exchange rates; warning - the
439 currency code is a bit cranky.
443 Bobby <bobby@bofh.dk>
445 # vim:ts=4:sw=4:expandtab:tw=80