view release on metacpan or  search on metacpan

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

    'ForeignSell' => {type=>'volume'},
    'ForeignNetBuy' => {type=>'volume'}, # calculated
    'AccumForeignBuy'    => {type=>'accum_volume'}, # calculated
    'AccumForeignSell'   => {type=>'accum_volume'}, # calculated
    'AccumForeignNetBuy' => {type=>'accum_volume'}, # calculated
    'Frequency' => {type=>'freq'},
    'High' => {type=>'price'},
    'IDStockSummary' => {type=>'str'},
    'IndexIndividual' => {type=>'index'},
    'ListedShares' => {type=>'num'},
    'Low' => {type=>'price'},
    'NonRegularFrequency' => {type=>'freq'},
    'NonRegularValue' => {type=>'money'},
    'NonRegularVolume' => {type=>'volume'},
    'Offer' => {type=>'price'},
    'OfferVolume' => {type=>'volume'},
    'OpenPrice' => {type=>'price'},
    'Previous' => {type=>'price'},
    'Remarks' => {type=>'str'},
    'TradebleShares' => {type=>'num'},
    'Value' => {type=>'money'},
    'Volume' => {type=>'volume'},
    'WeightForIndex' => {type=>'num'},
);
my @daily_fields = sort keys %daily_fields;

our %args_common = (
    dbpath => {
        summary => 'Path for SQLite database',
        description => <<'_',

If not specified, will default to `~/idxdb.db`.

_
        schema => 'str*',
        tags => ['common'],
    },
);

our %arg0_stock = (
    stock => {
        schema => 'idx::listed_stock_code*', # XXX allow unlisted ones too in the future
        req => 1,
        pos => 0,
    },
);

our %arg0_stocks = (
    stocks => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'stock',
        schema => ['array*', of=>'idx::listed_stock_code*', min_len=>1], # XXX allow unlisted ones too in the future
        req => 1,
        pos => 0,
        slurpy => 1,
    },
);

our %argsopt_filter_date = (
    date_start => {
        schema => ['date*', 'x.perl.coerce_to' => 'DateTime', 'x.perl.coerce_rules'=>['From_str::natural']],
        tags => ['category:filtering'],
        default => ($today - 30*86400),
        cmdline_aliases => {
            'week'   => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-     7*86400; $_[0]{date_end} = $today}},
            '1week'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-     7*86400; $_[0]{date_end} = $today}},
            'month'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-    30*86400; $_[0]{date_end} = $today}},
            '1month' => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-    30*86400; $_[0]{date_end} = $today}},
            '2month' => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-    60*86400; $_[0]{date_end} = $today}},
            '3month' => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-    90*86400; $_[0]{date_end} = $today}},
            '6month' => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-   180*86400; $_[0]{date_end} = $today}},
            'ytd'    => {is_flag=>1, code=>sub {$_[0]{date_start} = $startofyear;        $_[0]{date_end} = $today}},
            'year'   => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-   365*86400; $_[0]{date_end} = $today}},
            '1year'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-   365*86400; $_[0]{date_end} = $today}},
            '2year'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today- 2*365*86400; $_[0]{date_end} = $today}},
            '3year'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today- 3*365*86400; $_[0]{date_end} = $today}},
            '5year'  => {is_flag=>1, code=>sub {$_[0]{date_start} = $today- 5*365*86400; $_[0]{date_end} = $today}},
            '10year' => {is_flag=>1, code=>sub {$_[0]{date_start} = $today-10*365*86400; $_[0]{date_end} = $today}},
        },
    },
    date_end => {
        schema => ['date*', 'x.perl.coerce_to' => 'DateTime', 'x.perl.coerce_rules'=>['From_str::natural']],
        tags => ['category:filtering'],
        default => $today,
    },
);

my $sch_ownership_field = ['str*'=>{in=>\@ownership_fields, 'x.in.summaries'=>[map {$ownership_fields{$_}} @ownership_fields]}];
my $sch_daily_field     = ['str*'=>{in=>\@daily_fields}];

our %argopt_field_ownership = (
    field => {
        schema => $sch_ownership_field,
        tags => ['category:field_selection'],
        default => 'ForeignTotal',
    },
);

our %argopt_fields_ownership = (
    fields => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'field',
        schema => ['array*', of=>$sch_ownership_field, 'x.perl.coerce_rules'=>['From_str::comma_sep']],
        tags => ['category:field_selection'],
        default => ['LocalTotal', 'ForeignTotal'],
        cmdline_aliases => {
            fields_all           => {is_flag=>1, code=>sub { $_[0]{fields} = \@ownership_fields }},
            fields_foreign       => {is_flag=>1, code=>sub { $_[0]{fields} = [grep {/Foreign/ && $_ ne 'ForeignTotal'} @ownership_fields] }},
            fields_foreign_total => {is_flag=>1, code=>sub { $_[0]{fields} = ['ForeignTotal'] }},
            fields_local         => {is_flag=>1, code=>sub { $_[0]{fields} = [grep {/Local/} @ownership_fields] }},
        },
    },
);

our %argopt_field_daily = (
    field => {
        schema => $sch_daily_field,
        tags => ['category:field_selection'],
        default => 'AccumForeignNetBuy',
    },
);

our %argopt_fields_daily = (
    fields => {
        'x.name.is_plural' => 1,
        'x.name.singular' => 'field',
        schema => ['array*', of=>$sch_daily_field, 'x.perl.coerce_rules'=>['From_str::comma_sep']],
        tags => ['category:field_selection'],
        default => ['Volume','Value','ForeignNetBuy'],
        cmdline_aliases => {
            fields_all            => {is_flag=>1, summary=>'Display all fields', code=>sub { $_[0]{fields} = \@daily_fields }},
            fields_price_all      => {is_flag=>1, summary=>'Display all prices', code=>sub { $_[0]{fields} = [qw/FirstTrade OpenPrice High Low Close/] }},
            fields_price_close    => {is_flag=>1, summary=>'Short for --field Close', code=>sub { $_[0]{fields} = [qw/Close/] }},
            fields_price_and_afnb => {is_flag=>1, summary=>'Short for --field Close --field AccumForeignNetBuy', code=>sub { $_[0]{fields} = [qw/Close AccumForeignNetBuy/] }},
        },
    },
);

our %argopt_graph = (
    graph => {
        summary => 'Show graph instead of table',
        schema => 'bool*',
        tags => ['category:action'],
        cmdline_aliases => {g=>{}},
    },
);

$SPEC{update} = {
    v => 1.1,
    summary => 'Update data',
    description => <<'_',

Currently this routine imports from text files in the `gudangdata` repository on
the local filesystem. Functionality to import from server directly using
<pm:Finance::SE::IDX> and <pm:Finance::ID::KSEI> will be added in the future.

_
    args => {
        %args_common,
        gudangdata_path => {
            schema => 'dirname*',
            req => 1,
        },
    },
};
sub update {
    require DateTime;
    require DBIx::Util::Schema;
    require JSON::MaybeXS;

    my %args = @_;

    my $gd_path = $args{gudangdata_path};

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

  UPDATE_META:
    {
        my $table_exists = DBIx::Util::Schema::table_exists($dbh, 'meta');
        last if $table_exists;
        log_info "Creating meta table ...";
        $dbh->do("CREATE TABLE meta (name TEXT PRIMARY KEY, value TEXT)");
    }

    my $sth_sel_meta = $dbh->prepare("SELECT value FROM meta WHERE name=?");
    my $sth_upd_meta = $dbh->prepare("INSERT OR REPLACE INTO meta (name,value) VALUES (?,?)");

  UPDATE_STOCK:
    {
        local $CWD = "$gd_path/table/idx_stock";
        my @st = stat "data.tsv" or die "Can't stat $CWD/data.tsv: $!";
        open my $fh, "<", "data.tsv" or die "Can't open $CWD/data.tsv: $!";

        # for simplicity, we replce whole table when updating data
        my $table_exists = DBIx::Util::Schema::table_exists($dbh, 'stock');
        if (!$table_exists) {
            log_info "Creating table 'stock' ...";
            $dbh->do("CREATE TABLE stock (code VARCHAR(4) PRIMARY KEY, sector TEXT NOT NULL, name TEXT NOT NULL, listing_date TEXT NOT NULL, shares DECIMAL NOT NULL, board TEXT NOT NULL)");
        }
        $sth_sel_meta->execute("stock_table_mtime");
        my ($stock_table_mtime) = $sth_sel_meta->fetchrow_array;
        if (!$stock_table_mtime || $stock_table_mtime < $st[9]) {
            my $sth_ins_stock = $dbh->prepare("INSERT INTO stock (code,sector,name,listing_date,shares,board) VALUES (?,?,?,?,?,?)");
            log_info "Updating table 'stock' ...";
            $dbh->begin_work;
            $dbh->do("DELETE FROM stock");
            <$fh>;
            while (my $line = <$fh>) {
                chomp $line;
                $sth_ins_stock->execute(split /\t/, $line);
            }
            $sth_upd_meta->execute("stock_table_mtime", time());
            $dbh->commit;
        }
    }

  UPDATE_DAILY_TRADING_SUMMARY:
    {
        log_trace "Updating daily trading summary ...";
        my $table_exists = DBIx::Util::Schema::table_exists($dbh, 'daily_trading_summary');
        my @table_fields;
        if ($table_exists) {
            @table_fields = map { $_->{COLUMN_NAME} } DBIx::Util::Schema::list_columns($dbh, 'daily_trading_summary');
        }
        local $CWD = "$gd_path/table/idx_daily_trading_summary/raw";
      YEAR:
        for my $year (reverse grep {-d} glob("*")) {
            local $CWD = $year;
          FILENAME:
            for my $filename (reverse glob("*.json.gz")) {
                $filename =~ /^(\d{4})(\d{2})(\d{2})/ or die;
                log_trace "Processing file $CWD/$filename ...";
                my $date = "$1-$2-${3}";
                if ($table_exists && $dbh->selectrow_array(q(SELECT 1 FROM daily_trading_summary WHERE "Date" = ?), {}, $date)) {
                    log_trace "Data for date $date already exist, skipping this date";