view release on metacpan or  search on metacpan

lib/App/idxdb.pm  view on Meta::CPAN

                        } else {
                            $f = 'LocalTotal';
                        }
                    }
                }

                unless ($table_exists) {
                    log_info "Creating table 'stock_ownership' ...";
                    my @table_field_defs;
                    push @table_fields    , "date";
                    push @table_field_defs, "date TEXT NOT NULL";
                    for my $f (@fields) {
                        next if $f =~ /^(Date|Type|SecNum)$/;
                        my $type;
                        $type = 'TEXT' if $f =~ /^(Code)$/;
                        $type //= 'DECIMAL';
                        push @table_fields, $f;
                        push @table_field_defs, qq("$f" $type);
                    }
                    push @table_fields    , "ctime", "mtime";
                    push @table_field_defs, "ctime INT NOT NULL", "mtime INT NOT NULL";
                    my $sql = "CREATE TABLE stock_ownership (".join(", ", @table_field_defs).")";
                    #log_warn $sql;
                    $dbh->do($sql);
                    $dbh->do("CREATE INDEX ix_stock_ownership__Code ON stock_ownership(Code)");
                    $dbh->do("CREATE UNIQUE INDEX ix_stock_ownership__date__Code ON stock_ownership(date,Code)");
                    $table_exists++;
                }

                log_info "Inserting stock ownership data for $date ...";
                my $sql = "INSERT INTO stock_ownership (".join(",", map {qq("$_")} @table_fields).") VALUES (".join(",", map {"?"} @table_fields).")";
                #log_warn $sql;
                my $sth_ins_stock_ownership = $dbh->prepare($sql);
                $dbh->begin_work;
                while (my $line = <$fh>) {
                    chomp($line);
                    my @row = split /\|/, $line;
                    my $row = {};
                    for (0..$#fields) { $row->{ $fields[$_] } = $row[ $_ ] }
                    next unless $row->{Type} eq 'EQUITY';
                    $row->{date}  = $date;
                    $row->{ctime} = time();
                    $row->{mtime} = time();
                    $sth_ins_stock_ownership->execute((map { $row->{$_} } @table_fields));
                }
                $dbh->commit;
            }
        }
    } # UPDATE_DAILY_TRADING_SUMMARY

    [200];
}

$SPEC{ownership} = {
    v => 1.1,
    summary => 'Show ownership of some stock through time',
    args => {
        %arg0_stock,
        %argsopt_filter_date,
        %argopt_fields_ownership,
        legend => {
            summary => 'Show legend of ownership instead (e.g. ForeignIB = foreign bank, etc)',
            schema => 'bool*',
            tags => ['category:action'],
        },
        %argopt_graph,
    },
    examples => [
        {
            summary => 'Show legends instead (e.g. ForeignIB = foreign bank, etc)',
            args => {legend=>1},
            test => 0,
        },
    ],
};
sub ownership {
    my %args = @_;
    my $stock = $args{stock};
    my $fields = $args{fields};

    my $state = _init(\%args, 'ro');
    my $dbh = $state->{dbh};

    if ($args{legend}) {
        return [200, "OK", \%ownership_fields];
    }

    my @wheres;
    my @binds;
    push @wheres, "Code=?";
    push @binds, $stock;
    if ($args{date_start}) {
        push @wheres, "date >= '".$args{date_start}->ymd."'";
    }
    if ($args{date_end}) {
        push @wheres, "date <= '".$args{date_end}->ymd."'";
    }

    my $sth = $dbh->prepare("SELECT * FROM stock_ownership WHERE ".join(" AND ", @wheres)." ORDER BY date");
    $sth->execute(@binds);
    my @rows;

    while (my $row = $sth->fetchrow_hashref) {
        delete $row->{Code};
        delete $row->{Price};
        delete $row->{ctime};
        delete $row->{mtime};
        my $total = $row->{LocalTotal} + $row->{ForeignTotal};
        for (@ownership_fields) {
            $row->{$_} = sprintf(
                ($args{graph} ? "%.f":"%5.2f%%"), $row->{$_}/$total*100);
        }
        for my $f (@ownership_fields) { delete $row->{$f} unless (grep {$_ eq $f} @$fields) }
        push @rows, $row;
    }

    if ($args{graph}) {
        require Chart::Gnuplot;
        require Color::RGB::Util;
        require ColorTheme::Distinct::WhiteBG;
        require File::Temp;

        my ($tempfh, $tempfilename) = File::Temp::tempfile();
        $tempfilename .= ".png";

        my $theme = ColorTheme::Distinct::WhiteBG->new;
        my @colors = map { '#'.$theme->get_item_color($_) } ($theme->list_items);

        my $chart = Chart::Gnuplot->new(
            output   => $tempfilename,
            title    => "$stock ownership from ".$args{date_start}->ymd." to ".$args{date_end}->ymd,
            xlabel   => 'date',
            ylabel   => "\%",
            timeaxis => 'x',
            xtics    => {labelfmt=>'%Y-%m-%d', rotate=>"30 right"},
            #yrange   => [0, 100],
        );
        my $i = -1;
        my @datasets;
        for my $field (@$fields) {
            $i++;
            push @datasets, Chart::Gnuplot::DataSet->new(
                xdata   => [map { $_->{date} } @rows],
                ydata   => [map { $_->{$field} } @rows],

lib/App/idxdb.pm  view on Meta::CPAN

=head1 FUNCTIONS


=head2 daily

Usage:

 daily(%args) -> [$status_code, $reason, $payload, \%result_meta]

Show data from daily stockE<sol>trading summary.

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<date_end> => I<date> (default: 1624208400)

=item * B<date_start> => I<date> (default: 1621616400)

=item * B<fields> => I<array[str]> (default: ["Volume","Value","ForeignNetBuy"])

=item * B<graph> => I<bool>

Show graph instead of table.

=item * B<stocks>* => I<array[idx::listed_stock_code]>

=item * B<total> => I<bool>


=back

Returns an enveloped result (an array).

First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.

Return value:  (any)



=head2 ownership

Usage:

 ownership(%args) -> [$status_code, $reason, $payload, \%result_meta]

Show ownership of some stock through time.

Examples:

=over

=item * Show legends instead (e.g. ForeignIB = foreign bank, etc):

 ownership(legend => 1); # -> [400, "Missing required argument: stock", undef, {}]

=back

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<date_end> => I<date> (default: 1624208400)

=item * B<date_start> => I<date> (default: 1621616400)

=item * B<fields> => I<array[str]> (default: ["LocalTotal","ForeignTotal"])

=item * B<graph> => I<bool>

Show graph instead of table.

=item * B<legend> => I<bool>

Show legend of ownership instead (e.g. ForeignIB = foreign bank, etc).

=item * B<stock>* => I<idx::listed_stock_code>


=back

Returns an enveloped result (an array).

First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.

Return value:  (any)



=head2 stocks_by_foreign_ownership

Usage:

 stocks_by_foreign_ownership(%args) -> [$status_code, $reason, $payload, \%result_meta]

Rank stocks from highest foreign ownership.

This function is not exported.

Arguments ('*' denotes required arguments):

=over 4

=item * B<dbpath> => I<str>

Path for SQLite database.

If not specified, will default to C<~/idxdb.db>.


=back

Returns an enveloped result (an array).

First element ($status_code) is an integer containing HTTP-like status code
(200 means OK, 4xx caller error, 5xx function error). Second element
($reason) is a string containing error message, or something like "OK" if status is
200. Third element ($payload) is the actual result, but usually not present when enveloped result is an error response ($status_code is not 2xx). Fourth
element (%result_meta) is called result metadata and is optional, a hash
that contains extra information, much like how HTTP response headers provide additional metadata.

Return value:  (any)



=head2 update

Usage:

 update(%args) -> [$status_code, $reason, $payload, \%result_meta]