use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use POSIX;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

#my $wdir = "D:/Local/雪球数据/沪深一览";
my $wdir = "D:/Local/雪球数据/ETF一览";
make_path( gbk($wdir) ) unless -d gbk($wdir);

# 沪深 https://stock.xueqiu.com/v5/stock/screener/quote/list.json
# ETF https://stock.xueqiu.com/v5/stock/screener/fund/list.json

my $url = "https://stock.xueqiu.com/v5/stock/screener/fund/list.json";

my %args = (
        'page' => '1',
        'size' => '90',
        'order' => 'desc',
        'order_by' => 'percent',
        'type' => '18',
        'parent_type' => 1
    );

my $ua = Mojo::UserAgent->new();

$ua->cookie_jar->add( 
    Mojo::Cookie::Response->new(
        name   => "xq_a_token",
        value  => "这里填入对应的token值，从浏览器cookies记录获取",
        domain => 'stock.xueqiu.com',
        path   => '/',
    )
);

# 获取第一页
my $res = $ua->get( $url, form => \%args )->result;
#printf "%s\n", gbk( to_json( $res->json, {pretty => 1} ));

if ( exists $res->json->{data}{count} )
{
    write_file(  gbk( sprintf "${wdir}/%03d.json", 1 ), $res->body );
}

my $count = $res->json->{data}{count};
my $last = ceil($count / 90);

printf "count %d\n", $count;

for my $pg ( 2 .. $last )
{
    my $export = gbk( sprintf "${wdir}/%03d.json", $pg );
    if ( -f $export )
    {
        printf "Page: %d, exists\n", $pg;
        next;
    }

    # 如果之前不存在，请求数据
    $args{'page'} = $pg;
    my $res = $ua->get( $url, form => \%args )->result;
    if ( exists $res->json->{data}{count} )
    {
        printf "Page: %d\n", $pg;
        write_file( $export, $res->body );
    }
    else
    {
        printf "Page: %d, false\n", $pg;
    }
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $wdir = "D:/Local/雪球数据/ETF一览";
my $count = 0;
my $export = "ETF.txt";
my $buff = "";
for my $f ( glob gbk("$wdir/*.json") )
{
    my $json_str = uni(scalar( read_file( $f )));
    my $data = from_json( $json_str );
    for my $e ( @{$data->{data}{list}} )
    {
        next if $e->{name} =~ /^(ST|\*ST)/i;
        $count ++;
        printf "%s %s\n", $e->{symbol}, gbk($e->{name});
    
        $buff .= sprintf "%s %s\n", $e->{symbol}, $e->{name};
    }
}

write_file( $export, utf8($buff) );

printf "%d\n", $count;

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Path qw/make_path/;
use Mojo::UserAgent;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $wdir = "D:/Local/雪球数据/股票数据-日K-20230302-180DAY";
make_path( gbk($wdir) ) unless -d gbk($wdir);

# 提取某个日期之前的日K数据
my %args = (
        'symbol' => '',
        'begin' => time() * 1000 + 3600*24,
        'period' => 'day',
        'type' => 'before',
        'count' => '-185',  # 倒推天数
        'indicator' => 'kline,pe,pb,ps,pcf,market_capital,agt,ggt,balance',
    );

my $ua = Mojo::UserAgent->new();

$ua->cookie_jar->add( 
    Mojo::Cookie::Response->new(
        name   => "xq_a_token",
        value  => "这里改成自己的token",
        domain => 'stock.xueqiu.com',
        path   => '/',
    )
);

my @list = read_file("StockList.txt"); # "ETF.txt"
my $n = 0;
for my $e ( @list )
{
    $n++;
    $e =~ s/\r?\n//;
    my ( $code, $name ) = split(/\s+/, uni($e) );
    my $export = gbk("${wdir}/${code}.json");

    # 忽略科创板和创业板
    next if $code =~ /[A-Z]+(688|300)/;

    if ( -f $export )
    {
        printf "[%d/%d] %s %s already exists\n", $n, scalar(@list), $code, gbk( $name );
        next;
    }
    
    printf "[%d/%d] %s %s\n", $n, scalar(@list), $code, gbk( $name );
    $args{'symbol'} = $code;
    my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
    my $data = $res->json;
    if ( $data->{'error_code'} == 0 )
    {
        $data->{'data'}{'name'} = $name;
        write_file( $export, utf8( to_json( $data) ) );
    }
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
# use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

=note
分开建表：
* 日K - K线数据、均线数据、两融数据 （主力流入流出数据？待定）
* 周K - K线数据、均线数据
* 月K - K线数据、均线数据
* 股票信息汇总 - 代码、名称、市值、所属概念
=cut

my $database = 'stock_data_init.sqlite';
unlink $database if (-f $database and decode('gbk', __FILE__) =~ /创建/ );  # 无论如何 重新创建
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

# 创建股票数据表格 stock_data（如果不存在）
$dbh->do( utf8( <<'DAY' ) );
CREATE TABLE IF NOT EXISTS 日K ( -- 暂时去掉 IF NOT EXISTS
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    ma60 REAL,
    ma120 REAL,
    ma250 REAL,
    换手率 REAL,
    涨跌幅 REAL,
    振幅 REAL,
    融券余额 REAL, --如果这里使用Unicode形式，会被自动转为UTF8
    融券余量 REAL,
    融券净卖出 REAL,
    融券卖出量 REAL,
    融券偿还量 REAL
);
DAY

$dbh->do( utf8( <<'WEEK' ) );
CREATE TABLE IF NOT EXISTS 周K (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    ma60 REAL,
    涨跌幅 REAL,
    换手率 REAL
);
WEEK

$dbh->do( utf8( <<'MONTH' ) );
CREATE TABLE IF NOT EXISTS 月K (
    id INTEGER PRIMARY KEY AUTOINCREMENT,
    symbol TEXT NOT NULL,
    date TEXT NOT NULL,
    open REAL,
    high REAL,
    low REAL,
    close REAL,
    volume INTEGER, --成交量
    ma5 REAL,
    ma10 REAL,
    ma20 REAL,
    ma30 REAL,
    涨跌幅 REAL,
    换手率 REAL
);
MONTH

# 创建索引(主要是股票代码和日期)，用于提速
# 注意 同一个数据库中，不同的表，索引的名称不能冲突
for my $ktype ( qw/日K 周K 月K/ )
{
    printf "%s\n", $ktype;
    $dbh->do( utf8("CREATE INDEX index_${ktype}_symbol ON ${ktype} ( symbol )") );
    $dbh->do( utf8("CREATE INDEX index_${ktype}_date ON ${ktype} ( date )") );
    $dbh->do( utf8("CREATE UNIQUE INDEX index_${ktype}_symbol_date ON ${ktype} ( symbol, date )") );
}

# 调用插入函数插入数据（纯属虚构）
insert_stock_data( "TEST", "2023-09-06", "11.2", "13.5", "20020" );

# 调用查询函数查询数据 - 测试
query_stock_data( "TEST" );

# 插入股票数据
sub insert_stock_data
{
    # 使用prepare方法准备插入SQL语句。然后，我们使用execute方法执行插入操作，并传递相应的参数。
    my $insert = $dbh->prepare(utf8("INSERT INTO 日K (symbol, date, open, close, volume) VALUES (?, ?, ?, ?, ?)"));

    for ( 1 .. 1 )
    {
        $insert->execute( @_ );        
    }
}

# 查询股票数据
sub query_stock_data
{
    my ($symbol) = @_;

    my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ?") );
    $query->execute($symbol);

    while (my $row = $query->fetchrow_hashref())
    {
        print  uni(dump_json( $row ));
    }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use File::Path qw/make_path/;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
binmode(STDOUT, ":encoding(gbk)");

my $TOKEN = "歪枣网token";

my $ua = Mojo::UserAgent->new();
my $index = from_json( uni(scalar(read_file( "index.json" ))) );
my $code_map = $index->{'index_by_code'};
my @codes = sort keys %$code_map;
my $total = scalar( @codes );
my $end_date = get_last_date();
my $begin_date = "2022-01-01";

my $LASTDAY = $end_date;
$LASTDAY =~ s/-//g;
my $wdir = "D:/Local/歪枣网/股票数据-日K-2022-${LASTDAY}";
make_path( gbk($wdir) ) unless -d gbk($wdir);

printf "total: %s\n", $total;
printf "end_date: %s\n", $end_date;

# 筛选 ST *ST 科创板(688) 创业板(30x) 以外的票
# 北交所 82、83、87、88

my $it = 0;
my $count = 0;
for my $code ( @codes )
{
    my $name = $code_map->{ $code };
    $name =~ s/\s//g;
    $it++;
    # if ( $code !~ /^(688|30|82|83|87|88)/ and $name !~ /ST/i )
    #if ( $code =~ /^(688|30|82|83|87|88)/ or $name =~ /ST/i )
    # {
        $count ++;
        my $output = gbk("${wdir}/${code}.txt");
        printf "%s %s [%d/%d]\n", $code, $name, $it, $total;
        if ( not -f $output )
        {
            get_data_dayKline( $code, $begin_date, $end_date, $output );            
        }
    # }
}

printf "total: %d\n", $count;

sub get_data_dayKline
{
    my ($code, $start_date, $end_date, $output) = @_;

    # export 数据类型
    # 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    my %args = (
            'fq' => 1,       # 复权信息，取值范围：0|不复权；1|前复权；2|后复权
            'type' => 1,
            'ktype' => 101,  # 101|日线；102|周线；103|月线
            'code' => $code,
            'startDate' => $start_date,
            'endDate' => $end_date,
            'fields' => 'tdate,open,high,low,close,cjl,hsl', # 成交量，换手率
            'export' => "0",
            'token' => $TOKEN,
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getDayKLine", form => \%args )->result;

    #print u2gbk($res->body);
    write_file( $output, utf8( $args{'fields'} ."\n" ) );
    append_file( $output, $res->body() );
}

sub get_last_date
{
    my $hour = time2str( "%H", time() );
    my $end_date;
    # 如果大于15:00，日期调整为明天。
    if ( $hour ge "15" ) { $end_date = time2str("%Y-%m-%d", time() + 3600*24);  }
    else                 { $end_date = time2str("%Y-%m-%d", time());  }
}


sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

=info
    填充股票的历史日K数据。
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Basename;
use File::Copy;
use List::MoreUtils qw/zip/;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

=note
分开建表：
* 日K - K线数据、均线数据、两融数据 （主力流入流出数据？待定）
* 周K - K线数据、均线数据
* 月K - K线数据、均线数据
* 股票信息汇总 - 代码、名称、市值、所属概念
=cut

# {
    # 测试用
    # unlink "stock_data.sqlite";
    # copy "stock_data_init.sqlite", "stock_data.sqlite";
# }

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

my $src_dir = "D:/Local/歪枣网/股票数据-日K-2022-20231009";
my @files = glob gbk("${src_dir}/*.txt");
my $total = scalar( @files );

my $db_symbols = get_symbols_of_table( $dbh, utf8("日K") );

# begin_work 用于提速，这样不会频繁提交数据
# turning AutoCommit off
# Enable transactions until the next call to commit or rollback
$dbh->begin_work;

my $n = 0;
for my $f ( @files )
{   
    my ($symbol) = ($f =~ /(\d+)\.txt/);

    if ( exists $db_symbols->{$symbol} )
    {
        printf "%s - data already exists in the db\n", decode('gbk', $f);
        next;
    }

    printf "%s [%d/%d]\n", decode('gbk', $f), ++$n, $total;
    load_daily_kline_to_db( $dbh, $f );
    # last;
}

$dbh->commit;


sub load_daily_kline_to_db
{
    my ($dbh, $file) = @_;

    my ($symbol) = ($file =~ /(\d+)\.txt/);
    my @lines = read_file( $file );
    my @keys = split( /,/, $lines[0] );
    # tdate,open,high,low,close,cjl,hsl

    my $insert = $dbh->prepare(
        utf8("INSERT INTO 日K (symbol, date, open, high, low, close, volume, 换手率) VALUES (?, ?, ?, ?, ?, ?, ?, ?)")
    );

    my $total = scalar( @lines ) - 1;
    my $part_size = int($total / 100); # 用于估算处理进度 

    # 注意，歪枣网获取的CompanyInfo数据，有可能存在准备上市但未上市的公司记录(603075.txt)。
    # 对应的文件行数为1，只有标题行。

    for my $id ( 1 .. $#lines )
    {
        $lines[$id] =~ s/;\r?\n//;
        my @values = split( /,/, $lines[$id] );
        # my %data = zip @keys, @values;
        $insert->execute( $symbol, @values );
    }

    $insert->finish;
    
    say "";
}

# 获取数据库中已有的日期列表
sub get_symbols_of_table
{
    my ($dbh, $tb_name) = @_;
    my %hash;

    # 得到的 tb_name 自带双引号
    # This utility method combines "prepare", "execute", and fetching one column from all the rows
    my $list = $dbh->selectcol_arrayref( qq(SELECT DISTINCT symbol FROM $tb_name) );

    grep { $hash{$_} = 1 } @$list;

    return \%hash;
}


# 查询股票数据
sub query_stock_data
{
    my ($symbol) = @_;

    my $query = $dbh->prepare("SELECT * FROM 日K WHERE symbol = ?");
    $query->execute($symbol);

    while (my $row = $query->fetchrow_hashref())
    {
        print uni(dump_json( $row ));
    }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

=info
    日K数据更新    
    更新方案 - 提取数据库中已有的日期列表，清理末尾N天的数据，重新在线获取并覆盖
    获取数据时使用的股票列表：在线获取名单
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use File::Basename;
use File::Copy;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use POSIX qw/ceil/;
use List::Util qw/sum max min/;
use List::MoreUtils qw/zip/;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
use threads;
use threads::shared;
STDOUT->autoflush(1);

use DBI;
use Try::Tiny;
binmode(STDOUT, ":encoding(gbk)");

our $wdir = "day";
mkdir $wdir unless -d $wdir;
system("del ${wdir}\\*.json");

my $ua = Mojo::UserAgent->new();
our $TOKEN = "歪枣网 TOKEN";
our $xq_a_token = "雪球 xq_a_token";
our @mission :shared;

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";
my $tb_name = "日K";

my @symbols = get_symbol_list_with_prefix( $ua );
my $dates_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT date FROM [${tb_name}]" );

if ( scalar( @symbols ) < 1000 )
{
    printf "检查歪枣网接口，返回的股票列表为空\n";
    exit;
}

# 选择前N个交易日作为节点
my $date_select = $dates_in_db->[-3];

$dbh->begin_work;

# 清理前两天的数据（然后填入在线获取的数据 - 更新数据）
my $statement = qq(DELETE FROM [${tb_name}] WHERE date >= "${date_select}");
printf "%s\n", $statement;

# 删除该日以及之后的数据
$dbh->do( $statement );

my $begin_time = $date_select;
my $end_time = "2025-12-30";

@mission = @symbols;
# @mission = ();

my @ths;
#创建线程
grep { push @ths, threads->create( \&work, $_, $begin_time ) } ( 1 .. 4 );

#等待运行结束
while ( threads->list(threads::running) ) { sleep 0.2 };

#线程分离/结束
grep { $_->detach() if $_->is_running() } threads->list(threads::all);

# 批量写入数据库
for my $f ( glob "${wdir}/*.json" )
{
    xq_kline_data_to_db( $dbh, $tb_name, $f );
}

say "更新均线数据";
update_MA( $dbh, $tb_name );

$dbh->commit;

sub work
{
    my ( $tid, $begin_time ) = @_;

    my $begin_time_stamp = str2time( $begin_time ) * 1000;

    my $ua_xq = Mojo::UserAgent->new();
    $ua_xq->cookie_jar->add( 
        Mojo::Cookie::Response->new(
            name   => "xq_a_token",
            value  => $xq_a_token,
            domain => 'stock.xueqiu.com',
            path   => '/',
        )
    );

    while ( 1 )
    {
        my $target; # my $target 声明放在while内部，确保能够捕捉undef的情况 
        { 
            lock( @mission );
            $target = shift @mission;
        }

        last unless defined $target;

        my $data = get_xq_kline_data( $ua_xq, $target, $begin_time_stamp );
        if ( defined $data )
        {
            write_file("${wdir}/${target}.json", to_json($data->{'data'}) );
        }

        # if ( defined $data )
        # {
        #     for my $e ( @{$data->{'data'}{'item'}} )
        #     {
        #         # 0              1        2       3       4      5
        #         # "timestamp", "volume", "open", "high", "low", "close",
        #         $e->[0] = time2str("%Y-%m-%d %H:%M:%S", $e->[0]/1000);
        #         $insert->execute( $target, @{$e}[0,2,3,4,5,1] );
        #     }
        # }

        #完成后任务信息输出
        printf "[%d] target: %s\n", threads->tid(), $target;
    }

    # get_xq_kline_data();
}

sub get_xq_kline_data
{
    my ( $ua, $symbol, $begin_time ) = @_;
    my %args = (
            'symbol' => $symbol,
            'begin' => $begin_time,
            'period' => 'day',
            'type' => 'before',  # 前复权
            'count' => '1000',     # 向前(时间节点递增)提取
            'indicator' => 'kline,ma',
        );

    my $retry = 0;
    while ( $retry < 5 )
    {
        my $res = $ua->get( "https://stock.xueqiu.com/v5/stock/chart/kline.json", form => \%args )->result;
        my $data = $res->json;
        if ( exists $data->{'data'}{'item'} )
        {
            return $data;
            # printf "%d\n", scalar @{$data->{'data'}{'item'}};
            last;
        }
        else
        {
            printf "%s Retry: %d\n", $symbol, $retry;
            last if ( $retry++ >= 5 );
        }
    }

    return undef;
}

sub xq_kline_data_to_db
{
    my ($dbh, $tb_name, $file) = @_;

    my ( $code ) = ($file =~ /[A-Z]+(\d{6})/);

    my @items = qw/
        symbol date volume open high low close ma5 ma10 ma20 ma30 涨跌幅 换手率
    /;

    my $items_insert = join(",", @items);
    my $placeholds = join(", ", map {"?"} @items );

    # 使用prepare方法准备插入SQL语句。然后，我们使用execute方法执行插入操作，并传递相应的参数。
    my $insert = $dbh->prepare(
        utf8("INSERT INTO [${tb_name}] (${items_insert}) VALUES (${placeholds})")
    );

    my $data = from_json( uni(scalar(read_file( $file ))) );

    # 雪球返回数据的列标
    my @keys = @{$data->{'column'}};

    for my $e ( @{$data->{'item'}} )
    {
        my %kv = zip @keys, @{$e};

        $kv{'time'} = time2str("%Y-%m-%d", $kv{'timestamp'} /1000);

        # 雪球返回的成交量是股为单位，歪枣网的数据是"手" 为单位
        $kv{'volume'} = int($kv{'volume'}/100.0);

        # 振幅 - 振幅的参考基数是昨天的收盘价  (最高-最低)/(昨收)*100.0
        # 所以振幅留到后续再补充

        $insert->execute( $code, @{kv}{qw/time volume open high low close ma5 ma10 ma20 ma30 percent turnoverrate /} );
    }

    $insert->finish;
}


sub update_MA
{
    my ( $dbh, $tb_name ) = @_;
    
    my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM [${tb_name}]" );

    my $curr = 0;
    my $total = scalar @$codes;
    for my $code ( @$codes )
    {
        $curr++;
        printf "[%d/%d] %s\n", $curr, $total, $code;

        # 先获取单个标的的所有 id 映射表，在写入数据时通过id索引定位节点，达到提速效果
        # ORDER BY date ASC => 按日期排序 - 升序
        my $query = $dbh->prepare( utf8("SELECT * FROM [${tb_name}] WHERE symbol = ? ORDER BY date ASC") );
        $query->execute( $code );
        my $rows = $query->fetchall_arrayref( {} );
        my $total = scalar @$rows;

        for my $days ( 60, 120, 250 )
        {
            next if $total < $days;

            my $days_float = $days * 1.0;
            my $sth = $dbh->prepare( utf8("UPDATE [${tb_name}] SET ma${days} = ? WHERE id = ?") );

            for my $idx ( $days-1 .. $#$rows )
            {
                next if defined $rows->[$idx]{"ma$days"}; # 如果已有均线数据，跳过
                # printf "%d - %d\n", $days, $idx;
                my $sum = sum( map { $_->{'close'} } @{$rows}[ $idx-$days+1 .. $idx ] ); # 6 7 8 9 10 when idx = 10, ma = 5
                my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$idx]{'id'} );
                die if ( $result == -1 or $result eq "0E0" );
            }
        }

        # print decode('utf8', dump_json($rows));
        # print $rows->[1][0];
    }
}

# 获取带 SZ SH BJ 前缀的股票代码清单
sub get_symbol_list_with_prefix
{
    my ( $ua ) = @_;
    my %args = (
            'code' => "All",  # 全部
            'fields' => 'code,stype', # 股票代码, 股票类型，1：深证股票，2：上证股票，3：北证股票，4：港股
            'token' => $TOKEN,
            'export' => "1",
            # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;
    my @list;

    my $TYPE = { 1 => "SZ", 2 => "SH", 3 => "BJ", 4 => "HK" };

    for my $e ( @{$res->json->{'data'}} )
    {
        my $code = $TYPE->{ $e->{'stype'} } . $e->{'code'};
        push @list, $code;
    }

    return @list;
}

sub get_symbol_list
{
    my ( $ua ) = @_;
    my %args = (
            'code' => "All",  # 全部
            'fields' => 'code,name', # 股票代码
            'token' => $TOKEN,
            'export' => "1",
            # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
        );

    my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;

    my @list = map { $_->{'code'} } @{$res->json->{'data'}};
    return @list;
}

sub abort
{
    my ( $dbh ) = @_;
    
    $dbh->rollback;
    exit;
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use List::Util qw/sum/;
use Math::Round qw/nearest_floor nlowmult/;
# use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
use Modern::Perl;
use DBI;

binmode(STDOUT, ":encoding(gbk)");

my $database = 'stock_data.sqlite';
my $dbh = DBI->connect("dbi:SQLite:dbname=$database") or die "can not connect DB: $DBI::errstr";

$dbh->begin_work;
# 从日K数据表中获取股票名单
# DISTINCT 关键字用于去重
my $codes = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );

my $curr = 0;
my $total = scalar @$codes;
for my $code ( @$codes )
{
    $curr++;
    printf "[%d/%d] %s\n", $curr, $total, $code;

    # 先获取单个标的的所有 id 映射表，在写入数据时通过id索引定位节点，达到提速效果
    # ORDER BY date ASC => 按日期排序 - 升序
    my $query = $dbh->prepare( utf8("SELECT id,symbol,date,close FROM 日K WHERE symbol = ? ORDER BY date ASC") );
    $query->execute( $code );
    my $rows = $query->fetchall_arrayref( {} );
    my $total = scalar @$rows;

    for my $days ( 5, 10, 20, 30, 60, 120, 250 )
    {
        next if $total < $days;

        my $days_float = $days * 1.0;
        my $sth = $dbh->prepare( utf8("UPDATE 日K SET ma${days} = ? WHERE id = ?") );

        # 更新N日均线的第一个节点数值
        my $sum = sum( map { $_->{'close'} } @{$rows}[ 0 .. $days-1 ] );
        $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$days-1]{'id'} );

        for my $iter ( $days .. $#$rows )
        {
            $sum += $rows->[$iter]{'close'} - $rows->[$iter-$days]{'close'};
            my $result = $sth->execute( sprintf("%.3f", $sum/$days_float), $rows->[$iter]{'id'} );
            die if ( $result == -1 or $result eq "0E0" );

            # printf "%s ma%d %.3f\n", $rows->[$iter]{'date'}, $days, $sum/5.0;
        }
    }


    # print decode('utf8', dump_json($rows));
    # print $rows->[1][0];
}

$dbh->commit;
$dbh->disconnect;

sub query_stock_data
{
    my ($symbol, $date) = @_;

    my $query = $dbh->prepare( utf8("SELECT * FROM 日K WHERE symbol = ? AND date = ?") );
    my $result = $query->execute($symbol, $date) or die;

    printf $result;

    # while (my $row = $query->fetchrow_hashref())
    # {
    #     print  uni(dump_json( $row ));
    # }
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $token = '歪枣网TOKEN';

=info
    getCompany 的信息相对更详细，但是需要订阅接口权限
    getBaseInfo 包含基本的股票概念(板块)、流通市值、上市日期 等信息
=cut

my %args = (
        #'code' => "601949",
        'code' => "all",
        'type' => 1, # 1|沪深京A股；2|沪深京B股；3|港股；4|美股；5|黄金；6|汇率；7|Reits；10|沪深指数；11|香港指数；12|全球指数；13|债券指数；20|场内基金；30|沪深债券；40|行业板块；41|概念板块；42|地域板块
        'fields' => 'code,name,stype,bk,ssdate,z50,z52,z53',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
        'token' => $token,
        'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );

my $ua = Mojo::UserAgent->new();
# print u2gbk( $res->body );
my $res = $ua->get( "http://api.waizaowang.com/doc/getBaseInfo", form => \%args )->result;

# 还有一些板块信息，在 另一个接口中提供
# getCompanyInfo?code=600187&fields=code,name,mainbusin

my $data = $res->json;
my @codes = map { $_->{'code'} } @{$data->{'data'}};
my $total = scalar @{$data->{'data'}};
my $count = 0;
my %busin_map;

while ( scalar(@codes) > 0 )
{
    my @parts = splice @codes, 0, 50;
    my $main_business = 获取主营业务( $ua, join(",", @parts) );

    for my $e ( @$main_business )
    {
        $busin_map{ $e->{'code'} } = $e->{'mainbusin'};
    }
    # printf "%s\n", gbk( dump_json ($main_business));
    # last;

    printf "%d/%d\n", $count, $total;
    $count+=50;
}

for my $e ( @{$data->{'data'}} )
{
    my $code = $e->{'code'};
    my $main_business = $busin_map{$code};
    $main_business = "" if not defined $main_business;
    my $concept = $e->{'z53'} .";". $main_business;
    $e->{'concept'} = $concept;
}

# print u2gbk($res->body);
write_file( "baseInfo_all.json", utf8(dump_json( $data )) );

# stype 值对照 - 1：深证股票，2：上证股票，3：北证股票，4：港股

# 返回 JSON 数据时有效性判断
# if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
# {
#     print gbk(dump_json($res->json->{'data'}[0]));
# }
# else
# {
#     print gbk(dump_json($res->body));
# }

sub 获取主营业务
{
    my ( $ua, $codes_str ) = @_;
    my %args = (
        'code' => $codes_str,
        'fields' => 'code,mainbusin',  #深证、上证、北证、港股; 主板、科创板、创业板; 上市日期; 地域; 概念
        'token' => $token,
        'export' => 1, # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );
    my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo", form => \%args )->result;

    return $res->json->{'data'};
}


sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }

__DATA__
# R：融资融券标的，也就是说这只股票是融资融券的标的股;
# K：科创板股票，科创板资金门槛50万;涨跌幅20%;
# S：还没进行完股改，涨跌幅5%;
# ST：连续两年亏损或被处理的股票，涨跌幅5%;
# *ST：连续三年亏损，有退市风险，投资者应谨慎参与;
# N：当日上市股票，出现带有N字母的股票，其首日涨跌幅不受限制;
# NST：经过重组或者股改重新上市的ST股;
# PT：已经退市股票;
复制代码

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

binmode( STDOUT, ":encoding(gbk)");

my $token = '歪枣网TOKEN';

my $baseinfo = from_json( uni(scalar(read_file( "baseinfo_all.json" ))) );
my $concept = {};

printf "total: %d\n", scalar @{$baseinfo->{'data'}};

my $except = qr/(昨日连板_含一字|昨日涨停_含一字|HS300_|深圳特区|AB股|AH股|QFII重仓|预盈预增|预亏预减|机构重仓|沪股通|深成500|中证\d+|上证\d+|深证100R|央视50_|融资融券|证金持股|深股通|MSCI中国|富时罗素|标准普尔|破净股)/;
for my $e ( @{$baseinfo->{'data'}} )
{
    my $cpt = join(",", ($e->{'z52'},$e->{'z53'},$e->{'z50'}) );
    $cpt =~ s/${except},?//g;
    my @cps = grep { $_ !~ /^[_-]$/ } split( /[,;]/, $cpt );

    # printf "%s %s\n", $e->{'code'}, $cpt;
    $concept->{$e->{'code'}} = [ @cps ];
}

write_file( "concept.json", utf8(dump_json( $concept )) );

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

=info
    除息日的票显示为XD开头，使用 getCompanyInfo 重新获取股票名
    ST *ST 等开头，getCompanyInfo 获取的结果仍是ST。
    歪枣网 股票曾用名 接口 - getStockReName，似乎无法获取有效结果，返回
    {"code":200,"message":"成功","data":[]}
=cut

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

my $token = '歪枣网TOKEN';

my %args = (
        'code' => "All",  # 全部
        'fields' => 'code,name,z50,z53', # 股票代码、股票名称、归属行业板块名称、归属概念板块名称
        'token' => $token,
        'export' => "1",
        # export 0.Txt字符串  1.Json字符串  2.Txt文件  3.Json文件  4.Csv文件  5.DataFrame格式
    );

my $ua = Mojo::UserAgent->new();
my $res = $ua->get( "http://api.waizaowang.com/doc/getStockHSABaseInfo", form => \%args )->result;

# print u2gbk( $res->body );
my %hash;
my @list = @{$res->json->{'data'}};
for my $e ( @list )
{
    # 除权、除息股票，获取原名
    # DR：除权除息;表示当日是该只股票的除权除息日;
    # XD：除息日，这只股票的除息日;
    # XR：除权日，这只股票的除权日。

    if ( $e->{'name'} =~ /^(XD|XR|RD)/i )
    {
        my $res = $ua->get( "http://api.waizaowang.com/doc/getCompanyInfo", 
                            form => {
                                code => $e->{'code'},
                                fields => 'name',
                                export => '1',
                                token => $token
                            }
                        )->result;

        if ( $res->is_success and exists $res->json->{'data'}[0]{'name'} )
        {
            # printf "%s => %s\n", gbk($e->{'name'}), gbk( $res->json->{'data'}[0]{'name'} );
            $e->{'name'} = $res->json->{'data'}[0]{'name'};
        }
    }

    $e->{'name'} =~ s/\s//g;
    $hash{'index_by_code'}{ $e->{'code'} } = $e->{'name'};
    $hash{'index_by_name'}{ $e->{'name'} } = $e->{'code'};
}

# 数量
printf "total: %d\n", scalar( keys %{$hash{'index_by_code'}} );

write_file( gbk("index.json"), utf8(to_json(\%hash, {pretty => 1, canonical => 1 } )) );


sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

{
   "index_by_code" : {
      "000001" : "平安银行",
      "000002" : "万科Ａ"
   },
   "index_by_name" : {
      "平安银行" : "000001",
      "万科Ａ" : "000002"
   }
}
复制代码

index.json - 股票名称 代码映射表
baseInfo_all.json - 基本信息表
concept.json - 概念映射表
stock_data.sqlite - 日K、均线历史数据
复制代码

package DrawKlineMA;

use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use List::Util qw/sum max min/;
use List::MoreUtils qw/zip/;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use JSON qw/from_json to_json/;
use Image::Magick;

sub Draw
{
    my ( $code, $name, $data, $concept, $export ) = @_;

    if ( -f gbk($export) )
    {
        # printf "png file already exists\n";
        # return;
    }
    
    if ( $#$data < 80 )
    {
        printf "the data quantity less than 80\n";
    }
    else
    {
        @$data = @{$data}[-80 .. -1];
    }

    # 创建一个新的图片对象
    my $image = Image::Magick->new(size => '1200x500');
    $image->Read('xc:white');

    my $layer1 = Image::Magick->new(size => '1200x500');
    $layer1->Read('xc:none');
     
    my ( $W, $H ) = ( $image->Get("width"), $image->Get("height") );

    # 设置绘图参数
    my $bar_width = 10;  # K线的宽度
    my $padding = 3;   # K线之间的间距
    my $max_value = max( map { $_->{'high'} } @$data );
    my $min_value = min( map { $_->{'low'} } @$data );
    my $bar_delta = $max_value - $min_value;

    my $max_volume = max( map { $_->{'volume'} } @$data );

    my $VOL_BASE = $H * 0.2;
    my $VOL_MAX_H = $H * 0.1;

    my $BAR_BASE = $VOL_BASE + $VOL_MAX_H + 10;
    my $BAR_MAX_H = $H * 0.5;

    # 两融数据 - 考虑数据中有NULL的情况
    my @margin_data = grep { defined $_ } map { $_->{utf8('融券余额')} } @$data;
    my $margin_max = max( @margin_data );
    my $margin_min = min( @margin_data );
    my $margin_delta = scalar(@margin_data) > 0 ? $margin_max - $margin_min : undef;
    my $margin_sum = sum( @margin_data );

    # 绘制外框
    # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $VOL_BASE, $VOL_BASE+$VOL_MAX_H, "none", "gray" );

    # 绘制外框
    # draw_rect_range( $image, 1, scalar(@$data)*($bar_width+$padding), $BAR_BASE, $BAR_BASE+$BAR_MAX_H, "none", "gray" );

    my @words = split /,/, $concept;
    my $buff = "";
    while ( @words )
    {
        $buff .= join(", ", splice(@words, 0, 10)) ."\n";
    }

    # 板块信息
    $image->Annotate(
        text      => $buff,
        x         => int($W*1/4),
        y         => 20,
        fill      => 'black',
        font      => "Simhei",
        pointsize => 16,
        align     => 'left',
        gravity => "SouthWest",
        'word-break' => 'break-word',
    );

    # 股票名称
    $image->Annotate(
        text      => sprintf("%s(%s)", $name, $code),
        x         => 10,
        y         => 28,
        fill      => 'black',
        font      => "Simhei",
        pointsize => 28,
        align     => 'left',
        gravity => "SouthWest",
    );

    # 绘制K线图
    my $x = $padding;
    
    # 均线起点值
    my $prev = {};
    my @ma_list = qw/ma5 ma10 ma20 ma30 ma60 ma120 ma250/;
    my @colors = qw/black orange pink green blue purple brown cyan/;
    my $mcolor = {};
    my $cid = 0;

    # 初始化均线起点值，但也要考虑某些标的，长周期分均线一开始并未出现的情况
    for my $ma ( @ma_list )
    {
        $mcolor->{$ma} = $colors[$cid++];
        $prev->{$ma} = $data->[0]->{$ma};
    }

    $prev->{'margin'} = $data->[0]->{'融券余额'};

    my $prev_close = 0.0;
    for my $kline ( @$data )
    {
        my $date = $kline->{date};
        my $open = $kline->{open};
        my $high = $kline->{high};
        my $low = $kline->{low};
        my $close = $kline->{close};
        my $volume = $kline->{volume};

        # 计算K线的高度
        my $delta = abs($open - $close);
        my $bar_open = ($open - $min_value )/ $bar_delta * $BAR_MAX_H;
        my $bar_close = ($close - $min_value )/ $bar_delta * $BAR_MAX_H;

        # 上下影线位置
        my $bar_high = ($high - $min_value )/ $bar_delta * $BAR_MAX_H;
        my $bar_low = ($low - $min_value )/ $bar_delta * $BAR_MAX_H;

        # 颜色 - 下跌时为绿色实心，上涨或者不涨为白色实心、红色边界
        my $fill = $close > $open ? "white" : "green";
        my $stroke = $close > $open ? "red" : "green";

        # 如果是一字上涨
        if ( $close == $open and $close > $prev_close )
        { $fill = "white"; $stroke = "red"; }

        # 绘制上下影线
        draw_line_range( $image, $x+$bar_width/2, $BAR_BASE+$bar_high, $BAR_BASE+$bar_low, $stroke );

        # printf "%.2f %.2f %d %d\n", $high, $low, $bar_high, $bar_low;
        # 绘制K柱
        draw_rect_range( $image, $x, $x+$bar_width, $BAR_BASE+$bar_open, $BAR_BASE+$bar_close, $fill, $stroke );

        # 绘制量能条
        my $volume_height = $volume / $max_volume * $VOL_MAX_H;
        draw_rect_range( $image, $x, $x+$bar_width, $VOL_BASE, $VOL_BASE+$volume_height, $fill, $stroke );

        # 绘制融券数据
        if ( defined $kline->{utf8('融券余额')} and $margin_sum != 0 )
        {
            my $k = utf8("融券余额");
            if ( not defined $prev->{$k}  )
            {
                $prev->{$k} = $kline->{$k};
            }
            else
            {
                # printf "%.2f\n", $kline->{$k};
                # pt1 是上一个点的位置 pt2是当前点的位置
                my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H }; 
                my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$k} - $margin_min )/$margin_delta * $BAR_MAX_H }; 
                draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, "CYAN" );
                $prev->{$k} = $kline->{$k};
            }
        }

        # 绘制均线
        for my $ma ( @ma_list )
        {
            # 考虑某些标的，长周期分均线一开始并未出现的情况；先记录数据，留到下一节点绘制
            if ( not defined $prev->{$ma} )
            {
                $prev->{$ma} = $kline->{$ma};
                next;
            }

            # pt1 是上一个点的位置 pt2是当前点的位置
            my $pt1 = { 'x' => $x-$bar_width/2-$padding,  'y' => ($prev->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H }; 
            my $pt2 = { 'x' => $x+$bar_width/2, 'y' => ($kline->{$ma} - $min_value )/$bar_delta * $BAR_MAX_H }; 
            draw_line( $layer1, $pt1->{'x'}, $pt1->{'y'}+$BAR_BASE, $pt2->{'x'}, $pt2->{'y'}+$BAR_BASE, $mcolor->{$ma} );

            $prev->{$ma} = $kline->{$ma};
        }

        # 日期字符串长度
        my @mertics = $image->QueryFontMetrics(text => $date, font => 'Arial', pointsize => 12 );
        my $text_width = $mertics[4];

        # 绘制日期
        my $text_x = $x;
        my $text_y = $VOL_BASE;
        $image->Annotate(
            text      => $date,
            x         => $text_x + $padding/2,
            y         => $H - $VOL_BASE + $text_width/2 + $padding,
            rotate    => 90,
            fill      => 'black',
            # stroke    => 'black',
            font      => 'Arial',
            pointsize => 12,
            align     => 'Center',
            gravity => "South",
        );

        # 更新X轴位置
        $x += $bar_width + $padding;
        $prev_close = $close;
    }

    $layer1->Evaluate( channel => "Alpha", operator => "Multiply", value => 0.6 );
    $image->Composite( image => $layer1 );

    $image->Set( "Alpha" => "On");

    # 保存图像
    $image->Write( $export );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_line
{
    my ( $cv, $x1, $y1, $x2, $y2, $color, $strokewidth ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'line',
        points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
        stroke    => $color,
        strokewidth => 1.0
    );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_line_range
{
    my ( $cv, $x, $y1, $y2, $color ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'line',
        points    =>  sprintf("%d,%d %d,%d", $x, $h-$y1, $x, $h-$y2 ),
        stroke    => $color
    );
}

# 符合直觉的坐标绘制（y在底部）
sub draw_rect_range
{
    my ( $cv, $x1, $x2, $y1, $y2, $fill, $stroke ) = @_;
    my ( $h ) = $cv->Get("Height");
    $cv->Draw(
        primitive => 'rectangle',
        points    =>  sprintf("%d,%d %d,%d", $x1, $h-$y1, $x2, $h-$y2 ),
        fill      => $fill,
        stroke    => $stroke,
    );
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }

1;
复制代码

use utf8;
use Encode;
use Modern::Perl;
use DBI;
use File::Slurp;
use File::Path qw/make_path/;
use File::Basename;
use Mojo::UserAgent;
use Date::Format;  # time2str
use Date::Parse;   # str2time
use List::Util qw/max min sum/;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);

use FindBin;
use lib $FindBin::Bin;
use DrawKlineMA;

# 数据库路径不需要转换为GBK
my $db = "stock_data.sqlite";
my $dbh = DBI->connect("dbi:SQLite:dbname=$db") or die "can not connect DB: $DBI::errstr";

my $codes_in_db = $dbh->selectcol_arrayref( "SELECT DISTINCT symbol FROM 日K" );
my $total_in_db = scalar @$codes_in_db;

# 股票代号 - 名称 对照表
my $index = from_json( uni(scalar(read_file( "index.json" ))) );
my $baseinfo_all = from_json( uni(scalar(read_file( "baseInfo_all.json" ))) );
my $concept;
for my $e ( @{$baseinfo_all->{'data'}} )
{
    $concept->{$e->{code}} = $e->{'concept'} .",". $e->{'z52'};
}

my $output_dir = "./先进封装";
mkdir gbk($output_dir) unless -d gbk($output_dir);

for my $code ( @$codes_in_db )
{
    next if $code =~ /TEST/i;
    # next unless $code eq "001268";
    # printf "current: %s\n", $code;

    my $name = exists $index->{'index_by_code'}{$code} ? $index->{'index_by_code'}{$code} : "unknow";
    my $data = load_kline_data( $dbh, $code, 90 );
    
    # 如果少于90天，PASS
    next if scalar( @$data ) < 90;
    # 工业母机 工业4.0
    # 一带一路 and 新疆
    if ( not exists $concept->{ $code } )
    {
        printf "${code}: concept not found\n";
        next;
    }

    next unless $concept->{ $code } =~ /钙钛/;
    next unless $concept->{ $code } =~ /半导体/;

    # next unless $concept->{ $code } =~ /华为/;
    # next unless $concept->{ $code } =~ /ChatGPT/;

    printf "%s %s\n", $code, gbk($name);

    # next;

    my $export = "${output_dir}/${code}-${name}.png";
    DrawKlineMA::Draw( $code, $name, $data, $concept->{$code}, $export );
}

sub load_kline_data
{
    my ( $dbh, $code, $n ) = @_;

    # 查询数据
    my $query = "SELECT * FROM 日K WHERE symbol = ? ORDER BY date DESC LIMIT ?";

    # selectall_arrayref 函数可以返回带列标名称的哈希数据
    # $n 表示要获取的行数
    my $result = $dbh->selectall_arrayref($query, { Slice => {} }, $code, $n);
    # print dump_json( $result );

    @$result = reverse @$result;
    return $result;
}

sub dump_json
{
    my ($data) = @_;
    return to_json( $data, { allow_blessed => 1, allow_tags => 1, pretty => 1, canonical => 1 });
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
复制代码

    //创建 fbo 根据日期范围决定 画布宽度
    int fbo_width = (int)(bar_width + padding) * count_of_days + 100;
    fbo = gl::Fbo::create(fbo_width, canvas_h, fbo_fmt);

    cout << "fbo_width:" << fbo_width << endl;
复制代码

        fbo->bindFramebuffer();
        gl::viewport(0, 0, w, h);
        mCam.setOrtho( -center.x, center.x, -center.y, center.y, 0.1, 1000.0);
复制代码

writeImage( fs::path( imgfile ), fbo->getColorTexture()->createSource() ); 
复制代码

        uniform int hint;
        uniform vec4 color1;
        uniform vec4 color2;
        uniform int left;
        out vec4 FragColor;

        void main( void )
        {
            ivec2 coord = ivec2(gl_FragCoord.xy);

            if ( (coord.x-left+coord.y) % 6 > hint ) {
                FragColor = color1;
            } else {
                FragColor = color2;
            }
        }
复制代码