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; $To = uc $To;
 288     } elsif ($message =~ /^for\s(?:the\s)?([\w\s]+)/i) {
 289         # looking up the currency for a country
 290         $Country = $1;
 291     } else {
 292         return "that doesn't look right";
 293     }
 294
 295     my $ua = new LWP::UserAgent;
 296     # Let's pretend
 297     #$ua->agent('Mozilla/5.0 ' . $ua->agent);
 298     $ua->agent('Mozilla/5.0');
 299     $ua->proxy('http', $::param{'httpProxy'}) if (&::IsParam('httpProxy'));
 300     $ua->timeout(10);
 301
 302     my $Referer = 'http://www.xe.net/ucc/full.shtml';
 303     my $Converter='http://www.xe.net/ucc/convert.cgi';
 304
 305     # Get a list of currency abbreviations...
 306     my $grab = GET $Referer;
 307     my $reply = $ua->request($grab);
 308     if (!$reply->is_success) {
 309         return 'EXCHANGE: '.$reply->status_line;
 310     }
 311     my $html = $reply->as_string;
 312     my %Currencies = (grep /\S+/,
 313             ($html =~ /option value="([^"]+)">.*?,\s*([^<]+)</gi)
 314         );
 315
 316     my %CurrLookup = reverse ($html =~ /option value="([^"]+)">([^<]+)</gi);
 317
 318     if ($Country) {
 319         # Country lookup
 320         # crysflame++ for the space fix.
 321         $retval = '';
 322         foreach my $Found (grep /$Country/i, keys %CurrLookup){
 323             $Found =~ s/,/ uses/g;
 324             $retval .= "$Found, ";
 325         }
 326         $retval =~ s/(?:, )?\|?$//;
 327         return substr($retval, 0, 510);
 328     } else {
 329         my %tld2country = &GetTlds;
 330         if ($From =~ /^\.(\w\w)$/) {    # Probably a tld
 331             $From = $tld2country{uc $1};
 332         }
 333         if ($To =~ /^\.(\w\w)$/) {      # Probably a tld
 334             $To = $tld2country{uc $1};
 335         }
 336
 337         # Make sure that $Amount is of the form \d+(\.\d\d)?
 338         $Amount = sprintf("%.2f",$Amount);
 339
 340         # Get the exact currency abbreviations
 341         my $newFrom = &GetAbb($From, %CurrLookup);
 342         my $newTo = &GetAbb($To, %CurrLookup);
 343
 344         $From = $newFrom if $newFrom;
 345         $To   = $newTo   if $newTo;
 346
 347         if (exists $Currencies{$From} and exists $Currencies{$To}) {
 348
 349             my $req = POST $Converter,
 350                         [   timezone    => 'UTC',
 351                             From        => $From,
 352                             To          => $To,
 353                             Amount      => $Amount,
 354                         ];
 355
 356             # Falsify where we came from
 357             $req->referer($Referer);
 358
 359             # Submit request
 360             my $res = $ua->request($req);
 361
 362             if ($res->is_success) {
 363                 # Went through ok
 364                 my $html = $res->as_string;
 365                 # parse each one to avoid undefined warnings
 366                 my ($When) = ($html =~ m/ as of (\d{4}\.\d\d.\d\d\s\d\d:\d\d:\d\d\s\S+)/gi);
 367                 my ($Cfrom) = ($html =~ m/(\d[\d,.]+)\s*$From/gi);
 368                 my ($Cto) = ($html =~ m/(\d[\d,.]+)\s*$To/gi);
 369                 #my ($When, $Cfrom, $Cto) =
 370                 #    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);
 371
 372                 if ($When) {
 373                     return "$Cfrom $Currencies{$From} makes ".
 374                         "$Cto $Currencies{$To} (from http://www.xe.com/)"; # ." ($When)\n";
 375                 } else {
 376                     return 'i got some error trying that';
 377                 }
 378             } else {
 379                 # Oh dear.
 380                 return "EXCHANGE: ". $res->status_line;
 381             }
 382         } else {
 383             return "Don't know about \"$From\" as a currency" if (!exists $Currencies{$From});
 384             return "Don't know about \"$To\" as a currency" if (!exists $Currencies{$To});
 385         }
 386     }
 387 }
 388
 389 sub query {
 390         my ($args) = @_;
 391         &::performStrictReply(&exchange($args));
 392   return;
 393 }
 394
 395 #print &exchange('1 usd to eur') . "\n";
 396 1;
 397
 398 __END__
 399
 400 =head1 NAME
 401
 402 Exchange.pl - Exchange between currencies
 403
 404 =head1 PREREQUISITES
 405
 406         LWP::UserAgent
 407         HTTP::Request::Common
 408
 409 =head1 PARAMETERS
 410
 411 exchange
 412
 413 =head1 PUBLIC INTERFACE
 414
 415         Exchange <amount> <currency> for|[in]to <currency>
 416
 417 =head1 DESCRIPTION
 418
 419 Contacts C<www.xe.net> and grabs the exchange rates; warning - the
 420 currency code is a bit cranky.
 421
 422 =head1 AUTHORS
 423
 424 Bobby <bobby@bofh.dk>
 425
 426 # vim:ts=4:sw=4:expandtab:tw=80