忘记密码   免费注册 查看新帖 | 论坛精华区

ChinaUnix.net

  平台 论坛 博客 认证专区 大话IT HPC论坛 徽章 文库 沙龙 自测 下载 频道自动化运维 虚拟化 储存备份 C/C++ PHP MySQL 嵌入式 Linux系统
12下一页
最近访问板块 发新帖
查看: 741 | 回复: 10

Mojo UserAgent 上传文件,进度问题 [复制链接]

论坛徽章:
0
发表于 2017-06-12 23:50 |显示全部楼层
本帖最后由 maybenot 于 2017-06-13 07:04 编辑

服务器端:(Cookbook上的例子)
  1. use Mojolicious::Lite;
  2. use Scalar::Util 'weaken';

  3. # Intercept multipart uploads and log each chunk received
  4. hook after_build_tx => sub {
  5.   my $tx = shift;

  6.   # Subscribe to "upgrade" event to identify multipart uploads
  7.   weaken $tx;
  8.   $tx->req->content->on(upgrade => sub {
  9.     my ($single, $multi) = @_;
  10.     return unless $tx->req->url->path->contains('/upload');

  11.     # Subscribe to "part" event to find the right one
  12.     $multi->on(part => sub {
  13.       my ($multi, $single) = @_;

  14.       # Subscribe to "body" event of part to make sure we have all headers
  15.       $single->on(body => sub {
  16.         my $single = shift;

  17.         # Make sure we have the right part and replace "read" event
  18.         return unless $single->headers->content_disposition =~ /example/;
  19.         $single->unsubscribe('read')->on(read => sub {
  20.           my ($single, $bytes) = @_;

  21.           # Log size of every chunk we receive
  22.           app->log->debug(length($bytes) . ' bytes uploaded');
  23.         });
  24.       });
  25.     });
  26.   });
  27. };

  28. # Upload form in DATA section
  29. get '/' => 'index';

  30. # Streaming multipart upload
  31. post '/upload' => sub {
  32.    my $c = shift;
  33.    my @files;
  34.    for my $file ($c->req->upload('example')) {
  35.        push @files, $file->filename;
  36.    }
  37.    $c->render(text => "file names:\n@files");
  38. };

  39. app->start;
  40. __DATA__

  41. @@ index.html.ep
  42. <!DOCTYPE html>
  43. <html>
  44.   <head><title>Streaming multipart upload</title></head>
  45.   <body>
  46.     %= form_for upload => (enctype => 'multipart/form-data') => begin
  47.       %= file_field 'example'
  48.       %= submit_button 'Upload'
  49.     % end
  50.   </body>
  51. </html>
复制代码

然后用UserAgent上传文件:
  1. use Mojo::UserAgent;

  2. my $url = "http://127.0.0.1:3000/upload";
  3. my $ua  = Mojo::UserAgent->new();
  4. my $tx  = $ua->build_tx(POST => $url=> form => {example => { file=>'D:/report_data2.txt' }});
  5. $tx->req->on(progress => sub {
  6.     my $msg = shift;
  7.     return unless my $len = $msg->headers->content_length;
  8.     my $size = $msg->content->progress;
  9.     say 'Progress: ', $size == $len ? 100 : int($size / ($len / 100)), '%';
  10. });
  11. $tx = $ua->start($tx);
  12. print $tx->res->body;
复制代码
UA端代码我是参照的这里http://www.yishuiyixu.com/article/115
仅仅把$tx->res改成了$tx->req,文件上传成功并返回文件名没问题,就是进度信息不对,打印出很多0%
还请指点!

论坛徽章:
0
发表于 2017-06-15 11:06 |显示全部楼层

论坛徽章:
0
发表于 2017-06-15 11:14 |显示全部楼层

论坛徽章:
0
发表于 2017-06-15 13:14 |显示全部楼层
请教一下perl服务器端代码要如何测试运行? 本机Window中启动的IIS服务应该不能运行吧?
是否要linux系统?cygwin是否可以?

论坛徽章:
0
发表于 2017-06-15 15:35 |显示全部楼层
不用配置服务器. 直接morbo xxx.pl

https://metacpan.org/pod/distribution/Mojolicious/script/morbo

论坛徽章:
0
发表于 2017-06-15 21:55 |显示全部楼层
回复 4# hztj2005

安装Mojo之后自带的morbo命令就是服务端了,你看下文档

论坛徽章:
0
发表于 2017-06-15 23:22 |显示全部楼层
看Mojo::Message的source https://metacpan.org/source/SRI/ ... ojo/Message.pm#L111

所以可以是这样
  1. $tx->req->on(
  2.     progress => sub {
  3.         my ( $msg, $type, $offset ) = @_;
  4.         return unless $type eq 'body';

  5.         return unless my $len = $msg->headers->content_length;

  6.         say "Progress: ",
  7.           $offset == $len ? 100 : int( $offset / ( $len / 100 ) ),
  8.           '%';
  9.     }
  10. );
复制代码

论坛徽章:
0
发表于 2017-06-15 23:40 |显示全部楼层
maybenot 发表于 2017-06-15 21:55
回复 4# hztj2005

安装Mojo之后自带的morbo命令就是服务端了,你看下文档

谢谢!搜了一下网上,用下面行启动了你服务器端代码:
morbo -w ./lib -w ./templates ./mojosever.pl

然后另开一个DOS窗口,运行你客户端的代码,上传文件:

D:\Perl\perlandlwp\perllwp_examples\mojopl>perl uploadfile.pl
Progress: 0%
Progress: 0%
Progress: 0%
Progress: 0%
Progress: 0%
file names:
weblist.txt

似乎是成功了。

但是上传到服务器文件在硬盘什么地方呢?

我没有找到,继续请教。

论坛徽章:
0
发表于 2017-06-16 00:46 |显示全部楼层
回复 8# hztj2005

  •    for my $file ($c->req->upload('example')) {
  •        push @files, $file->filename;
  •        $file->move_to("E:/132.txt"); #这样试试
  •    }

论坛徽章:
0
发表于 2017-06-16 00:46 |显示全部楼层
回复 8# hztj2005

  •    for my $file ($c->req->upload('example')) {
  •        push @files, $file->filename;
  •        $file->move_to("E:/132.txt"); #这样试试
  •    }
您需要登录后才可以回帖 登录 | 注册

本版积分规则

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号 北京市公安局海淀分局网监中心备案编号:11010802020122
广播电视节目制作经营许可证(京) 字第1234号 中国互联网协会会员  联系我们:
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP