[原创代码] AliExpress 库存修改工具

523066680

平台最近改版，库存修改极其难用，做一个趁手工具，当作练习。

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 }
}COPY

523066680

Web.pm

package Web;
use Modern::Perl;
use Mojo::UserAgent;
use JSON qw/from_json to_json/;
use Data::Dumper;
use File::Slurp;
$Data::Dumper::Indent = 1;
STDOUT->autoflush(1);
 
my $log = "record.log";
write_file($log, "");
 
sub get_data
{
    my ($ua, $id) = @_;
    my $url = "https://gsp-gw.aliexpress.com/openapi/param2/1/gateway.seller/api.product.manager.operation.render?optId=editStock&single=1";
    my %args = ( productId => $id );
    my $res = $ua->post( $url, form => \%args )->result;
    my $json = $res->json;
    die "failed" unless $json->{success} eq "true";
    my $data = from_json( $json->{data} );
    return $data->{value};
}
 
sub post_data
{
    my ($ua, $id, $data) = @_;
    my $url = "https://gsp-gw.aliexpress.com/openapi/param2/1/gateway.seller/api.product.manager.operation.submit?optId=editStock&single=1";
    my %args = (
        'productId' => "$id",
        'jsonBody' => to_json($data),
        );
    my $res = $ua->post( $url, form => \%args  )->result;
 
    write_file( $log , {append => 1 }, to_json( $data, {canonical => 1, pretty => 1} ) ."\n\n" ) ;
    return $res->body;
}
 
1;COPY

523066680

Load.pm

package Load;
use utf8;
use Encode;
use Modern::Perl;
use File::Slurp;
use Data::Dumper;
use JSON qw/from_json to_json/;
STDOUT->autoflush(1);
 
sub data_to_list
{
    my ($data) = @_;
    my $sku = $data->{sku};
    my @temp;
    #print Dumper $sku;
    for my $e ( @$sku )
    {
        my $props = $e->{props};
        # 有些上传后没有别名，而是采用默认的颜色名称
        my $color = match( $props, "id", "14", "alias");
        $color = match( $props, "id", "14", "text") if not defined $color;
        my $from = match( $props, "id", "200007763", "text");
        my $stock = $e->{totalStock};
        $from =~ s/^ru.*/RU/i;
        $from =~ s/^sp.*/ES/i;
        $from =~ s/^ch.*/CN/i;
        $color = color_format($color);
        push @temp, [$from, $color, $stock, $e];
        #printf "%s %s %d\n", $color, $from,
    }
 
    # 避免混合，将国家分类排序
    my $idx = 1;
    my @list = ([0]);
    for my $ref ( sort { $a->[0] cmp $b->[0] } @temp )
    {
        push @list, [ $idx++, @$ref ];
    }
 
    return \@list;
}
 
sub color_format
{
    my ($name) = @_;
    if ($name =~/(.+)\s?(black|beige|gray)/i)
    {
        $name = sprintf "%15s %-5s", $1, $2;
    }
    return $name;
}
 
sub match
{
    my ( $aref, $key, $value, $item ) = @_;
    for my $e ( @$aref ) {
        return $e->{$item} if ( exists $e->{$key} and $e->{$key} =~ /$value/ );
    }
    return "NOT FOUND";
}
 
1;COPY