标题: [原创代码] AliExpress 库存修改工具 [打印本页]
作者: 523066680 时间: 2019-9-2 12:55 标题: AliExpress 库存修改工具
平台最近改版,库存修改极其难用,做一个趁手工具,当作练习。
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 }
- }
复制代码
作者: 523066680 时间: 2019-9-2 12:56
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;
复制代码
作者: 523066680 时间: 2019-9-2 12:56
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;
复制代码
欢迎光临 批处理之家 (http://bbs.bathome.net/) |
Powered by Discuz! 7.2 |