Strawberry Perl 5.24
附加模块 IUP
代码: 全选
=info
AliExpress 库存修改工具
Author: 523066680/vicyang
2019-09
=cut
use utf8;
use Modern::Perl;
use IUP ':all';
use Mojo::UserAgent;
use Web;
use Login;
use Load;
use List::Util qw/sum/;
use Data::Dumper;
$Data::Dumper::Indent = 1;
STDOUT->autoflush(1);
my $log = 0;
my $ua = Mojo::UserAgent->new();
$ua->request_timeout(10);
my $data;
my $list;
my $count;
my $PID;
my $prompt = IUP::Text->new(
FONT => "Simsun, 10",
MULTILINE => "YES",
BORDER => "YES",
SCROLLBAR => "YES",
EXPAND=>"HORIZONTAL",
#EXPAND=>"YES",
BGCOLOR => "#000000",
FGCOLOR => "#FFFFFF",
SIZE => "0x60",
);
my $bt_login = IUP::Button->new(
TITLE => "Login",
FONT => "Arial", FONTSIZE => 12,
BORDER => "YES",
ACTION => sub {
$prompt->APPEND("Logging ... ");
Login::init($ua);
$prompt->APPENDNEWLINE("NO");
$prompt->APPEND("Done");
$prompt->APPENDNEWLINE("YES");
}
);
my $bt_catch = IUP::Button->new(
TITLE => "Catch",
FONT => "Arial", FONTSIZE => 12,
BORDER => "YES",
ACTION => \&catch,
);
my $bt_clean = IUP::Button->new(
TITLE => "Clean",
FONT => "Arial", FONTSIZE => 12,
BORDER => "YES",
ACTION => \&clean,
);
my $bt_update = IUP::Button->new(
TITLE => "Update",
FONT => "Arial", FONTSIZE => 12,
BORDER => "YES",
PADDING => "8x0",
ACTION => \&update
);
my $label_id = IUP::Label->new( MARGIN => 5, TITLE => "ID:", FONT => "Arial", FONTSIZE => 12 );
my $text_id = IUP::Text->new( MARGIN => 5, SIZE => "80x", FONT => "Arial", FONTSIZE => 12, BORDER =>"NO" );
my $box_top = IUP::Hbox->new(
MARGIN => 0,
GAP => 8,
ALIGNMENT => "ACENTER",
child => [
$bt_login, $label_id, $text_id, $bt_catch, $bt_update, $bt_clean
],
);
my $mat = IUP::Matrix->new(
NUMCOL => 5,
NUMLIN => 30,
HEIGHTDEF => 12,
PADDING => "0x0",
MARGIN => "0x0",
FONTSIZE => 10,
#WIDTH1 => 25, WIDTH2 => 50, WIDTH3 => 100, WIDTH4 => 75, WIDTH5 => 25, WIDTH6 => 25,
#EXPAND => "HORIZONTAL",
EXPAND => "YES",
BORDER => "NO",
);
my $max_width = 260;
my @title = qw/ID Country Model Count Update/;
my @ratio = ( 0, 0.5, 1, 3, 1, 1 );
my @width = map { int($max_width * ($_/sum(@ratio)) ) } @ratio;
print join(",", @width);
for my $id ( 0 .. $#width ) { $mat->SetAttribute( "WIDTH".$id, $width[$id] ); }
# 列标
for my $id ( 0 .. $#title ) {
$mat->MatCell( 0, $id+1, $title[$id] );
}
my $main = IUP::Vbox->new(
TABTITLE => "订单详情",
name => "vbox_major",
ALIGNMENT => "ALEFT",
GAP => 8,
child => [
$box_top,
$mat,
$prompt,
]
);
my $dlg = IUP::Dialog->new(
name => "major",
child => $main,
MARGIN => "10x10",
TITLE => "Stock Manager V0.5",
SIZE => "360x280",
SHOW_CB => \&show_cb,
#TOPMOST => "YES",
);
$dlg->Show();
# 置顶, 在 dlg 创建之后设置才有效
$dlg->TOPMOST("YES");
IUP->MainLoop;
sub show_cb
{
if ( $log == 0 ) {
$log++;
$prompt->APPEND("Logging ... ");
Login::init($ua);
$prompt->APPENDNEWLINE("NO");
$prompt->APPEND("Done");
$prompt->APPENDNEWLINE("YES");
}
}
sub catch
{
my ($self) = @_;
my $clip = IUP::Clipboard->new();
my $buff = $clip->TEXT();
if ($buff=~/\d{11,12}/) {
$PID = $buff;
} else {
$prompt->APPEND("剪切板没有ID信息");
}
$text_id->VALUE($PID);
$clip->Destroy();
$data = Web::get_data($ua, $PID);
$list = Load::data_to_list( $data );
for my $r ( 1 .. $#$list ) {
for my $c ( 0 .. 3 ) {
$mat->MatAttribute("BGCOLOR", $r, $c+1, "#F0F0D0") if ( $list->[$r][$c] eq "CN" );
$mat->MatAttribute("BGCOLOR", $r, $c+1, "#D0F0F0") if ( $list->[$r][$c] eq "RU" );
$mat->MatCell( $r, $c+1, $list->[$r][$c] );
}
}
$mat->ACTIVE("YES");
#print Dumper $data;
}
sub update
{
my ($self) = @_;
$prompt->APPEND("Update ... ");
for my $row ( 1 .. $#$list )
{
next unless $mat->MatCell($row, 5);
next if $mat->MatCell($row, 5) eq "";
next if ($mat->MatCell($row, 5) =~ /[^\d]/ ); # 检测非数字项
$list->[$row][4]->{totalStock} = $mat->MatCell($row, 5);
}
my $result = Web::post_data( $ua, $PID, $data );
#print Dumper $data;
# 清理右侧填入的数值
for my $r ( 1 .. $#$list ) { $mat->MatCell( $r, 5, ""); }
$data = Web::get_data($ua, $PID);
$list = Load::data_to_list( $data );
for my $r ( 1 .. $#$list ) {
for my $c ( 0 .. 3 ) {
$mat->MatAttribute("BGCOLOR", $r, $c+1, "#F0F0D0") if ( $list->[$r][$c] eq "CN" );
$mat->MatAttribute("BGCOLOR", $r, $c+1, "#D0F0F0") if ( $list->[$r][$c] eq "RU" );
$mat->MatCell( $r, $c+1, $list->[$r][$c] );
}
}
$mat->ACTIVE("YES");
$prompt->APPENDNEWLINE("NO");
$prompt->APPEND("Done");
$prompt->APPEND( $result );
$prompt->APPENDNEWLINE("YES");
}
sub clean {
my ($self) = @_;
$prompt->VALUE("");
for my $r ( 1 .. $#$list ) {
for my $c ( 0 .. 4 ) {
$mat->MatAttribute("BGCOLOR", $r, $c+1, "#FFFFFF");
$mat->MatCell( $r, $c+1, undef);
}
}
$data = undef;
$list = undef;
$PID = undef;
$mat->ACTIVE("YES");
};
sub in_range {
my ($v, $a, $b) = @_;
if ( $v >= $a and $v <= $b ) { return 1 } else { return 0 }
}