view release on metacpan or  search on metacpan

devel/convert-scm.pl  view on Meta::CPAN

              decimals => 2 };
    my $decimals = 0;

    my $filename = "$ENV{HOME}/Chart/data/$symbol";
    open IN, '<', $filename or die;

    foreach my $line (<IN>) {
      if ($line =~ /\(([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+) ([0-9]+)( ([0-9]+))?/) {
        my ($date, $open, $high, $low, $close, $volume, $openint)
          = ($1,$2,$3,$4,$5,$6,$8);

        push @data, { symbol  => $symbol,
                      date    => App::Chart::tdate_to_iso ($1),
                      open    => insert_decimal ($2, $decimals),
                      high    => insert_decimal ($3, $decimals),
                      low     => insert_decimal ($4, $decimals),
                      close   => insert_decimal ($5, $decimals),
                      volume  => $6,
                      openint => $8 };
        $records++;
        next;
      }

      $line =~ s/\#f/\"\"/g;
      $line =~ s/\#t/1/g;
      my $arrayref = Lisp::Reader::lisp_read($line);
      my $form = $arrayref->[0];
      if ($option_verbose >= 2) { print Dumper(\$form); }
      next if ! defined $form; # blank or only comments

      if ($form->[0] eq 'decimals') {
        $decimals = $form->[1];
        if ($option_verbose) {
          print "decimals $decimals\n";
        }

      } elsif ($form->[0] eq 'currency') {
        my $currency = $form->[1];
        if ($option_verbose) { print "currency $currency\n"; }
        $h->{'currency'} = $currency;

      } elsif ($form->[0] eq 'name') {
        my $name = $form->[1];
        if ($option_verbose) { print "name $name\n"; }
        $h->{'name'} = $name;

      } elsif ($form->[0] eq 'dividend') {
        my $date = App::Chart::tdate_to_iso ($form->[1]);
        $form = $form->[2];

        if (! ref($form)) {
          # string dividend
          my $str = $form;
          if ($option_verbose) {
            print "dividend $date \"$str\"\n";
          }
          my $amount;
          my $imputation;
          my $qualifier;
          my $note;
          if (Scalar::Util::looks_like_number ($str)) {
            $amount = $str;
          } elsif ($amount eq 'unknown') {
            $qualifier = 'unknown';
          } elsif ($amount eq 'To be Advised') {
            $qualifier = 'TBA';
          } else {
            print "string dividend \"$str\"\n";
            $note = $str;
          }
          push @dividends, { symbol    => $symbol,
                             ex_date   => $date,
                             amount    => $amount,
                             qualifier => $qualifier,
                             note      => $note};

        } elsif ($form->[0] eq 'split') {
          my $new = $form->[1];
          my $old = $form->[2];
          if ($option_verbose) {
            print "split $date, $new, $old\n";
          }
          push @splits, { symbol => $symbol,
                          date => $date,
                          new  => $new,
                          old  => $old };

        } elsif ($form->[0] eq 'amount') {
          # structured value

          my $decimals = 0;
          my $amount = $form->[1];
          my $imputation;
          my $qualifier;

          my @array = @$form;
          foreach my $elem (@array[2..$#array]) {
            if ($elem->[0] eq 'decimals') {
              $decimals = $elem->[1];
            } elsif ($elem->[0] eq 'imputation') {
              $imputation = $elem->[1];
            } elsif ($elem->[0] eq 'estimated') {
              if ($elem->[1] != 0) {
                $qualifier = 'estimated';
              }
            } else {
              print "unrecognised dividend element: ",$elem->[0],"\n";
            }
          }

          $amount  = insert_decimal ($amount, $decimals);
          if ($imputation && ! ($imputation =~ /\./)) {
            $imputation  = insert_decimal ($imputation, $decimals);
          }

          if ($option_verbose) {
            print "dividend $date '",($amount||''),", '",($imputation||''),"'\n";
          }
          push @dividends, { symbol     => $symbol,
                             ex_date    => $date,
                             amount     => $amount,