tags 564639 + patch

Hello,

I did some re-engineering and have rewritten the VWD.pm packge. The
original version got its information from the page
http://www.finanztreff.de/kurse_einzelkurs_uebersicht.htn?s=XXX. The
date and time wasn't always the correct time of the quote but just the
current date and time.
My new version is using the page
http://www.finanztreff.de/kurse_einzelkurs_detail.htn?s=XXX and gets the
real date and time of the provided quote.

I have appended my version of VWD.pm. Please forward it to upstream so
they can consider using it.

Regards,
Vincent Smeets
#!/usr/bin/perl -W
#
#    Copyright (C) 1998, Dj Padzensky <djp...@padz.net>
#    Copyright (C) 1998, 1999 Linas Vepstas <li...@linas.org>
#    Copyright (C) 2000, Yannick LE NY <y-le...@ifrance.com>
#    Copyright (C) 2000, Paul Fenwick <p...@cpan.org>
#    Copyright (C) 2000, Brent Neal <bre...@users.sourceforge.net>
#    Copyright (C) 2000, Volker Stuerzl <volker.stue...@gmx.de>
#    Copyright (C) 2003,2005,2006 Jörg Sommer <jo...@alea.gnuu.de>
#    Copyright (C) 2008 Martin Kompf (skaringa at users.sourceforge.net)
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    You should have received a copy of the GNU General Public License
#    along with this program; if not, write to the Free Software
#    Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
#    02111-1307, USA
#
#
# This code derived from Padzensky's work on package Finance::YahooQuote,
# but extends its capabilites to encompas a greater number of data sources.
#
# This code was developed as part of GnuCash <http://www.gnucash.org/>

# =============================================================

package Finance::Quote::VWD;
require 5.005;

use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTML::TreeBuilder;

# use vars qw/$VERSION $VWD_FUNDS_URL/;

use vars qw/$VERSION/;

$VERSION = '1.17';

sub methods { return (vwd => \&vwd); }
sub labels { return (vwd => [qw/
		name
		symbol
		currency
		date isodate 
		last price
		time
		net
		p_change
		open
		high
		low
		close
		volume
            /]); }

# =======================================================================
# The vwd routine gets quotes of funds from the website of
# vwd Vereinigte Wirtschaftsdienste GmbH.
#
# This subroutine was written by Volker Stuerzl <volker.stue...@gmx.de>
# and adjusted to match the new vwd interface by Jörg Sommer

# Trim leading and tailing whitespaces (also non-breakable whitespaces)
sub trim
{
    $_ = shift();
    s/^\s*//;
    s/\s*$//;
    s/&nbsp;//g;
    return $_;
}

# Trim leading and tailing whitespaces, leading + and tailing %, leading
# and tailing &plusmn; (plus minus) and translate german separators into
# english separators. Also removes the thousands separator in returned
# values.
sub trimtr
{
    $_ = shift();
    s/&nbsp;//g;
    s/&plusmn;//g;
    s/^\s*\+?//;
    s/\%?\s*$//;
    tr/,./.,/;
    s/,//g;
    return $_;
}

sub getFromKursliste
{
   my $tr = shift;
   my @tds = $tr->find("td");
   @tds = $tr->find("th") if not @tds;
   return $tds[1]->as_text;
}

sub vwd
{
  my $quoter = shift;
  my $ua = $quoter->user_agent();
  my @funds = @_;
  return unless (@funds);
  my %info;

  foreach my $fund (@funds)
  {
    $info{$fund, "source"} = "VWD";
    $info{$fund, "success"} = 0;
    $info{$fund, "errormsg"} = "Parse error";

    my $response = $ua->get("http://www.finanztreff.de/";.
   "kurse_einzelkurs_detail.htn?s=".$fund);
    if ($response->is_success)
    {
      my $html = $response->content;

      my $tree = HTML::TreeBuilder->new;
      $tree->parse($html);

      # Search the div "column638"
      my $column638 = $tree->look_down(
         "_tag", "div",
         "class", "column638");
      next if not $column638;

      # <h1> contains name and symbol
      my $head = $column638->find("h1");
      next if not $head;

      if ($head->as_trimmed_text =~ /^(.*) \((.+)\)/) {
         $info{$fund, "name"} = $1;
         $info{$fund, "symbol"} = $2;
      }

      # <ul> contains currency as 3rd <li>
      my $wpinfo = $column638->look_down(
         "_tag", "ul",
         "class", "wpInfo"
      );
      if ($wpinfo) {
         my @li = $wpinfo->find("li");
	 my $currency_li = $li[2];
	 foreach ($currency_li->descendants) {
	    $_->delete;
	 }
	 $info{$fund, "currency"} = substr($currency_li->as_text, 0, 3);
      }

      # Search the table "kursliste"
      my $kursliste_table = $tree->look_down(
         "_tag", "table",
         "class", "kursliste");
      next if not $kursliste_table;

      my @tds;
      my @trs = $kursliste_table->find("tr");
      # $trs[0] Datum
      $quoter->store_date(\%info, $fund, { eurodate => getFromKursliste($trs[0])});
      # $trs[1] Aktueller Kurs
      $info{$fund, "last"} = $info{$fund, "price"} = trimtr(getFromKursliste($trs[1]));
      # $trs[2] Kurszeit
      $info{$fund, "time"} = getFromKursliste($trs[2]);
      # $trs[3] Differenz abs.
      $info{$fund, "net"} = trimtr(getFromKursliste($trs[3]));
      # $trs[4] Differenz rel.
      $info{$fund, "p_change"} = trimtr(getFromKursliste($trs[4]));
      # $trs[5] Eröffnung
      $info{$fund, "open"} = trimtr(getFromKursliste($trs[5]));
      # $trs[6] Tageshoch
      $info{$fund, "high"} = trimtr(getFromKursliste($trs[6]));
      # $trs[7] Tagestief
      $info{$fund, "low"} = trimtr(getFromKursliste($trs[7]));
      # $trs[8] Schlusskurs
      $info{$fund, "close"} = trimtr(getFromKursliste($trs[8]));
      # $trs[9] Gehandelte Stück
      $info{$fund, "volume"} = getFromKursliste($trs[9]);

      # fund ok
      $info{$fund, "success"}  = 1;
      $info{$fund, "errormsg"} = "";

      $tree->delete;
    } else {
      $info{$fund, "success"}  = 0;
      $info{$fund, "errormsg"} = "HTTP error";
    }
  }

  return wantarray() ? %info : \%info;
}

1;

=head1 NAME

Finance::Quote::VWD  - Obtain quotes from vwd Vereinigte Wirtschaftsdienste GmbH.

=head1 SYNOPSIS

    use Finance::Quote;

    $q = Finance::Quote->new;

    %stockinfo = $q->fetch("vwd","847402");

=head1 DESCRIPTION

This module obtains information from vwd Vereinigte Wirtschaftsdienste GmbH
http://www.vwd.de/. Many european stocks and funds are available, but
at the moment only funds are supported.

Information returned by this module is governed by vwd's terms
and conditions.

=head1 LABELS RETURNED

The following labels may be returned by Finance::Quote::vwd:
currency date isodate name price last symbol time.

=head1 SEE ALSO

vwd Vereinigte Wirtschaftsdienste GmbH, http://www.vwd.de/

=cut

 	  	 

Reply via email to