正版王中王香港资料新手入门导读[视频教程]正版王中王香港资料基础视频教程[视频教程]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

返回列表