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