line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
1
|
|
|
1
|
|
7
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
41
|
|
2
|
1
|
|
|
1
|
|
7
|
use File::Temp; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
70
|
|
3
|
1
|
|
|
1
|
|
46
|
use File::Basename (); |
|
1
|
|
|
|
|
5
|
|
|
1
|
|
|
|
|
20
|
|
4
|
1
|
|
|
1
|
|
6
|
use Mojo::Util (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
5
|
1
|
|
|
1
|
|
6
|
use POSIX (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
17
|
|
6
|
1
|
|
|
1
|
|
5
|
use Mojo::Weixin::Const qw(); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2225
|
|
7
|
|
|
|
|
|
|
sub Mojo::Weixin::_upload_media { |
8
|
0
|
|
|
0
|
|
|
my $self = shift; |
9
|
0
|
|
|
|
|
|
my $msg = shift; |
10
|
0
|
|
|
|
|
|
my $callback = shift; |
11
|
0
|
|
0
|
|
|
|
my $max_media_size = $self->media_size_max // 20 * 1024 *1024; |
12
|
0
|
0
|
0
|
|
|
|
if(!defined $msg or (!defined $msg->media_data and !defined $msg->media_path)){ |
|
|
|
0
|
|
|
|
|
13
|
0
|
|
|
|
|
|
$self->error("无效的media"); |
14
|
0
|
|
|
|
|
|
$callback->($msg,"invaild media"); |
15
|
0
|
|
|
|
|
|
return; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
$self->steps( |
18
|
|
|
|
|
|
|
sub{ |
19
|
0
|
|
|
0
|
|
|
my $delay = shift; |
20
|
0
|
|
|
|
|
|
my $end = $delay->begin(0,); |
21
|
0
|
0
|
|
|
|
|
if(defined $msg->media_data){ |
|
|
0
|
|
|
|
|
|
22
|
0
|
|
|
|
|
|
my $r = sub{my $r = sprintf "%.3f", rand();$r=~s/\.//g;return $self->now() . $r;}->(); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
23
|
0
|
0
|
|
|
|
|
$msg->media_ext("dat") if not defined $msg->media_ext; |
24
|
0
|
0
|
|
|
|
|
$msg->media_name($r . "." . $msg->media_ext) if not defined $msg->media_name; |
25
|
0
|
0
|
|
|
|
|
$msg->media_path($msg->media_name) if not defined $msg->media_path; |
26
|
0
|
0
|
|
|
|
|
$msg->media_size(length($msg->media_data)) if not defined $msg->media_size; |
27
|
|
|
|
|
|
|
|
28
|
0
|
0
|
|
|
|
|
if($msg->media_size > $max_media_size){ |
29
|
0
|
|
|
|
|
|
$self->error("媒体[".$msg->media_path."]大小超出限制( 最大值 $max_media_size bytes)"); |
30
|
0
|
|
|
|
|
|
$end->($msg,"media size exceed, maximum size is $max_media_size bytes"); |
31
|
0
|
|
|
|
|
|
return; |
32
|
|
|
|
|
|
|
} |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
$msg->media_mime('application/octet-stream') if not defined $msg->media_mime; |
35
|
0
|
0
|
|
|
|
|
$msg->media_mtime(time) if not defined $msg->media_mtime; |
36
|
0
|
|
|
|
|
|
$end->($msg); |
37
|
0
|
|
|
|
|
|
return; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
elsif($msg->media_path=~/^https?:\/\/.*?([^\/]+)$/){ |
40
|
0
|
|
|
|
|
|
my $name = $1; |
41
|
0
|
|
|
|
|
|
my $ext = ''; |
42
|
0
|
0
|
|
|
|
|
$ext = $1 if $name =~ /\.([^\.]+)$/; |
43
|
|
|
|
|
|
|
$self->http_get($msg->media_path,sub{ |
44
|
0
|
|
|
|
|
|
my($body,$ua,$tx) = @_; |
45
|
0
|
0
|
|
|
|
|
return if not defined $body; |
46
|
0
|
|
0
|
|
|
|
my($mtime,$mime,$size) = ($tx->res->headers->last_modified || time, $tx->res->headers->content_type|| 'application/octet-stream',$tx->res->headers->content_length || length($body)); |
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
47
|
0
|
|
|
|
|
|
$mime=~s/;.*$//; |
48
|
0
|
0
|
|
|
|
|
if(not $ext){ |
49
|
0
|
0
|
|
|
|
|
$ext = $mime=~/^image\/jpe?g/i ? "jpg" |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
50
|
|
|
|
|
|
|
: $mime=~/^image\/png/i ? "png" |
51
|
|
|
|
|
|
|
: $mime=~/^image\/bmp/i ? "bmp" |
52
|
|
|
|
|
|
|
: $mime=~/^image\/gif/i ? "gif" |
53
|
|
|
|
|
|
|
: $mime=~/^text\/plain/i ? "txt" |
54
|
|
|
|
|
|
|
: $mime=~/^text\/html/i ? "html" |
55
|
|
|
|
|
|
|
: $mime=~/^text\/json/i ? "json" |
56
|
|
|
|
|
|
|
: $mime=~/^application\/json/i ? "json" |
57
|
|
|
|
|
|
|
: $mime=~/^video\/mp4/i ? "mp4" |
58
|
|
|
|
|
|
|
: $mime=~/^audio\/mp3/i ? "mp3" |
59
|
|
|
|
|
|
|
: $mime=~/^audio\/mpeg/i ? "mp3" |
60
|
|
|
|
|
|
|
: $mime=~/^application\/json/i ? "json" |
61
|
|
|
|
|
|
|
: "dat" |
62
|
|
|
|
|
|
|
; |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
0
|
0
|
|
|
|
|
$msg->media_size($size) if not defined $msg->media_size; |
66
|
0
|
0
|
|
|
|
|
if($msg->media_size > $max_media_size){ |
67
|
0
|
|
|
|
|
|
$self->error("媒体[".$msg->media_path."]大小超出限制( 最大值 $max_media_size bytes)"); |
68
|
0
|
|
|
|
|
|
$end->($msg,"media size exceed, maximum size is $max_media_size bytes"); |
69
|
0
|
|
|
|
|
|
return; |
70
|
|
|
|
|
|
|
} |
71
|
0
|
0
|
|
|
|
|
$msg->media_name($name) if not defined $msg->media_name; |
72
|
0
|
0
|
|
|
|
|
$msg->media_mime($mime) if not defined $msg->media_mime; |
73
|
0
|
0
|
|
|
|
|
$msg->media_mtime($mtime) if not defined $msg->media_mtime; |
74
|
0
|
0
|
|
|
|
|
$msg->media_data($body) if not defined $msg->media_data; |
75
|
0
|
0
|
|
|
|
|
$msg->media_ext($ext) if not defined $msg->media_ext; |
76
|
0
|
|
|
|
|
|
$end->($msg); |
77
|
0
|
|
|
|
|
|
}); |
78
|
0
|
|
|
|
|
|
return; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
else{ |
81
|
0
|
0
|
|
|
|
|
if(not -f $msg->media_path){ |
82
|
0
|
|
|
|
|
|
$self->error("无效的文件路径"); |
83
|
0
|
|
|
|
|
|
$callback->($msg,"invaild media_path"); |
84
|
0
|
|
|
|
|
|
return; |
85
|
|
|
|
|
|
|
} |
86
|
0
|
|
|
|
|
|
my %mime_map = ( |
87
|
|
|
|
|
|
|
jpeg => 'image/jpeg', |
88
|
|
|
|
|
|
|
jpg => 'image/jpeg', |
89
|
|
|
|
|
|
|
gif => 'image/gif', |
90
|
|
|
|
|
|
|
bmp => 'image/bmp', |
91
|
|
|
|
|
|
|
png => 'image/png', |
92
|
|
|
|
|
|
|
mp3 => 'audio/mp3', |
93
|
|
|
|
|
|
|
mp4 => 'video/mp4', |
94
|
|
|
|
|
|
|
); |
95
|
0
|
|
|
|
|
|
my $mime_reg = join "|",keys %mime_map; |
96
|
0
|
|
|
|
|
|
eval{ |
97
|
0
|
|
|
|
|
|
my $size = (stat($msg->media_path))[7]; |
98
|
0
|
0
|
|
|
|
|
if($size > $max_media_size){ |
99
|
0
|
|
|
|
|
|
$self->error("媒体[".$msg->media_path."]大小超出限制( 最大值 $max_media_size bytes)"); |
100
|
0
|
|
|
|
|
|
$end->($msg,"media size exceed, maximum size is $max_media_size bytes"); |
101
|
0
|
|
|
|
|
|
return; |
102
|
|
|
|
|
|
|
} |
103
|
0
|
|
|
|
|
|
my $name = File::Basename::basename($msg->media_path); |
104
|
0
|
|
|
|
|
|
my $data = $self->slurp($msg->media_path); |
105
|
0
|
|
|
|
|
|
my $mtime = (stat($msg->media_path))[9]; |
106
|
0
|
|
|
|
|
|
my $mime = 'application/octet-stream'; |
107
|
0
|
0
|
|
|
|
|
if($name=~/\.($mime_reg)$/) { |
108
|
0
|
|
|
|
|
|
$mime = $mime_map{$1}; |
109
|
|
|
|
|
|
|
} |
110
|
0
|
|
|
|
|
|
my $ext = ''; |
111
|
0
|
0
|
|
|
|
|
$ext = $1 if $name =~ /\.([^\.]+)$/; |
112
|
0
|
0
|
|
|
|
|
$ext = 'dat' if not $ext; |
113
|
|
|
|
|
|
|
|
114
|
0
|
0
|
|
|
|
|
$msg->media_name($name) if not defined $msg->media_name; |
115
|
0
|
0
|
|
|
|
|
$msg->media_size($size) if not defined $msg->media_size; |
116
|
0
|
0
|
|
|
|
|
$msg->media_mime($mime) if not defined $msg->media_mime; |
117
|
0
|
0
|
|
|
|
|
$msg->media_mtime($mtime) if not defined $msg->media_mtime; |
118
|
0
|
0
|
|
|
|
|
$msg->media_data($data) if not defined $msg->media_data; |
119
|
0
|
0
|
|
|
|
|
$msg->media_ext($ext) if not defined $msg->media_ext; |
120
|
0
|
|
|
|
|
|
$end->($msg); |
121
|
|
|
|
|
|
|
}; |
122
|
0
|
0
|
|
|
|
|
if($@){ |
123
|
0
|
|
|
|
|
|
$self->error("读取媒体文件" .$msg->media_path . "错误: $@"); |
124
|
0
|
|
|
|
|
|
$end->($msg,"media file read error: $@"); |
125
|
0
|
|
|
|
|
|
return; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
|
}, |
129
|
|
|
|
|
|
|
sub { |
130
|
0
|
|
|
0
|
|
|
my $delay = shift; |
131
|
0
|
|
|
|
|
|
my $msg = shift; |
132
|
0
|
|
|
|
|
|
my $err = shift; |
133
|
0
|
0
|
|
|
|
|
if($err){ |
134
|
0
|
|
|
|
|
|
$callback->($msg,$err); |
135
|
0
|
|
|
|
|
|
return; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
$msg->on(_upload_media_chunk_over=>sub{ |
138
|
0
|
|
|
|
|
|
my($msg,$err) = @_; |
139
|
0
|
0
|
|
|
|
|
if($err){#上传失败 |
|
|
0
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
$msg->client->error("媒体[".$msg->media_path."]上传失败: $err"); |
141
|
0
|
|
|
|
|
|
$callback->($msg,$err); |
142
|
0
|
|
|
|
|
|
return; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
elsif($msg->media_chunk == $msg->media_chunks){#最后一个分片上传完毕 |
145
|
0
|
|
|
|
|
|
$callback->($msg); |
146
|
0
|
|
|
|
|
|
return; |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
else{#继续上传下一个分片 |
149
|
0
|
|
|
|
|
|
$msg->emit("_upload_media_chunk"); |
150
|
|
|
|
|
|
|
} |
151
|
0
|
0
|
|
|
|
|
}) if !$msg->has_subscribers('_upload_media_chunk_over'); |
152
|
|
|
|
|
|
|
$msg->on(_upload_media_chunk=>sub{ |
153
|
0
|
|
|
|
|
|
my $msg = shift;_upload_chunk($msg->client,$msg,sub{my $msg=shift;$msg->emit(_upload_media_chunk_over=>@_)}); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
154
|
0
|
0
|
|
|
|
|
}) if !$msg->has_subscribers('_upload_media_chunk');; |
155
|
0
|
|
|
|
|
|
$msg->emit("_upload_media_chunk"); |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
} |
158
|
0
|
|
|
|
|
|
); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
sub _upload_chunk{ |
162
|
0
|
|
|
0
|
|
|
my ($self,$msg,$callback) = @_; |
163
|
0
|
0
|
|
|
|
|
if(!defined $msg->media_chunks){ |
164
|
0
|
|
|
|
|
|
$msg->media_chunks(POSIX::ceil($msg->media_size/$self->media_chunk_size)); |
165
|
|
|
|
|
|
|
} |
166
|
0
|
0
|
|
|
|
|
if(!defined $msg->media_clientid){ |
167
|
|
|
|
|
|
|
#$msg->media_clientid($self->now); |
168
|
0
|
|
|
0
|
|
|
$msg->media_clientid(sub{my $r = sprintf "%.3f", rand();$r=~s/\.//g;return $self->now() . $r;}->()); |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
} |
170
|
0
|
|
|
|
|
|
$self->debug("正在上传媒体[". $msg->media_path ."],当前进度:" . ($msg->media_chunk+1) . "/" . $msg->media_chunks); |
171
|
0
|
0
|
|
|
|
|
my $uploadmediarequest = { |
172
|
|
|
|
|
|
|
BaseRequest => { |
173
|
|
|
|
|
|
|
DeviceID => $self->deviceid, |
174
|
|
|
|
|
|
|
Sid => $self->wxsid, |
175
|
|
|
|
|
|
|
Skey => $self->skey, |
176
|
|
|
|
|
|
|
Uin => $self->wxuin, |
177
|
|
|
|
|
|
|
}, |
178
|
|
|
|
|
|
|
ClientMediaId => $msg->media_clientid, |
179
|
|
|
|
|
|
|
TotalLen => $msg->media_size, |
180
|
|
|
|
|
|
|
StartPos => 0, |
181
|
|
|
|
|
|
|
DataLen => $msg->media_size, |
182
|
|
|
|
|
|
|
MediaType => 4, |
183
|
|
|
|
|
|
|
FromUserName => $msg->sender_id, |
184
|
|
|
|
|
|
|
ToUserName => ($msg->type eq "group_message"?$msg->group_id:$msg->receiver_id), |
185
|
|
|
|
|
|
|
UploadType=> 2, |
186
|
|
|
|
|
|
|
}; |
187
|
0
|
0
|
0
|
|
|
|
if(!defined $msg->media_md5 and defined $msg->media_data){ $msg->media_md5( Mojo::Util::md5_sum($msg->media_data ))} |
|
0
|
|
|
|
|
|
|
188
|
0
|
0
|
|
|
|
|
$uploadmediarequest->{FileMd5} = $msg->media_md5 if defined $msg->media_md5; |
189
|
|
|
|
|
|
|
|
190
|
0
|
0
|
|
|
|
|
if(not defined $msg->media_type){ |
191
|
0
|
0
|
|
|
|
|
my $media_type = $msg->media_mime=~/^image\/gif/i ? "emoticon" |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
192
|
|
|
|
|
|
|
: $msg->media_mime=~/^video\/(mp4|mpeg)/i ? "video" |
193
|
|
|
|
|
|
|
# : $msg->media_mime=~/^audio\/mp3/i ? "voice" |
194
|
|
|
|
|
|
|
: $msg->media_mime=~/^image\// ? "image" |
195
|
|
|
|
|
|
|
: "file" |
196
|
|
|
|
|
|
|
; |
197
|
0
|
|
|
|
|
|
$msg->media_type($media_type); |
198
|
|
|
|
|
|
|
} |
199
|
0
|
|
0
|
|
|
|
$msg->media_code($Mojo::Weixin::Const::KEY_MAP_MEDIA_CODE{$msg->media_type} || 6); |
200
|
0
|
0
|
|
|
|
|
my $msg_content = $msg->media_type eq "image" ? "[图片]" |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
201
|
|
|
|
|
|
|
: $msg->media_type eq "emoticon" ? "[表情]" |
202
|
|
|
|
|
|
|
: $msg->media_type eq "video" ? "[视频]" |
203
|
|
|
|
|
|
|
: $msg->media_type eq "microvideo"? "[小视频]" |
204
|
|
|
|
|
|
|
: $msg->media_type eq "voicce" ? "[语音]" |
205
|
|
|
|
|
|
|
: $msg->media_type eq "file" ? "[文件]" |
206
|
|
|
|
|
|
|
: "[文件]" |
207
|
|
|
|
|
|
|
; |
208
|
0
|
|
|
|
|
|
$msg->content($msg_content . "(" . $msg->media_path . ")"); |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
$self->http_post( |
211
|
|
|
|
|
|
|
'https://file.' . $self->domain .'/cgi-bin/mmwebwx-bin/webwxuploadmedia?f=json', |
212
|
|
|
|
|
|
|
{ json=>1, |
213
|
|
|
|
|
|
|
Referer=>'https://' . $self->domain . '/', |
214
|
|
|
|
|
|
|
ua_request_timeout => 120, |
215
|
|
|
|
|
|
|
ua_inactivity_timeout => 120, |
216
|
|
|
|
|
|
|
}, |
217
|
|
|
|
|
|
|
form=>{ |
218
|
|
|
|
|
|
|
id=>'WU_FILE_0', |
219
|
|
|
|
|
|
|
name=>$msg->media_name, |
220
|
|
|
|
|
|
|
type=>$msg->media_mime, |
221
|
|
|
|
|
|
|
($msg->media_chunks>1?(chunks=>$msg->media_chunks):()), |
222
|
|
|
|
|
|
|
($msg->media_chunks>1?(chunk=>$msg->media_chunk):()), |
223
|
|
|
|
|
|
|
lastModifiedDate=>POSIX::strftime('%a %b %d %Y %H:%M:%S GMT+0800 (中国标准时间)',gmtime($msg->media_mtime)), |
224
|
|
|
|
|
|
|
size=>$msg->media_size, |
225
|
|
|
|
|
|
|
mediatype=>( |
226
|
|
|
|
|
|
|
$msg->media_type eq "image" ? "pic" |
227
|
|
|
|
|
|
|
: ($msg->media_type eq "video" or $msg->media_type eq "microvideo") ? "video" |
228
|
|
|
|
|
|
|
: "doc" |
229
|
|
|
|
|
|
|
), |
230
|
|
|
|
|
|
|
uploadmediarequest=>$self->to_json($uploadmediarequest), |
231
|
|
|
|
|
|
|
webwx_data_ticket=>$self->search_cookie("webwx_data_ticket"), |
232
|
|
|
|
|
|
|
pass_ticket => $self->pass_ticket, |
233
|
|
|
|
|
|
|
filename =>{ |
234
|
|
|
|
|
|
|
content=>substr($msg->media_data,$self->media_chunk_size * $msg->media_chunk,$self->media_chunk_size), |
235
|
|
|
|
|
|
|
filename=>$msg->media_name, |
236
|
|
|
|
|
|
|
'Content-Type' => $msg->media_mime // 'application/octet-stream', |
237
|
|
|
|
|
|
|
}, |
238
|
|
|
|
|
|
|
}, |
239
|
|
|
|
|
|
|
sub{ |
240
|
0
|
|
|
0
|
|
|
my $json = shift; |
241
|
0
|
0
|
|
|
|
|
if(not defined $json){ |
242
|
0
|
|
|
|
|
|
$callback->($msg,"media upload failure " . $msg->media_chunk. "/" . $msg->media_chunks ); |
243
|
0
|
|
|
|
|
|
return; |
244
|
|
|
|
|
|
|
} |
245
|
|
|
|
|
|
|
else{ |
246
|
0
|
|
|
|
|
|
$msg->media_chunk( 1+$msg->media_chunk ); |
247
|
0
|
0
|
|
|
|
|
$msg->media_id(defined $msg->media_code?$json->{MediaId} . ":" . $msg->media_code : $json->{MediaId}) if $json->{MediaId}; |
|
|
0
|
|
|
|
|
|
248
|
0
|
|
|
|
|
|
$callback->($msg); |
249
|
0
|
|
|
|
|
|
return; |
250
|
|
|
|
|
|
|
} |
251
|
|
|
|
|
|
|
} |
252
|
0
|
0
|
0
|
|
|
|
); |
|
|
0
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
1; |