批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
[批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
返回列表 发帖

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

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


Strawberry Perl 5.24
附加模块 IUP
  1. =info
  2.     AliExpress 库存修改工具
  3.     Author: 523066680/vicyang
  4.     2019-09
  5. =cut
  6. use utf8;
  7. use Modern::Perl;
  8. use IUP ':all';
  9. use Mojo::UserAgent;
  10. use Web;
  11. use Login;
  12. use Load;
  13. use List::Util qw/sum/;
  14. use Data::Dumper;
  15. $Data::Dumper::Indent = 1;
  16. STDOUT->autoflush(1);
  17. my $log = 0;
  18. my $ua = Mojo::UserAgent->new();
  19. $ua->request_timeout(10);
  20. my $data;
  21. my $list;
  22. my $count;
  23. my $PID;
  24. my $prompt = IUP::Text->new(
  25.     FONT => "Simsun, 10",
  26.     MULTILINE => "YES",
  27.     BORDER    => "YES",
  28.     SCROLLBAR => "YES",
  29.     EXPAND=>"HORIZONTAL",
  30.     #EXPAND=>"YES",
  31.     BGCOLOR => "#000000",
  32.     FGCOLOR => "#FFFFFF",
  33.     SIZE => "0x60",
  34. );
  35. my $bt_login = IUP::Button->new(
  36.                 TITLE => "Login",
  37.                 FONT => "Arial", FONTSIZE => 12,
  38.                 BORDER => "YES",
  39.                 ACTION  => sub {
  40.                     $prompt->APPEND("Logging ... ");
  41.                     Login::init($ua);
  42.                     $prompt->APPENDNEWLINE("NO");
  43.                     $prompt->APPEND("Done");
  44.                     $prompt->APPENDNEWLINE("YES");
  45.                 }
  46.             );
  47. my $bt_catch = IUP::Button->new(
  48.                 TITLE => "Catch",
  49.                 FONT => "Arial", FONTSIZE => 12,
  50.                 BORDER => "YES",
  51.                 ACTION => \&catch,
  52.             );
  53. my $bt_clean = IUP::Button->new(
  54.                 TITLE => "Clean",
  55.                 FONT => "Arial", FONTSIZE => 12,
  56.                 BORDER => "YES",
  57.                 ACTION => \&clean,
  58.             );
  59. my $bt_update = IUP::Button->new(
  60.                 TITLE => "Update",
  61.                 FONT => "Arial", FONTSIZE => 12,
  62.                 BORDER => "YES",
  63.                 PADDING => "8x0",
  64.                 ACTION  => \&update
  65.             );
  66. my $label_id = IUP::Label->new( MARGIN => 5, TITLE => "ID:", FONT => "Arial", FONTSIZE => 12 );
  67. my $text_id = IUP::Text->new( MARGIN => 5, SIZE => "80x", FONT => "Arial", FONTSIZE => 12, BORDER =>"NO" );
  68. my $box_top = IUP::Hbox->new(
  69.                 MARGIN => 0,
  70.                 GAP    => 8,
  71.                 ALIGNMENT => "ACENTER",
  72.                 child => [
  73.                     $bt_login, $label_id, $text_id, $bt_catch, $bt_update, $bt_clean
  74.                 ],
  75.     );
  76. my $mat = IUP::Matrix->new(
  77.     NUMCOL         => 5,
  78.     NUMLIN         => 30,
  79.     HEIGHTDEF       => 12,
  80.     PADDING => "0x0",
  81.     MARGIN => "0x0",
  82.     FONTSIZE => 10,
  83.     #WIDTH1 => 25, WIDTH2 => 50, WIDTH3 => 100, WIDTH4 => 75, WIDTH5 => 25, WIDTH6 => 25,
  84.     #EXPAND => "HORIZONTAL",
  85.     EXPAND => "YES",
  86.     BORDER => "NO",
  87. );
  88. my $max_width = 260;
  89. my @title = qw/ID Country Model Count Update/;
  90. my @ratio = ( 0, 0.5, 1, 3, 1, 1 );
  91. my @width = map { int($max_width * ($_/sum(@ratio)) ) } @ratio;
  92. print join(",", @width);
  93. for my $id ( 0 .. $#width ) { $mat->SetAttribute( "WIDTH".$id, $width[$id] ); }
  94. # 列标
  95. for my $id ( 0 .. $#title ) {
  96.     $mat->MatCell( 0, $id+1, $title[$id] );
  97. }
  98. my $main = IUP::Vbox->new(
  99.     TABTITLE  => "订单详情",
  100.     name => "vbox_major",
  101.     ALIGNMENT => "ALEFT",
  102.     GAP       => 8,
  103.     child => [
  104.         $box_top,
  105.         $mat,
  106.         $prompt,
  107.     ]
  108. );
  109. my $dlg = IUP::Dialog->new(
  110.     name => "major",
  111.     child  => $main,
  112.     MARGIN => "10x10",
  113.     TITLE  => "Stock Manager V0.5",
  114.     SIZE   => "360x280",
  115.     SHOW_CB => \&show_cb,
  116.     #TOPMOST => "YES",
  117. );
  118. $dlg->Show();
  119. # 置顶, 在 dlg 创建之后设置才有效
  120. $dlg->TOPMOST("YES");
  121. IUP->MainLoop;
  122. sub show_cb
  123. {
  124.     if ( $log == 0 ) {
  125.         $log++;
  126.         $prompt->APPEND("Logging ... ");
  127.         Login::init($ua);
  128.         $prompt->APPENDNEWLINE("NO");
  129.         $prompt->APPEND("Done");
  130.         $prompt->APPENDNEWLINE("YES");
  131.     }
  132. }
  133. sub catch
  134. {
  135.     my ($self) = @_;
  136.     my $clip = IUP::Clipboard->new();
  137.     my $buff = $clip->TEXT();
  138.     if ($buff=~/\d{11,12}/) {
  139.         $PID = $buff;
  140.     } else {
  141.         $prompt->APPEND("剪切板没有ID信息");
  142.     }
  143.     $text_id->VALUE($PID);
  144.     $clip->Destroy();
  145.     $data = Web::get_data($ua, $PID);
  146.     $list = Load::data_to_list( $data );
  147.     for my $r ( 1 .. $#$list ) {
  148.         for my $c ( 0 .. 3 ) {
  149.             $mat->MatAttribute("BGCOLOR", $r, $c+1, "#F0F0D0") if ( $list->[$r][$c] eq "CN" );
  150.             $mat->MatAttribute("BGCOLOR", $r, $c+1, "#D0F0F0") if ( $list->[$r][$c] eq "RU" );
  151.             $mat->MatCell( $r, $c+1, $list->[$r][$c] );
  152.         }
  153.     }
  154.     $mat->ACTIVE("YES");
  155.     #print Dumper $data;
  156. }
  157. sub update
  158. {
  159.     my ($self) = @_;
  160.     $prompt->APPEND("Update ... ");
  161.     for my $row ( 1 .. $#$list )
  162.     {
  163.         next unless $mat->MatCell($row, 5);
  164.         next if $mat->MatCell($row, 5) eq "";
  165.         next if ($mat->MatCell($row, 5) =~ /[^\d]/ ); # 检测非数字项
  166.         $list->[$row][4]->{totalStock} = $mat->MatCell($row, 5);
  167.     }
  168.     my $result = Web::post_data( $ua, $PID, $data );
  169.     #print Dumper $data;
  170.     # 清理右侧填入的数值        
  171.     for my $r ( 1 .. $#$list ) { $mat->MatCell( $r, 5, ""); }
  172.     $data = Web::get_data($ua, $PID);
  173.     $list = Load::data_to_list( $data );
  174.     for my $r ( 1 .. $#$list ) {
  175.         for my $c ( 0 .. 3 ) {
  176.             $mat->MatAttribute("BGCOLOR", $r, $c+1, "#F0F0D0") if ( $list->[$r][$c] eq "CN" );
  177.             $mat->MatAttribute("BGCOLOR", $r, $c+1, "#D0F0F0") if ( $list->[$r][$c] eq "RU" );
  178.             $mat->MatCell( $r, $c+1, $list->[$r][$c] );
  179.         }
  180.     }
  181.     $mat->ACTIVE("YES");
  182.    
  183.     $prompt->APPENDNEWLINE("NO");
  184.     $prompt->APPEND("Done");
  185.     $prompt->APPEND( $result );
  186.     $prompt->APPENDNEWLINE("YES");
  187. }
  188. sub clean {
  189.     my ($self) = @_;
  190.     $prompt->VALUE("");
  191.     for my $r ( 1 .. $#$list ) {
  192.         for my $c ( 0 .. 4 ) {
  193.             $mat->MatAttribute("BGCOLOR", $r, $c+1, "#FFFFFF");
  194.             $mat->MatCell( $r, $c+1, undef);
  195.         }
  196.     }
  197.     $data = undef;
  198.     $list = undef;
  199.     $PID = undef;
  200.     $mat->ACTIVE("YES");
  201. };
  202. sub in_range {
  203.     my ($v, $a, $b) = @_;
  204.     if ( $v >= $a and $v <= $b ) { return 1 } else { return 0 }
  205. }
复制代码
附件: 您需要登录才可以下载或查看附件。没有帐号?注册
综合型编程论坛
Writing Code That Nobody Else Can Read.

Web.pm
  1. package Web;
  2. use Modern::Perl;
  3. use Mojo::UserAgent;
  4. use JSON qw/from_json to_json/;
  5. use Data::Dumper;
  6. use File::Slurp;
  7. $Data::Dumper::Indent = 1;
  8. STDOUT->autoflush(1);
  9. my $log = "record.log";
  10. write_file($log, "");
  11. sub get_data
  12. {
  13.     my ($ua, $id) = @_;
  14.     my $url = "https://gsp-gw.aliexpress.com/openapi/param2/1/gateway.seller/api.product.manager.operation.render?optId=editStock&single=1";
  15.     my %args = ( productId => $id );
  16.     my $res = $ua->post( $url, form => \%args )->result;
  17.     my $json = $res->json;
  18.     die "failed" unless $json->{success} eq "true";
  19.     my $data = from_json( $json->{data} );
  20.     return $data->{value};
  21. }
  22. sub post_data
  23. {
  24.     my ($ua, $id, $data) = @_;
  25.     my $url = "https://gsp-gw.aliexpress.com/openapi/param2/1/gateway.seller/api.product.manager.operation.submit?optId=editStock&single=1";
  26.     my %args = (
  27.         'productId' => "$id",
  28.         'jsonBody' => to_json($data),
  29.         );
  30.     my $res = $ua->post( $url, form => \%args  )->result;
  31.     write_file( $log , {append => 1 }, to_json( $data, {canonical => 1, pretty => 1} ) ."\n\n" ) ;
  32.     return $res->body;
  33. }
  34. 1;
复制代码
综合型编程论坛
Writing Code That Nobody Else Can Read.

TOP

Load.pm
  1. package Load;
  2. use utf8;
  3. use Encode;
  4. use Modern::Perl;
  5. use File::Slurp;
  6. use Data::Dumper;
  7. use JSON qw/from_json to_json/;
  8. STDOUT->autoflush(1);
  9. sub data_to_list
  10. {
  11.     my ($data) = @_;
  12.     my $sku = $data->{sku};
  13.     my @temp;
  14.     #print Dumper $sku;
  15.     for my $e ( @$sku )
  16.     {
  17.         my $props = $e->{props};
  18.         # 有些上传后没有别名,而是采用默认的颜色名称
  19.         my $color = match( $props, "id", "14", "alias");
  20.         $color = match( $props, "id", "14", "text") if not defined $color;
  21.         my $from = match( $props, "id", "200007763", "text");
  22.         my $stock = $e->{totalStock};
  23.         $from =~ s/^ru.*/RU/i;
  24.         $from =~ s/^sp.*/ES/i;
  25.         $from =~ s/^ch.*/CN/i;
  26.         $color = color_format($color);
  27.         push @temp, [$from, $color, $stock, $e];
  28.         #printf "%s %s %d\n", $color, $from,
  29.     }
  30.     # 避免混合,将国家分类排序
  31.     my $idx = 1;
  32.     my @list = ([0]);
  33.     for my $ref ( sort { $a->[0] cmp $b->[0] } @temp )
  34.     {
  35.         push @list, [ $idx++, @$ref ];
  36.     }
  37.     return \@list;
  38. }
  39. sub color_format
  40. {
  41.     my ($name) = @_;
  42.     if ($name =~/(.+)\s?(black|beige|gray)/i)
  43.     {
  44.         $name = sprintf "%15s %-5s", $1, $2;
  45.     }
  46.     return $name;
  47. }
  48. sub match
  49. {
  50.     my ( $aref, $key, $value, $item ) = @_;
  51.     for my $e ( @$aref ) {
  52.         return $e->{$item} if ( exists $e->{$key} and $e->{$key} =~ /$value/ );
  53.     }
  54.     return "NOT FOUND";
  55. }
  56. 1;
复制代码
综合型编程论坛
Writing Code That Nobody Else Can Read.

TOP

返回列表