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