src/Modules/Exchange.pl

   1 #!/usr/bin/perl
   2
   3 # Exchange.pl - currency exchange 'module'
   4 #
   5 # Last update: 990818 08:30:10, bobby@bofh.dk
   6 # 20021111 Tim Riker <Tim@Rikers.org>
   7 #
   8
   9 package Exchange;
  10 use strict;
  11
  12 my $no_exchange;
  13
  14 BEGIN {
  15     eval qq{
  16         use LWP::UserAgent;
  17         use HTTP::Request::Common qw(POST GET);
  18     };
  19
  20     $no_exchange++ if ($@);
  21 }
  22
  23 sub GetAbb {
  24     my ( $LookFor, %Hash ) = @_;
  25
  26     my $Found = ( grep /$LookFor/i, keys %Hash )[0];
  27     $Found =~ m/\((\w\w\w)\)/;
  28     return $1;
  29 }
  30
  31 sub GetTlds {
  32     my %Hash = (
  33         'AF', 'AFGHANISTAN',
  34         'AL', 'ALBANIA',
  35         'DZ', 'ALGERIA',
  36         'AS', 'AMERICAN SAMOA',
  37         'AD', 'ANDORRA',
  38         'AO', 'ANGOLA',
  39         'AI', 'ANGUILLA',
  40         'AQ', 'ANTARCTICA',
  41         'AG', 'ANTIGUA AND BARBUDA',
  42         'AR', 'ARGENTINA',
  43         'AM', 'ARMENIA',
  44         'AW', 'ARUBA',
  45         'AU', 'AUSTRALIA',
  46         'AT', 'AUSTRIA',
  47         'AZ', 'AZERBAIJAN',
  48         'BS', 'BAHAMAS',
  49         'BH', 'BAHRAIN',
  50         'BD', 'BANGLADESH',
  51         'BB', 'BARBADOS',
  52         'BY', 'BELARUS',
  53         'BE', 'BELGIUM',
  54         'BZ', 'BELIZE',
  55         'BJ', 'BENIN',
  56         'BM', 'BERMUDA',
  57         'BT', 'BHUTAN',
  58         'BO', 'BOLIVIA',
  59         'BA', 'BOSNIA AND HERZEGOWINA',
  60         'BW', 'BOTSWANA',
  61         'BV', 'BOUVET ISLAND',
  62         'BR', 'BRAZIL',
  63         'IO', 'BRITISH INDIAN OCEAN TERRITORY',
  64         'BN', 'BRUNEI DARUSSALAM',
  65         'BG', 'BULGARIA',
  66         'BF', 'BURKINA FASO',
  67         'BI', 'BURUNDI',
  68         'KH', 'CAMBODIA',
  69         'CM', 'CAMEROON',
  70         'CA', 'CANADA',
  71         'CV', 'CAPE VERDE',
  72         'KY', 'CAYMAN ISLANDS',
  73         'CF', 'CENTRAL AFRICAN REPUBLIC',
  74         'TD', 'CHAD',
  75         'CL', 'CHILE',
  76         'CN', 'CHINA',
  77         'CX', 'CHRISTMAS ISLAND',
  78         'CC', 'COCOS (KEELING) ISLANDS',
  79         'CO', 'COLOMBIA',
  80         'KM', 'COMOROS',
  81         'CG', 'CONGO',
  82         'CD', 'CONGO, THE DEMOCRATIC REPUBLIC OF THE',
  83         'CK', 'COOK ISLANDS',
  84         'CR', 'COSTA RICA',
  85         'CI', "COTE D'IVOIRE",
  86         'HR', 'CROATIA (local name: Hrvatska)',
  87         'CU', 'CUBA',
  88         'CY', 'CYPRUS',
  89         'CZ', 'CZECH REPUBLIC',
  90         'DK', 'DENMARK',
  91         'DJ', 'DJIBOUTI',
  92         'DM', 'DOMINICA',
  93         'DO', 'DOMINICAN REPUBLIC',
  94         'TP', 'EAST TIMOR',
  95         'EC', 'ECUADOR',
  96         'EG', 'EGYPT',
  97         'SV', 'EL SALVADOR',
  98         'GQ', 'EQUATORIAL GUINEA',
  99         'ER', 'ERITREA',
 100         'EE', 'ESTONIA',
 101         'ET', 'ETHIOPIA',
 102         'FK', 'FALKLAND ISLANDS (MALVINAS)',
 103         'FO', 'FAROE ISLANDS',
 104         'FJ', 'FIJI',
 105         'FI', 'FINLAND',
 106         'FR', 'FRANCE',
 107         'FX', 'FRANCE, METROPOLITAN',
 108         'GF', 'FRENCH GUIANA',
 109         'PF', 'FRENCH POLYNESIA',
 110         'TF', 'FRENCH SOUTHERN TERRITORIES',
 111         'GA', 'GABON',
 112         'GM', 'GAMBIA',
 113         'GE', 'GEORGIA',
 114         'DE', 'GERMANY',
 115         'GH', 'GHANA',
 116         'GI', 'GIBRALTAR',
 117         'GR', 'GREECE',
 118         'GL', 'GREENLAND',
 119         'GD', 'GRENADA',
 120         'GP', 'GUADELOUPE',
 121         'GU', 'GUAM',
 122         'GT', 'GUATEMALA',
 123         'GN', 'GUINEA',
 124         'GW', 'GUINEA-BISSAU',
 125         'GY', 'GUYANA',
 126         'HT', 'HAITI',
 127         'HM', 'HEARD AND MC DONALD ISLANDS',
 128         'VA', 'HOLY SEE (VATICAN CITY STATE)',
 129         'HN', 'HONDURAS',
 130         'HK', 'HONG KONG',
 131         'HU', 'HUNGARY',
 132         'IS', 'ICELAND',
 133         'IN', 'INDIA',
 134         'ID', 'INDONESIA',
 135         'IR', 'IRAN (ISLAMIC REPUBLIC OF)',
 136         'IQ', 'IRAQ',
 137         'IE', 'IRELAND',
 138         'IL', 'ISRAEL',
 139         'IT', 'ITALY',
 140         'JM', 'JAMAICA',
 141         'JP', 'JAPAN',
 142         'JO', 'JORDAN',
 143         'KZ', 'KAZAKHSTAN',
 144         'KE', 'KENYA',
 145         'KI', 'KIRIBATI',
 146         'KP', "KOREA, DEMOCRATIC PEOPLE'S REPUBLIC OF",
 147         'KR', 'KOREA, REPUBLIC OF',
 148         'KW', 'KUWAIT',
 149         'KG', 'KYRGYZSTAN',
 150         'LA', "LAO PEOPLE'S DEMOCRATIC REPUBLIC",
 151         'LV', 'LATVIA',
 152         'LB', 'LEBANON',
 153         'LS', 'LESOTHO',
 154         'LR', 'LIBERIA',
 155         'LY', 'LIBYAN ARAB JAMAHIRIYA',
 156         'LI', 'LIECHTENSTEIN',
 157         'LT', 'LITHUANIA',
 158         'LU', 'LUXEMBOURG',
 159         'MO', 'MACAU',
 160         'MK', 'MACEDONIA, THE FORMER YUGOSLAV REPUBLIC OF',
 161         'MG', 'MADAGASCAR',
 162         'MW', 'MALAWI',
 163         'MY', 'MALAYSIA',
 164         'MV', 'MALDIVES',
 165         'ML', 'MALI',
 166         'MT', 'MALTA',
 167         'MH', 'MARSHALL ISLANDS',
 168         'MQ', 'MARTINIQUE',
 169         'MR', 'MAURITANIA',
 170         'MU', 'MAURITIUS',
 171         'YT', 'MAYOTTE',
 172         'MX', 'MEXICO',
 173         'FM', 'MICRONESIA, FEDERATED STATES OF',
 174         'MD', 'MOLDOVA, REPUBLIC OF',
 175         'MC', 'MONACO',
 176         'MN', 'MONGOLIA',
 177         'MS', 'MONTSERRAT',
 178         'MA', 'MOROCCO',
 179         'MZ', 'MOZAMBIQUE',
 180         'MM', 'MYANMAR',
 181         'NA', 'NAMIBIA',
 182         'NR', 'NAURU',
 183         'NP', 'NEPAL',
 184         'NL', 'NETHERLANDS',
 185         'AN', 'NETHERLANDS ANTILLES',
 186         'NC', 'NEW CALEDONIA',
 187         'NZ', 'NEW ZEALAND',
 188         'NI', 'NICARAGUA',
 189         'NE', 'NIGER',
 190         'NG', 'NIGERIA',
 191         'NU', 'NIUE',
 192         'NF', 'NORFOLK ISLAND',
 193         'MP', 'NORTHERN MARIANA ISLANDS',
 194         'NO', 'NORWAY',
 195         'OM', 'OMAN',
 196         'PK', 'PAKISTAN',
 197         'PW', 'PALAU',
 198         'PA', 'PANAMA',
 199         'PG', 'PAPUA NEW GUINEA',
 200         'PY', 'PARAGUAY',
 201         'PE', 'PERU',
 202         'PH', 'PHILIPPINES',
 203         'PN', 'PITCAIRN',
 204         'PL', 'POLAND',
 205         'PT', 'PORTUGAL',
 206         'PR', 'PUERTO RICO',
 207         'QA', 'QATAR',
 208         'RE', 'REUNION',
 209         'RO', 'ROMANIA',
 210         'RU', 'RUSSIAN FEDERATION',
 211         'RW', 'RWANDA',
 212         'KN', 'SAINT KITTS AND NEVIS',
 213         'LC', 'SAINT LUCIA',
 214         'VC', 'SAINT VINCENT AND THE GRENADINES',
 215         'WS', 'SAMOA',
 216         'SM', 'SAN MARINO',
 217         'ST', 'SAO TOME AND PRINCIPE',
 218         'SA', 'SAUDI ARABIA',
 219         'SN', 'SENEGAL',
 220         'SC', 'SEYCHELLES',
 221         'SL', 'SIERRA LEONE',
 222         'SG', 'SINGAPORE',
 223         'SK', 'SLOVAKIA (Slovak Republic)',
 224         'SI', 'SLOVENIA',
 225         'SB', 'SOLOMON ISLANDS',
 226         'SO', 'SOMALIA',
 227         'ZA', 'SOUTH AFRICA',
 228         'GS', 'SOUTH GEORGIA AND THE SOUTH SANDWICH ISLANDS',
 229         'ES', 'SPAIN',
 230         'LK', 'SRI LANKA',
 231         'SH', 'ST. HELENA',
 232         'PM', 'ST. PIERRE AND MIQUELON',
 233         'SD', 'SUDAN',
 234         'SR', 'SURINAME',
 235         'SJ', 'SVALBARD AND JAN MAYEN ISLANDS',
 236         'SZ', 'SWAZILAND',
 237         'SE', 'SWEDEN',
 238         'CH', 'SWITZERLAND',
 239         'SY', 'SYRIAN ARAB REPUBLIC',
 240         'TW', 'TAIWAN, PROVINCE OF CHINA',
 241         'TJ', 'TAJIKISTAN',
 242         'TZ', 'TANZANIA, UNITED REPUBLIC OF',
 243         'TH', 'THAILAND',
 244         'TG', 'TOGO',
 245         'TK', 'TOKELAU',
 246         'TO', 'TONGA',
 247         'TT', 'TRINIDAD AND TOBAGO',
 248         'TN', 'TUNISIA',
 249         'TR', 'TURKEY',
 250         'TM', 'TURKMENISTAN',
 251         'TC', 'TURKS AND CAICOS ISLANDS',
 252         'TV', 'TUVALU',
 253         'UG', 'UGANDA',
 254         'UA', 'UKRAINE',
 255         'AE', 'UNITED ARAB EMIRATES',
 256         'GB', 'UNITED KINGDOM',
 257         'US', 'UNITED STATES',
 258         'UM', 'UNITED STATES MINOR OUTLYING ISLANDS',
 259         'UY', 'URUGUAY',
 260         'UZ', 'UZBEKISTAN',
 261         'VU', 'VANUATU',
 262         'VE', 'VENEZUELA',
 263         'VN', 'VIET NAM',
 264         'VG', 'VIRGIN ISLANDS (BRITISH)',
 265         'VI', 'VIRGIN ISLANDS (U.S.)',
 266         'WF', 'WALLIS AND FUTUNA ISLANDS',
 267         'EH', 'WESTERN SAHARA',
 268         'YE', 'YEMEN',
 269         'YU', 'YUGOSLAVIA',
 270         'ZM', 'ZAMBIA',
 271         'ZW', 'ZIMBABWE',
 272     );
 273     return %Hash;
 274 }
 275
 276 sub exchange {
 277     my ($message) = @_;
 278     &::DEBUG("exchange(@_)");
 279
 280     return 'Exchange.pl needs LWP::UserAgent and HTTP::Request::Common'
 281       if ($no_exchange);
 282
 283     my ( $From, $To, $Amount, $Country );
 284     my $retval = '';
 285     if ( $message =~ /^([\d\.\,]+)\s+(\S+)\s+(?:into|to|for)\s+(\S+)/i ) {
 286         ( $Amount, $From, $To ) = ( $1, $2, $3 );
 287         $From = uc $From;
 288         $To   = uc $To;
 289     }
 290     elsif ( $message =~ /^for\s(?:the\s)?([\w\s]+)/i ) {
 291
 292         # looking up the currency for a country
 293         $Country = $1;
 294     }
 295     else {
 296         return "that doesn't look right";
 297     }
 298
 299     my $ua = new LWP::UserAgent;
 300
 301     # Let's pretend
 302     #$ua->agent('Mozilla/5.0 ' . $ua->agent);
 303     $ua->agent('Mozilla/5.0');
 304     $ua->proxy( 'http', $::param{'httpProxy'} ) if ( &::IsParam('httpProxy') );
 305     $ua->timeout(10);
 306
 307     my $Referer   = 'http://www.xe.net/ucc/full.shtml';
 308     my $Converter = 'http://www.xe.net/ucc/convert.cgi';
 309
 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;
 315     }
 316     my $html = $reply->as_string;
 317     my %Currencies =
 318       ( grep /\S+/, ( $html =~ /option value="([^"]+)">.*?,\s*([^<]+)</gi ) );
 319
 320     my %CurrLookup = reverse( $html =~ /option value="([^"]+)">([^<]+)</gi );
 321
 322     if ($Country) {
 323
 324         # Country lookup
 325         # crysflame++ for the space fix.
 326         $retval = '';
 327         foreach my $Found ( grep /$Country/i, keys %CurrLookup ) {
 328             $Found =~ s/,/ uses/g;
 329             $retval .= "$Found, ";
 330         }
 331         $retval =~ s/(?:, )?\|?$//;
 332         return substr( $retval, 0, 510 );
 333     }
 334     else {
 335         my %tld2country = &GetTlds;
 336         if ( $From =~ /^\.(\w\w)$/ ) {    # Probably a tld
 337             $From = $tld2country{ uc $1 };
 338         }
 339         if ( $To =~ /^\.(\w\w)$/ ) {      # Probably a tld
 340             $To = $tld2country{ uc $1 };
 341         }
 342
 343         # Make sure that $Amount is of the form \d+(\.\d\d)?
 344         $Amount = sprintf( "%.2f", $Amount );
 345
 346         # Get the exact currency abbreviations
 347         my $newFrom = &GetAbb( $From, %CurrLookup );
 348         my $newTo   = &GetAbb( $To,   %CurrLookup );
 349
 350         $From = $newFrom if $newFrom;
 351         $To   = $newTo   if $newTo;
 352
 353         if ( exists $Currencies{$From} and exists $Currencies{$To} ) {
 354
 355             my $req = POST $Converter,
 356               [
 357                 timezone => 'UTC',
 358                 From     => $From,
 359                 To       => $To,
 360                 Amount   => $Amount,
 361               ];
 362
 363             # Falsify where we came from
 364             $req->referer($Referer);
 365
 366             # Submit request
 367             my $res = $ua->request($req);
 368
 369             if ( $res->is_success ) {
 370
 371                 # Went through ok
 372                 my $html = $res->as_string;
 373
 374                 # parse each one to avoid undefined warnings
 375                 my ($When) =
 376                   ( $html =~
 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 );
 380
 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);
 383
 384                 if ($When) {
 385                     return "$Cfrom $Currencies{$From} makes "
 386                       . "$Cto $Currencies{$To} (from http://www.xe.com/)"
 387                       ;    # ." ($When)\n";
 388                 }
 389                 else {
 390                     return 'i got some error trying that';
 391                 }
 392             }
 393             else {
 394
 395                 # Oh dear.
 396                 return "EXCHANGE: " . $res->status_line;
 397             }
 398         }
 399         else {
 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} );
 404         }
 405     }
 406 }
 407
 408 sub query {
 409     my ($args) = @_;
 410     &::performStrictReply( &exchange($args) );
 411     return;
 412 }
 413
 414 #print &exchange('1 usd to eur') . "\n";
 415 1;
 416
 417 __END__
 418
 419 =head1 NAME
 420
 421 Exchange.pl - Exchange between currencies
 422
 423 =head1 PREREQUISITES
 424
 425         LWP::UserAgent
 426         HTTP::Request::Common
 427
 428 =head1 PARAMETERS
 429
 430 exchange
 431
 432 =head1 PUBLIC INTERFACE
 433
 434         Exchange <amount> <currency> for|[in]to <currency>
 435
 436 =head1 DESCRIPTION
 437
 438 Contacts C<www.xe.net> and grabs the exchange rates; warning - the
 439 currency code is a bit cranky.
 440
 441 =head1 AUTHORS
 442
 443 Bobby <bobby@bofh.dk>
 444
 445 # vim:ts=4:sw=4:expandtab:tw=80