├── .travis.yml ├── API.md ├── Changes ├── Collection.md ├── Controller-API.md ├── Docker.md ├── FAQ.md ├── IRC.md ├── LICENSE ├── Makefile.PL ├── NOTICE ├── Plugin.md ├── README.md ├── cpanfile ├── demo ├── echo-reply.pl ├── load-plugin.pl ├── openqq-client.pl └── openqq-client.sh ├── doc └── Webqq.pod ├── docker-image ├── Dockerfile └── Dockerfile-ubuntu ├── lib └── Mojo │ ├── Webqq.pm │ ├── Webqq.pod │ └── Webqq │ ├── Base.pm │ ├── Cache.pm │ ├── Client.pm │ ├── Client │ ├── Cron.pm │ └── Remote │ │ ├── _check_login.pm │ │ ├── _check_sig.pm │ │ ├── _check_verify_code.pm │ │ ├── _cookie_proxy.pm │ │ ├── _get_group_pic.pm │ │ ├── _get_img_verify_code.pm │ │ ├── _get_offpic.pm │ │ ├── _get_qrlogin_pic.pm │ │ ├── _get_vfwebqq.pm │ │ ├── _login1.pm │ │ ├── _login2.pm │ │ ├── _prepare_for_login.pm │ │ ├── _recv_message.pm │ │ ├── _relink.pm │ │ ├── change_state.pm │ │ └── logout.pm │ ├── Controller.pm │ ├── Counter.pm │ ├── Discuss.pm │ ├── Discuss │ └── Member.pm │ ├── Friend.pm │ ├── Group.pm │ ├── Group │ └── Member.pm │ ├── List.pm │ ├── Log.pm │ ├── Message.pm │ ├── Message │ ├── Base.pm │ ├── Emoji.pm │ ├── Face.pm │ ├── Handle.pm │ ├── Queue.pm │ ├── Remote │ │ ├── _get_sess_sig.pm │ │ ├── _send_discuss_message.pm │ │ ├── _send_friend_message.pm │ │ ├── _send_group_message.pm │ │ └── _send_sess_message.pm │ └── XMLescape.pm │ ├── Model.pm │ ├── Model │ ├── Base.pm │ ├── Ext.pm │ └── Remote │ │ ├── _get_discuss_info.pm │ │ ├── _get_discuss_list_info.pm │ │ ├── _get_friend_info.pm │ │ ├── _get_friends_state.pm │ │ ├── _get_group_info.pm │ │ ├── _get_group_info_ext.pm │ │ ├── _get_group_info_ext2.pm │ │ ├── _get_group_list_info.pm │ │ ├── _get_group_list_info_ext.pm │ │ ├── _get_recent_info.pm │ │ ├── _get_user_friends.pm │ │ ├── _get_user_friends_ext.pm │ │ ├── _get_user_info.pm │ │ ├── _invite_friend.pm │ │ ├── _kick_group_member.pm │ │ ├── _qiandao.pm │ │ ├── _remove_group_admin.pm │ │ ├── _set_group_admin.pm │ │ ├── _set_group_member_card.pm │ │ ├── _shutup_group_member.pm │ │ ├── get_qq_from_id.pm │ │ └── get_single_long_nick.pm │ ├── Plugin.pm │ ├── Plugin │ ├── FmPush.pm │ ├── FuckAndroid.pm │ ├── FuckDaShen.pm │ ├── GCM.pm │ ├── GasPrice.pm │ ├── GroupManage.pm │ ├── HwPush.pm │ ├── IPwhere.pm │ ├── IRCShell.pm │ ├── KnowledgeBase.pm │ ├── LCMD.pm │ ├── MiPush.pm │ ├── MobileInfo.pm │ ├── Openqq.pm │ ├── Perlcode.pm │ ├── Perldoc.pm │ ├── PostImgVerifycode.pm │ ├── PostQRcode.pm │ ├── PostQRcodeToTelegram.pm │ ├── ProgramCode.pm │ ├── Pu.pm │ ├── Qiandao.pm │ ├── Riddle.pm │ ├── RikkaGCM.pm │ ├── ShowMsg.pm │ ├── ShowQRcode.pm │ ├── SmartReply.pm │ ├── StockInfo.pm │ ├── Translation.pm │ ├── UploadQRcode.pm │ ├── UploadQRcode2.pm │ └── ZiYue.pm │ ├── Recent │ ├── Discuss.pm │ ├── Friend.pm │ └── Group.pm │ ├── Request.pm │ ├── Run.pm │ ├── Server.pm │ ├── User.pm │ └── Util.pm ├── screenshot ├── How_to_chat_like_a_hacker.jpg ├── IRCShell.png └── donate.jpg ├── script └── check_dependencies.pl └── t ├── https.t └── load_module.t /.travis.yml: -------------------------------------------------------------------------------- 1 | language: perl 2 | perl: 3 | - "5.10" 4 | - "5.14" 5 | - "5.20" 6 | -------------------------------------------------------------------------------- /Collection.md: -------------------------------------------------------------------------------- 1 | ### Mojo-Webqq 作品展 2 | 3 | 如下展示了一些基于Mojo-Webqq项目衍生出来的作品，各种创意应用，乐在其中 4 | 5 | * **在VIM中聊QQ** 6 | 7 | 作者：[wsdjeg](https://github.com/wsdjeg) 8 | 9 | 项目地址：https://github.com/vim-chat/vim-chat 10 | 11 | ![作品预览](https://github.com/wsdjeg/DotFiles/raw/master/pic/Vim-QQ.png) 12 | 13 | * **通过GCM将消息推送到Android手机** 14 | 15 | 作者：jklmn 16 | 17 | 项目地址：http://www.coolapk.com/apk/com.swjtu.gcmformojo 18 | 19 | ![作品预览](http://image.coolapk.com/apk_image/2017/0115/236430504552438545-for-127809-o_1b6gbjn15ou772c10ng1vpp5kqr-uid-399128.png.t.jpg) 20 | 21 | * **NPC-使用 docker 快速部署 Mojo-Webqq 并实现相关扩展功能** 22 | 23 | 作者：[huangzhongzhang](https://huangzz.xyz) 24 | 25 | 项目地址：https://github.com/huangzhongzhang/NPC 26 | 27 | ![作品预览](https://github.com/huangzhongzhang/NPC/raw/master/NPC.png) 28 | 29 | -------------------------------------------------------------------------------- /Docker.md: -------------------------------------------------------------------------------- 1 | ### Docker镜像安装及使用方法 2 | 3 | 1. ***安装镜像*** 4 | 5 | 从官方仓库直接拉取 6 | 7 | docker pull sjdy521/mojo-webqq 8 | 9 | 或者使用Dockerfile自己build 10 | 11 | docker build -t mojo-webqq . 12 | 13 | 2. ***运行镜像*** 14 | 15 | 二维码登录方式（默认） 16 | 17 | docker run -it -p 5000:5000 -v /tmp:/tmp sjdy521/mojo-webqq 18 | 19 | 账号密码登录方式 20 | 21 | docker run -it --env MOJO_WEBQQ_ACCOUNT=123456 --env MOJO_WEBQQ_PWD=xxxx --env MOJO_WEBQQ_LOGIN_TYPE=login -p 5000:5000 -v /tmp:/tmp sjdy521/mojo-webqq 22 | 23 | 为了能够方便查看日志，获取容器中下载的二维码文件等，建议把宿主的/tmp目录挂载到docker的/tmp上，同时设置容器的端口映射 24 | 25 | 支持通过环境变量的方式传递参数，常用的环境变量参数： 26 | 27 | | 环境变量 | 作用 | 默认值 | 28 | | ---------------------------------|:------------------| :---------------------------------| 29 | | MOJO_WEBQQ_ACCOUNT | QQ账号 | 无 | 30 | | MOJO_WEBQQ_PWD | QQ账号密码的MD5 | 无 | 31 | | MOJO_WEBQQ_LOGIN_TYPE | 登录方式 | qrlogin（login表示密码登录） | 32 | | MOJO_WEBQQ_LOG_LEVEL | 日志级别 | info | 33 | | MOJO_WEBQQ_LOG_PATH | 日志保存路径 | STDERR | 34 | | MOJO_WEBQQ_LOG_ENCODING | 日志编码 | utf8 | 35 | | MOJO_WEBQQ_QRCODE_PATH | 二维码保存路径 | /tmp/mojo_webqq_qrcode_default.png| 36 | | MOJO_WEBQQ_PLUGIN_OPENQQ_PORT | Openqq插件监听端口| 5000 | 37 | | MOJO_WEBQQ_PLUGIN_OPENQQ_POST_API| Openqq插件上报地址| 无 | 38 | 39 | 更多环境变量自定义参数参见[开发文档](https://metacpan.org/pod/distribution/Mojo-Webqq/lib/Mojo/Webqq.pm#new) 40 | -------------------------------------------------------------------------------- /FAQ.md: -------------------------------------------------------------------------------- 1 | #### 1. *打印到终端的日志乱码* 2 | 3 | 程序默认会自动检测终端的编码，如果你发现乱码，可能是自动检测失败，这种情况下你可以尝试手动设置下输出编码 4 | 5 | $client = Mojo::Webqq->new(log_encoding=>"utf8"); 6 | 7 | #### 2. *如何运行多个QQ账号* 8 | 9 | 使用[Controller-API](Controller-API.md)轻松实现多账号管理 10 | 11 | 如果你只是希望简单的跑起来一两个帐号，并不想或者不会使用API，可以参考如下方法： 12 | 13 | 多账号登录主要的问题是需要把每个账号的cookie等数据保存到单独的路径，避免互相影响 14 | 15 | 在客户端初始化时提供了一个account的参数用于为每个登陆的客户端设置单独的标识，这个参数并不是真正的QQ账号，可以自由定义 16 | 17 | 每个账号的代码保存到不同的pl文件中,并设置好account参数 18 | 19 | ##### abc.pl文件 20 | 21 | use Mojo::Webqq; 22 | my $client = Mojo::Webqq->new(account=>"abc"); 23 | $client->load("ShowMsg"); 24 | $client->run(); 25 | 26 | ##### def.pl文件 27 | 28 | use Mojo::Webqq; 29 | my $client = Mojo::Webqq->new(account=>"def"); 30 | $client->load("ShowMsg"); 31 | $client->run(); 32 | 33 | 单独运行abc.pl和def.pl即可 34 | 35 | 或者不想搞很多个pl文件，可以只使用一份代码，然后运行时通过环境变量`MOJO_WEBQQ_ACCOUNT`来传递account 36 | 37 | use Mojo::Webqq; 38 | my $client = Mojo::Webqq->new(); #这里不设置account参数，而是从环境变量获取 39 | $client->load("ShowMsg"); 40 | $client->run(); 41 | 42 | #### 3. *如何使用github上最新的代码进行测试* 43 | 44 | github上的代码迭代比较频繁，定期打包发布一个稳定版本上传到cpan(Perl官方库) 45 | 46 | 通过`cpanm Mojo::Webqq`在线下载或更新的都是来自cpan的稳定版本，如果你迫不及待的想要尝试github上的最新代码， 47 | 48 | 可以手动从github下载最新源码，然后在你的 `xxxx.pl` 文件的开头 49 | 50 | 通过 `use lib 'github源码解压路径/lib/'` 来指定你要使用该路径下的`Mojo::Webqq`模块 51 | 52 | 而不是之前通过cpanm安装到系统其他路径上的`Mojo::Webqq`模块，操作步骤演示： 53 | 54 | a. 下载最新源码的zip文件 https://github.com/sjdy521/Mojo-Webqq/archive/master.zip 55 | 56 | b. 解压master.zip到指定路径，比如Windows C盘根目录 c:/ 57 | 58 | c. 在你的perl程序开头加上 `use lib 'c:/Mojo-Webqq-master/lib';` 59 | 60 | d. 正常执行你的程序即可 61 | 62 | ``` 63 | #!/usr/bin/env perl 64 | use lib 'c:/Mojo-Webqq-master/lib'; #指定加载模块时优先加载的路径 65 | use Mojo::Webqq; 66 | my ($host,$port,$post_api); 67 | 68 | $host = "0.0.0.0"; #发送消息接口监听地址，没有特殊需要请不要修改 69 | $port = 5000; #发送消息接口监听端口，修改为自己希望监听的端口 70 | #$post_api = 'http://xxxx'; #接收到的消息上报接口，如果不需要接收消息上报，可以删除或注释此行 71 | 72 | my $client = Mojo::Webqq->new(log_level=>"info",http_debug=>0); 73 | $client->load("ShowMsg"); 74 | $client->load("Openqq",data=>{listen=>[{host=>$host,port=>$port}], post_api=>$post_api}); 75 | $client->run(); 76 | ``` 77 | #### 4. 日志中为什么会打印很多 “504 Gateway Time-out” 78 | 79 | 你可能会在日志中看到很多类似如下的日志 80 | 81 | `[17/01/09 16:55:45] [warn] http://d1.web2.qq.com/channel/poll2 请求失败: 504 Gateway Time-out` 82 | 83 | 这个主要是腾讯官方接口本身的问题，即便使用网页浏览器访问w.qq.com，也会碰到这种情况 84 | 85 | 好在目前看这种错误并不会影响到消息接收，可以无视 86 | 87 | #### 5. 扫码后可以保持多长时间在线 88 | 89 | 受限于腾讯官方服务端的限制，目前扫码成功登陆后只能保持1~2天在线，登录状态失效后会强制重新扫码登录 90 | 91 | `Openqq`插件会上报`input_qrcode`事件 92 | 93 | 也可以通过`PostQRcode`插件把登录二维码发送到指定邮箱实现手机随时随地扫码，除此之外，也没有更好的办法避免掉线 94 | 95 | #### 6. PHP如何获取达到Openqq插件上报的json数据 96 | 97 | 由于上报的json数据属于 application/json类型，而非application/x-www-form-urlencoded类型 98 | 99 | 因此使用常规的`$_POST`的方式是行不通的（`$_POST` 只适合获取形式为 a=1&b=2&c=3 的数据形式） 100 | 101 | 需要使用`$GLOBALS['HTTP_RAW_POST_DATA']`来直接获取http请求body中携带的原始json数据 102 | 103 | 或者使用 `$http_request_body = file_get_contents('php://input');` 104 | 105 | 再通过 php提供的`json_decode` 函数将原始json字符串转换为php对应的数据结构 106 | 107 | php相关文档说明： 108 | 109 | http://us3.php.net/manual/en/function.json-decode.php 110 | 111 | http://us3.php.net/manual/en/reserved.variables.httprawpostdata.php 112 | 113 | #### 7. screen乱码的问题 114 | 115 | 解决办法：强制UTF-8模式开启,在其他命令前加上-U 即可,如 116 | 117 | ``` 118 | screen -U -S test 119 | screen -U -r xxx 120 | 121 | ``` 122 | 123 | #### 8. 修改用户cookie目录和记录消息目录 124 | 125 | `Mojo::Webqq` 在类构造方法new函数中提供相关配置项,详见(https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#new) 126 | 默认是用户cookie是保存在/tmp目录下，如果出现登陆问题时候需要手动删除/tmp 127 | 下的相关文件，可以在启动脚本中增加参数，例子： 128 | 129 | 现在启动脚本中创建两个个目录msg 和 cookie 130 | 131 | 修改启动脚本： 132 | 133 | use POSIX; 134 | my $date=strftime("%Y%m%d",localtime()); 135 | 136 | my $client=Mojo::Webqq->new( 137 | ua_debug => 0, #是否打印详细的debug信息 138 | log_level => "info", #日志打印级别 139 | is_update_group => 0, 140 | is_update_discuss => 0, 141 | log_path=>"msg/qqmsg-$date", 142 | tmpdir=>"cookie", 143 | login_type => "qrlogin", #"qrlogin"表示二维码登录 144 | ); 145 | 146 | 这样消息就会保存在目录msg,session文件，二维码文件就保存在cookie目录下， 147 | 以qqmsg-20171204等保存文件中tail -f qqmsg-20171204就可以实时查看消息了。 148 | 149 | #### 9. 发送二维码到邮箱 150 | 151 | 首先通过PostQRcode模块，如果涉及其他模块也安装下`cpanm Mojo::SMTP::Client` 152 | 153 | 修改启动脚本，在插件部分，增加如下脚本： 154 | 155 | $client->load("PostQRcode",data=>{ 156 | smtp => 'smtp.ijz.me', #邮箱的smtp地址 157 | port => '25', #smtp服务器端口，默认25 158 | from => 'mojoqq@ijz.me', #发件人 159 | to => '10010@qq.com', #收件人 160 | user => 'mojoqq@ijz.me', #smtp登录帐号 161 | pass => 'Mojo-Webqq123', 162 | tls => 0, #可选，是否使用SMTPS协议，默认为0 163 | }); 164 | 165 | 收件人和发件人按照你实际信息填写。 166 | 167 | #### 10. 碰到 Can't locate Mojo/Webqq.pm in @INC 168 | 169 | 说明Mojo::Webqq模块没有安装成功，通常是在执行`cpanm Mojo::Webqq`安装的过程中，由于其他依赖模块安装失败导致最终`Mojo::Webqq`没有安装成功 170 | 171 | 需要逐个检查缺少哪些模块，Linux下你可以直接执行如下命令来检查模块的安装情况,并根据提示进行操作 172 | 173 | `curl -ks "https://raw.githubusercontent.com/sjdy521/Mojo-Webqq/master/script/check_dependencies.pl" |perl -` 174 | 175 | #### 11. 非root账号安装后无法使用问题 176 | 177 | 解决方法： 178 | 179 | 方法1、切换到root账号下重新安装使用 180 | 181 | 方法2、在非root账号下依次执行如下操作（**不要在任何命令前面加sudo**） 182 | 183 | 1）安装local::lib模块，执行命令如下： 184 | 185 | cpanm --local-lib=~/perl5 local::lib && eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib) 186 | 187 | 2）把相关环境变量写入启动文件中，执行命令如下： 188 | 189 | echo 'eval "$(perl -I $HOME/perl5/lib/perl5 -Mlocal::lib)"' >>~/.bashrc 190 | 191 | #### 12. 使用账号密码的方法无法成功登录 192 | 193 | 可能的原因是，基于账号密码的登录方式，一旦登录所在地发生较大变化，则腾讯服务器可能需要你输入图片验证码，这样就很难实现自动化操作 194 | 195 | 为了避免这种情况，你需要尽量在pl脚本所在的网络中用浏览器多登录一下 http://qun.qq.com 让腾讯服务器消除登录异常的判断 196 | 197 | 你可以在服务端搭建ssh隧道，socks5代理，支持SSL转发（CONNECT方法）的http代理等方式，然后浏览器通过服务端代理访问 198 | 199 | 参考issue： https://github.com/sjdy521/Mojo-Webqq/issues/183 200 | -------------------------------------------------------------------------------- /IRC.md: -------------------------------------------------------------------------------- 1 | ###如何在终端上使用IRC玩转QQ 2 | 3 | 项目自带一个`IRCShell的插件`，只需要在代码中加载该插件就能够轻松的实现在终端上利用IRC来聊QQ 4 | 5 | 实现原理： 6 | 7 | ``` 8 | +-------------------+ +----------------+ 9 | | Tencent | | Any IRC Client | 10 | | SmartQQ Server | | wechat、irssi | 11 | +---v-------------^-+ +-v------------^-+ 12 | | | | | 13 | | QQ协议交互 | |IRC协议交互 | 14 | +-- --- |-- - - -- | - - - -- - - --- | --- ----- | --+ 15 | | +---v-------------^--+ +----v------------^-+ | 16 | | | <——————————————————< | | 17 | | | SmartQQ Client | QQ - IRC | IRC Server | | 18 | | | | 协议转换 | 监听本机6667端口 | | 19 | | | >——————————————————> | | 20 | | +--------------------+ +-------------------+ | 21 | | | 22 | | 我们程序实现的部分 | 23 | +--- - - - - -- - -- ---- ------ ------- ------ --- ----+ 24 | 25 | ``` 26 | 27 | ###操作步骤 28 | 29 | 1.先安装 IRC 依赖模块 30 | 31 | ```$ cpanm -v Mojo::IRC::Server::Chinese``` 32 | 33 | 2.代码中指定加载IRCShell插件，代码如下： 34 | 35 | ``` 36 | #!/usr/bin/env perl 37 | use Mojo::Webqq; 38 | my $client = Mojo::Webqq->new(); 39 | $client->load("ShowMsg"); 40 | $client->load("IRCShell"); #加载IRCShell插件 41 | $client->run(); 42 | ``` 43 | 3.将上述代码保存成 `xxxx.pl` 文件（必须UTF8编码），使用perl解释器运行 44 | 45 | ```perl xxxx.pl``` #执行的结果是完成QQ的登录、同时本机启动一个监听6667端口的IRC Server 46 | 47 | 4.使用任意支持IRC协议的客户端连接127.0.0.1:6667的IRC Server即可开始聊天 48 | 49 | 常见的irc客户端有weechat、irssi等，这里以irssi为例 50 | 51 | ``` 52 | #建立服务端 53 | irssi -c 127.0.0.1 -p 6667 54 | 55 | IRC客户端常用操作命令 56 | 57 | /nick 你的QQ昵称 #设置irc的昵称，建议和自己的QQ昵称相同 58 | /user 123456(你的QQ号码) #/user指令不是必须的，设置user为自己的QQ号是为了方便irc server区分主人 59 | /list #列出自己加入的QQ群 60 | /join #我的QQ群名称 #加入指定的某个QQ群 61 | /part #退出该QQ群 62 | ``` 63 | 更多irc的使用方就不一一列举了，自行百度即可 64 | 65 | 5.更多插件自定义参数，参见[IRCShell插件文档](https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::IRCShell) 66 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 2-Clause License 2 | 3 | Copyright (c) 2014, sjdy521 4 | All rights reserved. 5 | 6 | Redistribution and use in source and binary forms, with or without 7 | modification, are permitted provided that the following conditions are met: 8 | 9 | * Redistributions of source code must retain the above copyright notice, this 10 | list of conditions and the following disclaimer. 11 | 12 | * Redistributions in binary form must reproduce the above copyright notice, 13 | this list of conditions and the following disclaimer in the documentation 14 | and/or other materials provided with the distribution. 15 | 16 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 17 | AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 18 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 19 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE 20 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 21 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR 22 | SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 23 | CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, 24 | OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 25 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 26 | -------------------------------------------------------------------------------- /Makefile.PL: -------------------------------------------------------------------------------- 1 | use 5.010001; 2 | use ExtUtils::MakeMaker "6.46"; 3 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence 4 | # the contents of the Makefile that is written. 5 | WriteMakefile( 6 | NAME => 'Mojo::Webqq', 7 | VERSION_FROM => 'lib/Mojo/Webqq.pm', # finds $VERSION 8 | DISTNAME => 'Mojo-Webqq', 9 | LICENSE => "perl", 10 | PREREQ_PM => { 11 | "Compress::Raw::Zlib" => 0, 12 | "IO::Compress::Gzip" => 0, 13 | "Time::HiRes" => 0, 14 | "Time::Piece" => 0, 15 | "Time::Seconds" => 0, 16 | "Digest::SHA" => 0, 17 | "Digest::MD5" => 0, 18 | #"Term::ANSIColor" => 0, 19 | "Encode::Locale" => 0, 20 | "IO::Socket::SSL" => '2.009', 21 | "Mojolicious" => '8.02', 22 | #"Webqq::Encryption" => '1.5', 23 | }, # e.g., Module::Name => 1.1 24 | dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', }, 25 | clean => { FILES => 'Mojo-Webqq-* MANIFEST' }, 26 | META_MERGE => { 27 | 'meta-spec' => { version => 2 }, 28 | resources => { 29 | repository=>{ 30 | type => 'git', 31 | url => 'git://github.com/sjdy521/Mojo-Webqq.git', 32 | web => 'https://github.com/sjdy521/Mojo-Webqq', 33 | }, 34 | }, 35 | }, 36 | ($] >= 5.005 ? ## Add these new keywords supported since 5.005 37 | ( 38 | #ABSTRACT_FROM => 'lib/Webqq/Client.pm', # retrieve abstract from module 39 | ABSTRACT => 'A Smartqq Client Framework base on Mojolicious', 40 | AUTHOR => 'sjdy521 ') : ()), 41 | ); 42 | -------------------------------------------------------------------------------- /NOTICE: -------------------------------------------------------------------------------- 1 | 以下是最新公告： 2 | !!! 重要通知：webQQ即将在2019年1月1日停止服务，此项目目前已决定停止维护，感谢大家四年来的一路陪伴支持 3 | -------------------------------------------------------------------------------- /Plugin.md: -------------------------------------------------------------------------------- 1 | ### 插件列表 2 | 3 | |名称 | 优先级 |当前状态 |github作者 | 功能说明 4 | |:-------------------|:--------|:-----------|:-------------|:---------------------------- 5 | |[ShowMsg] |100 |已发布 |sjdy521 |打印客户端接收和发送的消息 6 | |[GroupManage] |100 |已发布 |sjdy521 |群管理，入群欢迎、限制发图频率等 7 | |[IRCShell] |99 |已发布 |sjdy521 |Linux环境下通过irc客户端使用qq 8 | |[Openqq] |98 |已发布 |sjdy521 |提供qq发送消息api接口 9 | |[GCM] |97 |已发布 |sjdy521 |接收消息通过GCM推送到android手机 10 | |[Perlcode] |97 |已发布 |sjdy521 |通过qq消息执行perl代码 11 | |[Perldoc] |96 |已发布 |sjdy521 |通过qq消息查询perl文档 12 | |[StockInfo] |95 |已发布 |shalk |查询股票信息 13 | |[ProgramCode] |94 |已发布 |limengyu1990 |通过qq消息执行代码，支持26种语言 14 | |[Translation] |93 |已发布 |sjdy521 |多国语言翻译功能 15 | |[MobileInfo] |93 |已发布 |limengyu1990 |手机号码归属地查询 16 | |[Riddle] |92 |已发布 |limengyu1990 |输入"猜谜"关键字进行猜谜游戏 17 | |[GasPrice] |91 |已发布 |hyvinlam |输入"油价"关键字查询油价 18 | |[KnowledgeBase] |3 |已发布 |sjdy521 |自定义可编辑问答知识库 19 | |[FuckDaShen] |1 |已发布 |sjdy521 |对消息中的"大神"关键词进行鄙视 20 | |[Qiandao] |1 |已发布 |sjdy521 |QQ群每日签到 21 | |[Pu] |1 |已发布 |bollwarm |周易、占卜、算命、八卦等关键字触发占卜 22 | |[ZiYue] |1 |已发布 |bollwarm |子曰、论语、之乎者也等关键字触发论语语句 23 | |[PostImgVerifycode] |0 |已发布 |sjdy521 |登录验证码发送到邮箱实现远程登录 24 | |[PostQRcode] |0 |已发布 |sjdy521 |登录二维码发送到邮箱实现远程扫码 25 | |[UploadQRcode] |0 |已发布 |sjdy521 |二维码上传图床获得公网访问url 26 | |[ShowQRcode] |0 |已发布 |autodataming |调用系统图片查看程序来示二维码（目前仅支持win） 27 | |[SmartReply] |0 |已发布 |sjdy521 |智能聊天回复 28 | |[IPWhere]           |1 |已发布 |bollwarm |IP库查询 29 | |[LCMD]             |1       |已发布 |bollwarm     |linux命令使用方法查询 30 | |[SCH]             |1       |已发布 |bollwarm     |查询高校录取分数线 31 | |[PW]          |1       |已发布 |bollwarm     |在线分词pullword插件,pullword,分词 关键词触发 32 | |[PostQRcodeToTelegram]|0     |已发布 |HubertZhang |二维码通过Telegram Bot发至指定账户或频道或群组 33 | 34 | [ShowMsg]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::ShowMsg 35 | [GroupManage]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::GroupManage 36 | [IRCShell]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::IRCShell 37 | [Openqq]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Openqq 38 | [Perlcode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Perlcode 39 | [Perldoc]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Perldoc 40 | [StockInfo]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::StockInfo 41 | [ProgramCode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::ProgramCode 42 | [Translation]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Translation 43 | [MobileInfo]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::MobileInfo 44 | [Riddle]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Riddle 45 | [GasPrice]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::GasPrice 46 | [KnowledgeBase]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::KnowledgeBase 47 | [FuckDaShen]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::FuckDaShen 48 | [Qiandao]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Qiandao 49 | [Pu]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::Pu 50 | [ZiYue]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::ZiYue 51 | [PostImgVerifycode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::PostImgVerifycode 52 | [PostQRcode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::PostQRcode 53 | [UploadQRcode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::UploadQRcode 54 | [ShowQRcode]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::ShowQRcode 55 | [SmartReply]: https://metacpan.org/pod/distribution/Mojo-Webqq/doc/Webqq.pod#Mojo::Webqq::Plugin::SmartReply 56 | [IPWhere]: https://git.oschina.net/ijz/Mojo-Webqq-IPwhere 57 | [LCMD]: https://gitee.com/ijz/Mojo-Webqq-LCMD 58 | [SCH]: https://gitee.com/ijz/Mojo-Webqq-CollegePoint 59 | [PW]: http://gitee.com/ijz/pullword/blob/master/example/PW.pm 60 | [PostQRcodeToTelegram]: https://github.com/sjdy521/Mojo-Webqq/blob/master/lib/Mojo/Webqq.pod#Mojo::Webqq::Plugin::PostQRcodeToTelegram 61 | [GCM]: http://www.coolapk.com/apk/com.swjtu.gcmformojo 62 | -------------------------------------------------------------------------------- /cpanfile: -------------------------------------------------------------------------------- 1 | requires 'Compress::Raw::Zlib'; 2 | requires 'IO::Compress::Gzip'; 3 | requires 'Time::HiRes'; 4 | requires 'Time::Piece'; 5 | requires 'Time::Seconds'; 6 | requires 'Digest::SHA'; 7 | requires 'Digest::MD5'; 8 | requires 'Encode::Locale'; 9 | requires 'IO::Socket::SSL', '>= 2.009'; 10 | requires 'Mojolicious','>= 8.02'; 11 | recommends 'Term::ANSIColor'; 12 | conflicts 'Mojolicious','< 8.02'; 13 | -------------------------------------------------------------------------------- /demo/echo-reply.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use lib "../lib/"; 3 | use Mojo::Webqq; 4 | 5 | #注意: 6 | #程序内部数据全部使用UTF8编码，因此二次开发源代码也请尽量使用UTF8编码进行编写，否则需要自己做编码处理 7 | #在终端上执行程序，会自动检查终端的编码进行转换，以防止乱码 8 | #如果在某些IDE的控制台中查看执行结果，程序无法自动检测输出编码，可能会出现乱码，可以手动设置输出编码 9 | #手动设置输出编码参考文档中关于 log_encoding 的说明 10 | 11 | #帐号可能进入保护模式的原因: 12 | #多次发言中包含网址 13 | #短时间内多次发言中包含敏感词汇 14 | #短时间多次发送相同内容 15 | #频繁异地登陆 16 | 17 | #推荐手机安装[QQ安全中心]APP，方便随时掌握自己帐号的情况 18 | 19 | #初始化一个客户端对象，设置登录的qq号 20 | my $client=Mojo::Webqq->new( 21 | http_debug => 0, #是否打印详细的debug信息 22 | log_level => "info", #日志打印级别 23 | ); 24 | #注意: 腾讯可能已经关闭了帐号密码的登录方式，这种情况下只能使用二维码扫描登录 25 | 26 | #客户端加载ShowMsg插件，用于打印发送和接收的消息到终端 27 | $client->load("ShowMsg"); 28 | 29 | #设置接收消息事件的回调函数，在回调函数中对消息以相同内容进行回复 30 | $client->on(receive_message=>sub{ 31 | my ($client,$msg)=@_; 32 | #已以相同内容回复接收到的消息 33 | $msg->reply($msg->content); 34 | #你也可以使用$msg->dump() 来打印消息结构 35 | }); 36 | 37 | #客户端开始运行 38 | $client->run(); 39 | -------------------------------------------------------------------------------- /demo/load-plugin.pl: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env perl 2 | use lib "../lib/"; 3 | use Mojo::Webqq; 4 | 5 | #注意: 6 | #程序内部数据全部使用UTF8编码，因此二次开发源代码也请尽量使用UTF8编码进行编写，否则需要自己做编码处理 7 | #在终端上执行程序，会自动检查终端的编码进行转换，以防止乱码 8 | #如果在某些IDE的控制台中查看执行结果，程序无法自动检测输出编码，可能会出现乱码，可以手动设置输出编码 9 | #手动设置输出编码参考文档中关于 log_encoding 的说明 10 | 11 | #帐号可能进入保护模式的原因: 12 | #多次发言中包含网址 13 | #短时间内多次发言中包含敏感词汇 14 | #短时间多次发送相同内容 15 | #频繁异地登陆 16 | 17 | #推荐手机安装[QQ安全中心]APP，方便随时掌握自己帐号的情况 18 | 19 | #初始化一个客户端对象，设置登录的qq号 20 | 21 | my $client=Mojo::Webqq->new( 22 | http_debug => 0, #是否打印详细的debug信息 23 | log_level => "info", #日志打印级别 24 | ); 25 | 26 | #注意: 腾讯可能已经关闭了帐号密码的登录方式，这种情况下只能使用二维码扫描登录 27 | 28 | #发送二维码到邮箱 29 | $client->load("PostQRcode",data=>{ 30 | smtp => 'smtp.xxx.com', #邮箱的smtp地址 31 | port => '25', #smtp服务器端口，默认25 32 | from => 'xxx@xxx.com', #发件人 33 | to => 'xxx@xxx.com', #收件人 34 | user => 'xxx@xxx.com', #smtp登录帐号 35 | pass => 'xxxxx', #smtp登录密码 36 | }); 37 | 38 | #客户端加载ShowMsg插件，用于打印发送和接收的消息到终端 39 | $client->load("ShowMsg"); 40 | 41 | #显示perl文档 42 | #$client->load("Perlcode"); 43 | 44 | #执行perl命令，仅支持linux系统加载使用 45 | #$client->load("Perldoc"); 46 | 47 | #智能聊天回复 48 | $client->load("SmartReply"); 49 | #需要私聊或@机器人 50 | 51 | #对大神进行鄙视 52 | $client->load("FuckDaShen"); 53 | 54 | #创建知识库 55 | $client->load("KnowledgeBase"); 56 | #示例：learn 今天天气怎么样 天气很好 57 | # 学习 "你吃了吗" 当然吃了 58 | # learn '哈哈 你真笨' "就你聪明" 59 | # del 今天天气怎么样 60 | # 删除 '哈哈 你真笨' 61 | 62 | #翻译 63 | $client->load("Translation"); 64 | #示例：翻译 hello 65 | 66 | #手机归属地查询 67 | $client->load("MobileInfo"); 68 | #示例：手机 1888888888 69 | 70 | #代码测试 71 | $client->load("ProgramCode"); 72 | #示例：code|c>>> 73 | # #include 74 | # int main() { 75 | # printf("Hello World!\n"); 76 | # return 0; 77 | # } 78 | 79 | #股票查询 80 | $client->load("StockInfo"); 81 | #示例：股票 000001 82 | 83 | #提供HTTP API接口，方便获取客户端帐号、好友、群、讨论组信息 84 | #以及通过接口发送和接收好友消息、群消息、群临时消息和讨论组临时消息 85 | $client->load("Openqq",data=>{ 86 | listen => [ {host=>"0.0.0.0",port=>5000}, ] , #监听的地址和端口，支持多个 87 | #auth => sub {my($param,$controller) = @_}, #可选，认证回调函数，用于进行请求鉴权 88 | #post_api => 'http://xxxx', #可选，设置接收消息的上报接口 89 | }); 90 | 91 | #客户端开始运行 92 | $client->run(); 93 | -------------------------------------------------------------------------------- /demo/openqq-client.pl: -------------------------------------------------------------------------------- 1 | =encoding utf8 2 | =head1 SYNOPSIS 3 | 使用帮助 4 | 5 | -h 打印帮助内容 6 | -id 对象(好友、群成员、讨论组成员)的id 7 | -uid 对象(好友、群成员、讨论组成员)的qq号码 8 | -gid 群的id 9 | -guid 群号码 10 | -did 讨论组的id 11 | 12 | 发送消息示例： 13 | 14 | 好友消息 ./script -id 123456 你好 15 | ./script -uid 123456 你好 16 | 17 | 群消息 ./script -gid 123456 你好 18 | ./script -guid 123456 你好 19 | 20 | 群临时消息 ./script -gid 123456 -id 123456 你好 21 | ./script -guid 123456 -uid 123456 你好 22 | 23 | 讨论组临时消息 ./script -did 123456 -id 123456 你好 24 | =cut 25 | use strict; 26 | use Getopt::Long; 27 | use Mojo::UserAgent; 28 | use Mojo::Util qw(url_escape encode decode); 29 | my %API = ( 30 | send_friend_message => 'http://127.0.0.1:5000/openqq/send_friend_message', 31 | send_group_message => 'http://127.0.0.1:5000/openqq/send_group_message', 32 | send_discuss_message => 'http://127.0.0.1:5000/openqq/send_discuss_message', 33 | send_sess_message => 'http://127.0.0.1:5000/openqq/send_sess_message', 34 | ); 35 | my $ua = Mojo::UserAgent->new; 36 | if($ARGV[0] eq "-l" or $ARGV[0] eq "-list"){ 37 | my $friend = $ua->get("http://127.0.0.1:5000/openqq/get_friend_info")->res->json; 38 | print "好友:\n"; 39 | for(@{$friend}){ 40 | print $_->{id},"\t",encode("utf8",$_->{name}),"\n"; 41 | } 42 | print "群组:\n"; 43 | my $group = $ua->get("http://127.0.0.1:5000/openqq/get_group_info")->res->json; 44 | for(@{$group}){ 45 | print $_->{id},"\t",encode("utf8",$_->{name}),"\n"; 46 | } 47 | exit; 48 | } 49 | elsif(@ARGV == 0 or $ARGV[0] eq "-h" or $ARGV[0] eq "--help"){ 50 | print < \$gid, 81 | "id=i" => \$id, 82 | "did=i" => \$did, 83 | "uid=i" => \$uid, 84 | "guid=i" => \$guid, 85 | "<>" => sub{push @content ,$_[0]}, 86 | )or die $!; 87 | $content = join " ",@content; 88 | $content=~s/\\n/\n/g; 89 | $content = url_escape( $content); 90 | die "需要输入发送内容\n" unless defined $content; 91 | 92 | my $tx; 93 | if(defined $gid and defined $id){ 94 | $tx = $ua->get($API{"send_sess_message"} . "?group_id=$gid&id=$id&content=$content"); 95 | } 96 | elsif(defined $did and defined $id) { 97 | $tx = $ua->get($API{"send_sess_message"} . "?discuss_id=$did&id=$id&content=$content"); 98 | } 99 | elsif(defined $gid){ 100 | $tx = $ua->get($API{"send_group_message"} . "?id=$gid&content=$content"); 101 | } 102 | elsif(defined $did){ 103 | $tx = $ua->get($API{"send_discuss_message"} . "?id=$did&content=$content"); 104 | } 105 | elsif(defined $id){ 106 | $tx = $ua->get($API{"send_friend_message"} . "?id=$id&content=$content"); 107 | } 108 | elsif(defined $guid and defined $uid){ 109 | $tx = $ua->get($API{"send_sess_message"} . "?group_uid=$guid&uid=$uid&content=$content"); 110 | } 111 | elsif(defined $guid){ 112 | $tx = $ua->get($API{"send_group_message"} . "?uid=$guid&content=$content"); 113 | } 114 | elsif(defined $uid){ 115 | $tx = $ua->get($API{"send_friend_message"} . "?uid=$uid&content=$content"); 116 | } 117 | else{ 118 | die "参数错误\n"; 119 | } 120 | warn $tx->req->to_string; 121 | warn $tx->res->to_string; 122 | -------------------------------------------------------------------------------- /demo/openqq-client.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | #发送的群号 4 | guid=$1 5 | 6 | #Openqq插件中定义的host和port 7 | API_ADDR="127.0.0.1:5000" 8 | 9 | # 处理下编码，用于合并告警内容的标题和内容，即$2和$3 10 | message=`echo -e "$2"|od -t x1 -A n -v -w100000 | tr " " %` 11 | 12 | #组装api调用地址 13 | api_url="http://$API_ADDR/openqq/send_group_message?uid=$guid&content=$message" 14 | 15 | #请求api地址发送群消息 16 | curl -v $api_url 17 | -------------------------------------------------------------------------------- /docker-image/Dockerfile: -------------------------------------------------------------------------------- 1 | FROM centos:7.0.1406 2 | MAINTAINER sjdy521 3 | WORKDIR /root 4 | USER root 5 | ENV TZ=Asia/Shanghai 6 | RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone 7 | RUN yum -y --nogpgcheck install \ 8 | make \ 9 | unzip \ 10 | wget \ 11 | tar \ 12 | perl \ 13 | perl-App-cpanminus \ 14 | perl-Crypt-OpenSSL-Bignum \ 15 | perl-Crypt-OpenSSL-RSA \ 16 | perl-Compress-Raw-Zlib \ 17 | perl-IO-Compress-Gzip \ 18 | perl-Digest-MD5 \ 19 | perl-Digest-SHA \ 20 | perl-Time-Piece \ 21 | perl-Time-Seconds \ 22 | perl-Time-HiRes \ 23 | perl-IO-Socket-SSL \ 24 | perl-Encode-Locale \ 25 | perl-Term-ANSIColor && \ 26 | yum clean all 27 | RUN cpanm -vn Test::More IO::Socket::SSL Webqq::Encryption Mojolicious MIME::Lite Mojo::SMTP::Client Mojo::IRC::Server::Chinese 28 | RUN wget -q https://github.com/sjdy521/Mojo-Webqq/archive/master.zip -OMojo-Webqq.zip \ 29 | && unzip -qo Mojo-Webqq.zip \ 30 | && cd Mojo-Webqq-master \ 31 | && cpanm -v . \ 32 | && cd .. \ 33 | && rm -rf Mojo-Webqq-master Mojo-Webqq.zip 34 | CMD perl -MMojo::Webqq -e 'Mojo::Webqq->new(log_encoding=>"utf8")->load(["ShowMsg","UploadQRcode"])->load("Openqq",data=>{listen=>[{port=>$ENV{MOJO_WEBQQ_PLUGIN_OPENQQ_PORT}//5000}],post_api=>$ENV{MOJO_WEBQQ_PLUGIN_OPENQQ_POST_API}})->run' 35 | -------------------------------------------------------------------------------- /docker-image/Dockerfile-ubuntu: -------------------------------------------------------------------------------- 1 | # version: v2.2.6 2 | FROM ubuntu 3 | MAINTAINER XZ-Dev 4 | WORKDIR /root 5 | USER root 6 | ENV LANG C.UTF-8 7 | ENV TZ=Asia/Shanghai 8 | RUN ln -snf /usr/share/zoneinfo/$TZ /etc/localtime && echo $TZ > /etc/timezone 9 | RUN apt-get update 10 | RUN apt-get dist-upgrade -y 11 | RUN apt-get install \ 12 | make cpanminus \ 13 | libnet-ssleay-perl \ 14 | libcrypt-openssl-bignum-perl \ 15 | libcrypt-openssl-rsa-perl -y 16 | RUN cpanm IO::Socket::SSL 17 | RUN cpanm Mojo::Webqq 18 | RUN cpanm Webqq::Encryption 19 | CMD perl -MMojo::Webqq -e 'Mojo::Webqq->new(log_encoding=>"utf8")->load(["ShowMsg","UploadQRcode"])->load("Openqq",data=>{listen=>[{port=>$ENV{MOJO_WEBQQ_PLUGIN_OPENQQ_PORT}//5000}],post_api=>$ENV{MOJO_WEBQQ_PLUGIN_OPENQQ_POST_API}})->run' 20 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Base.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Base; 2 | use strict; 3 | use warnings; 4 | use feature (); 5 | 6 | # No imports because we get subclassed, a lot! 7 | use Carp (); 8 | 9 | # Only Perl 5.14+ requires it on demand 10 | use IO::Handle (); 11 | 12 | # Supported on Perl 5.22+ 13 | my $NAME 14 | = eval { require Sub::Util; Sub::Util->can('set_subname') } || sub { $_[1] }; 15 | 16 | # Protect subclasses using AUTOLOAD 17 | sub DESTROY { } 18 | 19 | # Declared here to avoid circular require problems in Mojo::Util 20 | sub _monkey_patch { 21 | my ($class, %patch) = @_; 22 | no strict 'refs'; 23 | no warnings 'redefine'; 24 | *{"${class}::$_"} = $NAME->("${class}::$_", $patch{$_}) for keys %patch; 25 | } 26 | 27 | sub attr { 28 | my ($self, $attrs, $value) = @_; 29 | return unless (my $class = ref $self || $self) && $attrs; 30 | 31 | Carp::croak 'Default has to be a code reference or constant value' 32 | if ref $value && ref $value ne 'CODE'; 33 | 34 | for my $attr (@{ref $attrs eq 'ARRAY' ? $attrs : [$attrs]}) { 35 | Carp::croak qq{Attribute "$attr" invalid} unless $attr =~ /^[a-zA-Z_]\w*$/; 36 | 37 | # Very performance sensitive code with lots of micro-optimizations 38 | if (ref $value) { 39 | _monkey_patch $class, $attr, sub { 40 | return 41 | exists $_[0]{$attr} ? $_[0]{$attr} : ($_[0]{$attr} = $value->($_[0])) 42 | if @_ == 1; 43 | $_[0]{$attr} = $_[1]; 44 | $_[0]; 45 | }; 46 | } 47 | elsif (defined $value) { 48 | _monkey_patch $class, $attr, sub { 49 | return exists $_[0]{$attr} ? $_[0]{$attr} : ($_[0]{$attr} = $value) 50 | if @_ == 1; 51 | $_[0]{$attr} = $_[1]; 52 | $_[0]; 53 | }; 54 | } 55 | else { 56 | _monkey_patch $class, $attr, 57 | sub { return $_[0]{$attr} if @_ == 1; $_[0]{$attr} = $_[1]; $_[0] }; 58 | } 59 | } 60 | } 61 | 62 | sub import { 63 | my $class = shift; 64 | return unless my $flag = shift; 65 | 66 | # Base 67 | if ($flag eq '-base') { $flag = $class } 68 | 69 | # Strict 70 | elsif ($flag eq '-strict') { $flag = undef } 71 | 72 | # Module 73 | elsif ((my $file = $flag) && !$flag->can('new')) { 74 | $file =~ s!::|'!/!g; 75 | require "$file.pm"; 76 | } 77 | 78 | # ISA 79 | if ($flag) { 80 | my $caller = caller; 81 | no strict 'refs'; 82 | push @{"${caller}::ISA"}, $flag; 83 | _monkey_patch $caller, 'has', sub { attr($caller, @_) }; 84 | } 85 | 86 | # Mojo modules are strict! 87 | $_->import for qw(strict warnings); 88 | feature->import(':5.10'); 89 | } 90 | 91 | sub new { 92 | my $class = shift; 93 | bless @_ ? @_ > 1 ? {@_} : {%{$_[0]}} : {}, ref $class || $class; 94 | } 95 | 96 | sub tap { 97 | my ($self, $cb) = (shift, shift); 98 | $_->$cb(@_) for $self; 99 | return $self; 100 | } 101 | 102 | 1; 103 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Cache.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Cache; 2 | sub new{ 3 | return bless {} 4 | } 5 | sub store { 6 | my $self= shift; 7 | my ($data_key,$data,$ttl) = @_; 8 | $self->{$data_key}{data} = $data; 9 | $self->{$data_key}{ttl} = $ttl; 10 | $self->{$data_key}{ctime} = time; 11 | 12 | } 13 | sub delete { 14 | my $self= shift; 15 | my $data_key = shift; 16 | delete $self->{$data_key}; 17 | } 18 | sub retrieve{ 19 | my $self = shift; 20 | my $data_key = shift; 21 | if(exists $self->{$data_key} ){ 22 | if(defined $self->{$data_key}{ttl}){ 23 | if($self->{$data_key}{ttl} + $self->{$data_key}{ctime} > time){ 24 | return $self->{$data_key}{data}; 25 | } 26 | else{delete $self->{$data_key};return undef} 27 | } 28 | else{ 29 | return $self->{$data_key}{data}; 30 | } 31 | } 32 | else{return undef} 33 | } 34 | 1; 35 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Cron.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Client::Cron; 2 | use POSIX qw(mktime); 3 | BEGIN{ 4 | our $is_module_ok = 0; 5 | eval{ 6 | require Time::Piece; 7 | require Time::Seconds; 8 | Time::Piece->import; 9 | Time::Seconds->import; 10 | }; 11 | $is_module_ok = 1 if not $@; 12 | } 13 | sub add_job{ 14 | my $self = shift; 15 | if(not $is_module_ok){ 16 | $self->error("调用add_job方法请先确保安装模块 Time::Piece 和 Time::Seconds"); 17 | return; 18 | } 19 | my($type,$nt,$callback) = @_; 20 | my $t = $nt; 21 | if(ref $callback ne 'CODE'){ 22 | $self->die("设置的callback无效\n"); 23 | } 24 | if(ref $nt eq "CODE"){ 25 | $t = $nt->(); 26 | } 27 | my $time = {}; 28 | if(ref $t eq "HASH"){ 29 | $time = $t; 30 | } 31 | else{ 32 | my($hour,$minute,$second) = split /:/,$t; 33 | $second = 0 if not defined $second ; 34 | $time = {hour => $hour,minute => $minute,second=> $second}; 35 | } 36 | $self->debug("计划任务[$type]添加成功，时间设定: " . join(":",map {$_!=0?$_:"00"} ($time->{hour},$time->{minute},$time->{second})) ); 37 | my $delay; 38 | #my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime; 39 | my @now = localtime; 40 | my $now = mktime(@now); 41 | my @next = @{[@now]}; 42 | for my $k (keys %$time){ 43 | $k eq 'year' ? ($next[5]=$time->{$k}-1900) 44 | : $k eq 'month' ? ($next[4]=$time->{$k}-1) 45 | : $k eq 'day' ? ($next[3]=$time->{$k}) 46 | : $k eq 'hour' ? ($next[2]=$time->{$k}) 47 | : $k eq 'minute' ? ($next[1]=$time->{$k}) 48 | : $k eq 'second' ? ($next[0]=$time->{$k}) 49 | : next; 50 | } 51 | 52 | my $next = mktime(@next); 53 | $now = localtime($now); 54 | $next = localtime($next); 55 | 56 | if($now >= $next){ 57 | if( $time->{month} ) { 58 | $next->add_years(1); 59 | } 60 | elsif( $time->{day} ) { 61 | $next->add_months(1); 62 | } 63 | elsif( $time->{hour} ) { 64 | $next += ONE_DAY; 65 | } 66 | elsif( $time->{minute} ) { 67 | $next += ONE_HOUR; 68 | } 69 | elsif( $time->{second} ) { 70 | $next += ONE_MINUTE; 71 | } 72 | } 73 | 74 | $self->debug("计划任务[$type]下一次触发时间为：" . $next->strftime("%Y/%m/%d %H:%M:%S")); 75 | $delay = $next - $now; 76 | $self->timer($delay,sub{ 77 | eval{ 78 | $callback->(); 79 | }; 80 | $self->error($@) if $@; 81 | $self->add_job($type,$nt,$callback); 82 | }); 83 | } 84 | 1; 85 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_check_login.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_check_login { 2 | my $self = shift; 3 | $self->info("正在检查登录状态..."); 4 | if($self->search_cookie("supertoken") and $self->search_cookie("superuin")){ 5 | my $content = $self->http_get('https://ssl.ptlogin2.qq.com/pt4_auth?daid=164&appid=501004106&auth_token=' . $self->time33($self->search_cookie("supertoken")), {Referer => 'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?daid=164&target=self&style=40&pt_disable_pwd=1&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F' . $self->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001'} ); 6 | return 0 if not defined $content; 7 | my( $retcode,$api_check_sig) = $content=~/'(.*?)'/g; 8 | $self->info("登录状态检查结果($retcode)"); 9 | if( $api_check_sig =~ /^https?:\/\/[^\/]+\.qq\.com\/check_sig/){ 10 | $self->api_check_sig($api_check_sig . '®master=&aid=501004106&s_url=http%3A%2F%2F'. $self->domain . '%2Fproxy.html'); 11 | $self->info("检查结果：登录状态有效，尝试直接恢复登录..."); 12 | return 1; 13 | } 14 | else{ 15 | $self->info("检查结果：需要重新登录(1)"); 16 | return 0; 17 | } 18 | } 19 | else{ 20 | $self->info("检查结果：需要重新登录(2)"); 21 | return 0; 22 | } 23 | } 24 | 1; 25 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_check_sig.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_check_sig { 2 | my $self = shift; 3 | $self->info("检查安全代码...\n"); 4 | my $api_url = $self->api_check_sig; 5 | my $content = $self->http_get($api_url,{ua_debug_res_body=>0}); 6 | return 0 unless defined $content; 7 | return 1; 8 | } 9 | 1; 10 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_check_verify_code.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_check_verify_code{ 2 | my $self = shift; 3 | return 1 if $self->login_type eq "qrlogin"; 4 | $self->info("检查验证码...") if $self->login_type eq "login"; 5 | my $api_url = 'https://ssl.ptlogin2.qq.com/check'; 6 | my $headers = {Referer=>'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?daid=164&target=self&style=40&pt_disable_pwd=1&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F' . $seld->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001'}; 7 | 8 | my @query_string = ( 9 | regmaster => '', 10 | pt_tea => ($self->login_type eq "qrlogin"?2:1), 11 | pt_vcode => 1, 12 | uin => $self->account, 13 | appid => 501004106, 14 | js_ver => 10233, 15 | js_type => 1, 16 | login_sig => $self->pt_login_sig, 17 | u1 => 'http%3A%2F%2F' . $self->domain . ' %2Fproxy.html', 18 | r => rand(), 19 | pt_uistyle => 40, 20 | pt_jstoken => 485008785, 21 | ); 22 | 23 | #$self->ua->cookie_jar->add( 24 | # Mojo::Cookie::Response->new( 25 | # name => "chkuin", 26 | # value => $self->uid, 27 | # domain => "ptlogin2.qq.com", 28 | # path => "/", 29 | # ) 30 | #); 31 | my $content = $self->http_get($self->gen_url($api_url,@query_string),$headers); 32 | return 0 unless defined $content; 33 | my %d = (); 34 | @d{qw( retcode cap_cd md5_salt ptvfsession isRandSalt)} = $content=~/'(.*?)'/g ; 35 | $self->md5_salt($d{md5_salt}) 36 | ->cap_cd($d{cap_cd}) 37 | ->isRandSalt($d{isRandSalt}) 38 | ->pt_verifysession($d{ptvfsession}); 39 | if($d{retcode} ==0){ 40 | $self->info("检查结果: 很幸运，本次登录不需要验证码") if $self->login_type eq "login"; 41 | $self->verifycode($d{cap_cd}); 42 | } 43 | elsif($d{retcode} == 1){ 44 | $self->info("检查结果: 需要输入图片验证码")->is_need_img_verifycode(1) if $self->login_type eq "login"; 45 | } 46 | return 1; 47 | } 48 | 1; 49 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_cookie_proxy.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_cookie_proxy { 2 | my $self = shift; 3 | return 1 if $self->domain eq 'web2.qq.com'; 4 | my $p_skey = $self->search_cookie("p_skey"); 5 | my $p_uin = $self->search_cookie("p_uin"); 6 | $self->ua->cookie_jar->add( 7 | Mojo::Cookie::Response->new( 8 | name => "p_skey", 9 | value => $p_skey, 10 | domain => $self->domain, 11 | path => "/", 12 | ), 13 | Mojo::Cookie::Response->new( 14 | name => "p_uin", 15 | value => $p_uin, 16 | domain => $self->domain, 17 | path => "/", 18 | ), 19 | ) if defined $p_skey and defined $p_uin; 20 | $self->save_cookie(); 21 | return 1; 22 | }; 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_get_group_pic.pm: -------------------------------------------------------------------------------- 1 | use File::Temp qw/:seekable/; 2 | use Mojo::Util qw/url_escape/; 3 | sub Mojo::Webqq::Client::_get_group_pic { 4 | my $self = shift; 5 | my $fid = shift; 6 | my $pic_name = shift; 7 | my $rip = shift; 8 | my $rport = shift; 9 | my $sender = shift; 10 | my $cb = pop; 11 | 12 | return if $sender->is_discuss_member; 13 | my $api = 'http://web2.qq.com/cgi-bin/get_group_pic'; 14 | my @query_string ; 15 | if($sender->is_group_member){ 16 | @query_string= ( 17 | type => 0, 18 | fid => $fid, 19 | gid => $sender->gcode, 20 | pic => url_escape($pic_name), 21 | rip => $rip, 22 | rport => $rport, 23 | uin => $sender->id, 24 | vfwebqq => $self->vfwebqq, 25 | t => rand(), 26 | ); 27 | } 28 | elsif($sender->is_discuss_member){ 29 | @query_string= ( 30 | type => 0, 31 | fid => $fid, 32 | did => $sender->did, 33 | pic => url_escape($pic_name), 34 | rip => $rip, 35 | rport => $rport, 36 | uin => $sender->id, 37 | vfwebqq => $self->vfwebqq, 38 | t => rand(), 39 | ); 40 | } 41 | my $callback = sub{ 42 | my ($data,$ua,$tx) = @_; 43 | unless(defined $data){ 44 | $self->warn("群图片下载失败: " . $tx->error->{message}); 45 | return; 46 | } 47 | return unless $tx->res->headers->content_type =~/^image\/(.*)/; 48 | my $type = $1=~/jpe?g/i ? ".jpg" 49 | : $1=~/png/i ? ".png" 50 | : $1=~/bmp/i ? ".bmp" 51 | : $1=~/gif/i ? ".gif" 52 | : undef 53 | ; 54 | return unless defined $type; 55 | if(defined $self->pic_dir and not -d $self->pic_dir){ 56 | $self->error("无效的 pic_dir: " . $self->pic_dir); 57 | return; 58 | } 59 | my @opt = ( 60 | TEMPLATE => "mojo_webqq_cface_XXXX", 61 | SUFFIX => $type, 62 | UNLINK => 0, 63 | ); 64 | defined $self->pic_dir?(push @opt,(DIR=>$self->pic_dir)):(push @opt,(TMPDIR=>1)); 65 | eval{ 66 | my $tmp = File::Temp->new(@opt); 67 | binmode $tmp; 68 | print $tmp $tx->res->body(); 69 | close $tmp; 70 | $self->emit(receive_pic => $tmp->filename,$sender); 71 | if($sender->is_group_member){ 72 | $self->emit(receive_group_pic => $tmp->filename,$sender); 73 | } 74 | else{ 75 | $self->emit(receive_disucss_pic => $tmp->filename,$sender); 76 | } 77 | $cb->($self,$tmp->filename,$sender) if ref $cb eq "CODE"; 78 | }; 79 | $self->error("[Mojo::Webqq::Client::_get_group_pic] $@") if $@; 80 | }; 81 | $self->http_get($self->gen_url($api,@query_string),{Referer=>'http://'. $self->domain . '/'},$callback); 82 | }; 83 | 1; 84 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_get_img_verify_code.pm: -------------------------------------------------------------------------------- 1 | use Encode (); 2 | use Encode::Locale; 3 | sub Mojo::Webqq::Client::_get_img_verify_code{ 4 | my $self = shift; 5 | return 1 if $self->login_type ne "login"; 6 | return 1 if not $self->is_need_img_verifycode ; 7 | $self->verifycode(undef); 8 | my $api_url = 'https://ssl.captcha.qq.com/getimage'; 9 | my $headers ={Referer => 'https://ui.ptlogin2.qq.com/cgi-bin/login?daid=164&target=self&style=16&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F'. $self->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001'}; 10 | my @query_string = ( 11 | aid => 501004106, 12 | r => rand(), 13 | uin => $self->uid, 14 | cap_cd => $self->cap_cd, 15 | ); 16 | 17 | my $content = $self->http_get($self->gen_url($api_url,@query_string),$headers); 18 | unless(defined $content){ 19 | $self->error("验证码下载失败"); 20 | return 0; 21 | } 22 | $self->clean_verifycode(); 23 | eval{ 24 | die "未定义验证码保存路径\n" if not defined $self->verifycode_path; 25 | open(my $fh,">",$self->verifycode_path) or die "$!\n"; 26 | binmode $fh; 27 | print $fh $content; 28 | close $fh; 29 | }; 30 | if($@){ 31 | $self->error("验证码写入文件失败: $@"); 32 | return 0; 33 | } 34 | if($self->has_subscribers("input_img_verifycode")){ 35 | $self->emit(input_img_verifycode => $self->verifycode_path); 36 | if(defined $self->verifycode){return 1;} 37 | else{$self->fatal("无法从回调函数中获取有效的验证码");$self->stop();return 0;} 38 | } 39 | elsif(-t STDIN){ 40 | my $filename_for_console = Encode::encode("utf8",Encode::decode(locale_fs,$self->verifycode_path)); 41 | my $info = $self->log->format->(time,"info","请输入图片验证码 [ $filename_for_console ]: "); 42 | chomp($info); 43 | $self->log->append($info); 44 | my $verifycode = ; 45 | chomp($verifycode); 46 | $self->verifycode($verifycode); 47 | return 1; 48 | } 49 | else{ 50 | $self->fatal("未连接到终端，无法获取验证码\n"); 51 | $self->stop(); 52 | return 0; 53 | } 54 | return 0; 55 | } 56 | 1; 57 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_get_offpic.pm: -------------------------------------------------------------------------------- 1 | use File::Temp qw/:seekable/; 2 | use Mojo::Util qw/url_escape/; 3 | sub Mojo::Webqq::Client::_get_offpic { 4 | my $self = shift; 5 | my $file_path = shift; 6 | my $sender = shift; 7 | my $cb = pop; 8 | 9 | #my $api = 'http://w.qq.com/d/channel/get_offpic2'; 10 | my $api = 'http://d.web2.qq.com/channel/get_offpic2'; 11 | my @query_string = ( 12 | file_path => url_escape($file_path), 13 | f_uin => $sender->id, 14 | clientid => $self->clientid, 15 | psessionid => $self->psessionid, 16 | ); 17 | my $callback = sub{ 18 | my ($data,$ua,$tx) = @_; 19 | unless(defined $data){ 20 | $self->warn("图片下载失败: " . $tx->error->{message}); 21 | return; 22 | } 23 | return unless $tx->res->headers->content_type =~/^image\/(.*)/; 24 | my $type = $1=~/jpe?g/i ? ".jpg" 25 | : $1=~/png/i ? ".png" 26 | : $1=~/bmp/i ? ".bmp" 27 | : $1=~/gif/i ? ".gif" 28 | : undef 29 | ; 30 | return unless defined $type; 31 | if(defined $self->pic_dir and not -d $self->pic_dir){ 32 | $self->error("无效的 pic_dir: " . $self->pic_dir); 33 | return; 34 | } 35 | my @opt = ( 36 | TEMPLATE => "mojo_webqq_offpic_XXXX", 37 | SUFFIX => $type, 38 | UNLINK => 0, 39 | ); 40 | defined $self->pic_dir?(push @opt,(DIR=>$self->pic_dir)):(push @opt,(TMPDIR=>1)); 41 | eval{ 42 | my $tmp = File::Temp->new(@opt); 43 | binmode $tmp; 44 | print $tmp $tx->res->body(); 45 | close $tmp; 46 | $self->emit(receive_pic => $tmp->filename,$sender); 47 | $self->emit(receive_friend_pic => $tmp->filename,$sender) if $sender->type eq "friend"; 48 | $self->emit(receive_sess_pic => $tmp->filename,$sender) if $sender->type ne "friend"; 49 | $cb->($self,$tmp->filename,$sender) if ref $cb eq "CODE"; 50 | }; 51 | $self->error("[Mojo::Webqq::Client::_get_offpic] $@") if $@; 52 | }; 53 | $self->http_get($self->gen_url($api,@query_string),{Referer=>'http://'. $self->domain . '/'},$callback); 54 | }; 55 | 1; 56 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_get_qrlogin_pic.pm: -------------------------------------------------------------------------------- 1 | use Encode (); 2 | use Encode::Locale; 3 | sub Mojo::Webqq::Client::_get_qrlogin_pic { 4 | my $self = shift; 5 | return 1 if $self->login_type ne "qrlogin"; 6 | $self->info("正在获取登录二维码..."); 7 | my $api = 'https://ssl.ptlogin2.qq.com/ptqrshow'; 8 | my @query_string = ( 9 | appid => 501004106, 10 | e => 2, 11 | l => 'M', 12 | s => 3, 13 | d => 72, 14 | v => 4, 15 | t => rand(), 16 | daid => 164, 17 | pt_3rd_aid => 0, 18 | ); 19 | my $url = $self->gen_url($api,@query_string); 20 | my $data = $self->http_get($url,{Referer=>'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?daid=164&target=self&style=40&pt_disable_pwd=1&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F' . $self->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001',ua_debug_res_body=>0}); 21 | if( not defined $data){ 22 | $self->error("登录二维码下载失败"); 23 | return 0; 24 | } 25 | $self->clean_qrcode(); 26 | eval{ 27 | die "未设置二维码保存路径\n" if not defined $self->qrcode_path; 28 | open(my $fh,">",$self->qrcode_path) or die "$!\n"; 29 | binmode $fh; 30 | print $fh $data; 31 | close $fh; 32 | }; 33 | 34 | if($@){ 35 | $self->error("二维码写入文件失败: $@"); 36 | return 0; 37 | } 38 | 39 | my $filename_for_log = Encode::encode("utf8",Encode::decode(locale_fs,$self->qrcode_path)); 40 | #$self->info("二维码已下载到本地[ $filename_for_log ]\n二维码原始下载地址[ $url ]"); 41 | $self->info("二维码已下载到本地[ $filename_for_log ]"); 42 | $self->emit(input_qrcode=>$self->qrcode_path,$data); 43 | return 1; 44 | } 45 | 1; 46 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_get_vfwebqq.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_get_vfwebqq { 2 | my $self = shift; 3 | $self->info("获取数据验证参数...\n"); 4 | my $api_url = 'https://s.web2.qq.com/api/getvfwebqq'; 5 | my @query_string = ( 6 | ptwebqq => $self->ptwebqq, 7 | clientid => $self->clientid, 8 | psessionid => $self->psessionid, 9 | t => time(), 10 | ); 11 | my $headers = { 12 | Referer => 'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 13 | json => 1, 14 | ua_request_timeout => 10, 15 | ua_retry_times => 3, 16 | }; 17 | 18 | my $json = $self->http_get($self->gen_url($api_url,@query_string),$headers); 19 | return undef unless defined $json; 20 | if($json->{retcode}!=0){ 21 | $self->error("获取数据验证参数失败..."); 22 | return 0; 23 | } 24 | $self->vfwebqq($json->{result}{vfwebqq}); 25 | return 1; 26 | } 27 | 1; 28 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_login1.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_login1{ 2 | my $self = shift; 3 | my $login_type = $self->login_type; 4 | $self->info("正在进行登录(1)...") if $login_type eq "login"; 5 | if($login_type eq "qrlogin"){ 6 | my $headers = {Referer => 'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?daid=164&target=self&style=40&pt_disable_pwd=1&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F' . $self->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001'}; 7 | my @query_string = ( 8 | u1 => 'http%3A%2F%2F' . $self->domain . '%2Fproxy.html', 9 | ptqrtoken => $self->hash33($self->search_cookie("qrsig")), 10 | ptredirect => 0, 11 | h => 1, 12 | t => 1, 13 | g => 1, 14 | from_ui => 1, 15 | ptlang => 2052, 16 | action => '0-0-1516082717616', 17 | js_ver => 10233, 18 | js_type => 1, 19 | login_sig => $self->pt_login_sig, 20 | pt_uistyle => 40, 21 | aid => 501004106, 22 | daid => 164, 23 | mibao_css => 'm_webqq', 24 | ); 25 | my $content = $self->http_get($self->gen_url('https://ssl.ptlogin2.qq.com/ptqrlogin',@query_string) . '&' ,$headers ); 26 | return 0 unless defined $content; 27 | #ptuiCB('4','0','','0','您输入的验证码不正确，请重新输入。', '12345678'); 28 | #ptuiCB('3','0','','0','您输入的帐号或密码不正确，请重新输入。', '2735534596'); 29 | my %d = (); 30 | @d{qw( retcode unknown_1 api_check_sig unknown_2 status nick )} = $content=~/'(.*?)'/g; 31 | if($d{retcode} == 65){ 32 | $self->info("登录二维码已失效，重新获取二维码"); 33 | return -6; 34 | } 35 | elsif($d{retcode} == 66){ 36 | $self->info("等待手机QQ扫描二维码...\n") if $self->login_state ne 'scaning'; 37 | $self->login_state('scaning'); 38 | $self->state('scaning'); 39 | return -4; 40 | } 41 | elsif($d{retcode} == 67){ 42 | $self->info("手机QQ扫码成功，请在手机上点击[允许登录smartQQ]按钮...") if $self->login_state ne 'confirming'; 43 | $self->login_state('confirming'); 44 | $self->state('confirming'); 45 | return -5; 46 | } 47 | #elsif($d{retcode} == 10005){ 48 | # 49 | #} 50 | #elsif($d{retcode} == 10006){ 51 | # 52 | #} 53 | elsif($d{retcode} == 0){ 54 | my $qrlogin_id = $self->search_cookie("uin"); 55 | my $id = substr($qrlogin_id,1,) + 0; 56 | if(!defined $id or $id !~/^\d+$/){ 57 | $self->fatal("无法获取到登录帐号"); 58 | $self->stop(); 59 | return 0; 60 | } 61 | elsif($self->check_account and $self->account=~/^\d+$/ and $self->account ne $id){ 62 | $self->fatal("实际登录帐号和程序预设帐号不一致"); 63 | $self->stop(); 64 | return 0; 65 | } 66 | $self->uid($id); 67 | $self->api_check_sig($d{api_check_sig})->ptwebqq($self->search_cookie('ptwebqq')); 68 | return 1; 69 | } 70 | elsif($d{retcode} != 0){ 71 | $self->fatal("$d{status}，客户端终止运行...\n"); 72 | $self->stop(); 73 | return 0; 74 | } 75 | } 76 | elsif($login_type eq "login"){ 77 | my $ret = $self->model_ext_authorize(); 78 | if($ret == 1){ 79 | $self->info("账号密码方式登录成功"); 80 | $self->uid($self->account); 81 | $self->ptwebqq($self->search_cookie('ptwebqq')); 82 | return 1; 83 | } 84 | else{ 85 | $self->warn("账号密码登录方式失败，尝试使用二维码登录"); 86 | $self->login_type('qrlogin'); 87 | return -3; 88 | } 89 | } 90 | return 1; 91 | } 92 | 1; 93 | 94 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_login2.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_login2{ 2 | my $self = shift; 3 | $self->info("正在进行登录(2)..."); 4 | my $api_url = 'http://d1.web2.qq.com/channel/login2'; 5 | my $headers = { 6 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 7 | json => 1, 8 | }; 9 | my %r = ( 10 | status => $self->mode, 11 | ptwebqq => $self->ptwebqq, 12 | clientid => $self->clientid, 13 | psessionid => $self->psessionid, 14 | ); 15 | 16 | #if($self->{type} eq 'webqq'){ 17 | # $r{passwd_sig} = $self->passwd_sig; 18 | #} 19 | 20 | my $data = $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)}); 21 | return 0 unless defined $data; 22 | if($data->{retcode} ==0){ 23 | if(defined $self->uid and $self->uid ne $data->{result}{uin}){ 24 | $self->fatal("实际登录帐号和程序预设帐号不一致"); 25 | $self->stop(); 26 | return 0; 27 | } 28 | $self->uid($data->{result}{uin}) 29 | ->psessionid($data->{result}{psessionid}) 30 | #->vfwebqq($data->{result}{vfwebqq}) 31 | ->login_state('success') 32 | ->_cookie_proxy(); 33 | return 1; 34 | } 35 | return 0; 36 | } 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_prepare_for_login.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_prepare_for_login { 2 | my $self = shift; 3 | $self->info( "初始化 " . $self->type . " 客户端...\n" ); 4 | $self->http_get("http://" . $self->domain . "/",{ua_debug_res_body=>0}); 5 | my $api_url = 'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?daid=164&target=self&style=40&pt_disable_pwd=1&mibao_css=m_webqq&appid=501004106&enable_qlogin=0&no_verifyimg=1&s_url=http%3A%2F%2F' . $self->domain . '%2Fproxy.html&f_url=loginerroralert&strong_login=1&login_state=10&t=20131024001'; 6 | my $headers ={ Referer => 'http://'. $self->domain . '/',ua_debug_res_body=>0 }; 7 | my $content = $self->http_get( $api_url, $headers); 8 | return 0 unless defined $content; 9 | $self->pt_login_sig($self->search_cookie("pt_login_sig")) if not $self->pt_login_sig; 10 | return 1; 11 | } 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_recv_message.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_recv_message{ 2 | my $self = shift; 3 | return if $self->is_stop; 4 | return if $self->is_polling; 5 | $self->is_polling(1); 6 | my $api_url = ($self->security?'https':'http') . '://d1.web2.qq.com/channel/poll2'; 7 | my $callback = sub { 8 | my ($json,$ua,$tx) = @_; 9 | eval{ 10 | #分析接收到的消息，并把分析后的消息放到接收消息队列中 11 | if(defined $json){ 12 | $self->parse_receive_msg($json); 13 | $self->emit(receive_raw_message=>$tx->res->body,$json); 14 | } 15 | }; 16 | $self->error($@) if $@; 17 | $self->is_polling(0); 18 | #重新开始接收消息 19 | $self->emit("poll_over"); 20 | }; 21 | 22 | my %r = ( 23 | ptwebqq => $self->ptwebqq, 24 | clientid => $self->clientid, 25 | psessionid => $self->psessionid, 26 | key => "", 27 | ); 28 | my $headers = {Referer=>"http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2",json=>1}; 29 | my $id = $self->http_post( 30 | $api_url, 31 | $headers, 32 | form=>{r=>$self->to_json(\%r)}, 33 | $callback 34 | ); 35 | $self->poll_connection_id($id); 36 | } 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/_relink.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::_relink{ 2 | my $self = shift; 3 | $self->login_state('relink'); 4 | $self->info("正在进行重新连接(2)..."); 5 | my $api_url = 'http://d1.web2.qq.com/channel/login2'; 6 | my $headers = {Referer=>'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2',json=>1}; 7 | my %r = ( 8 | status => $self->mode, 9 | key => "", 10 | ptwebqq => $self->ptwebqq, 11 | clientid => $self->clientid, 12 | psessionid => $self->psessionid, 13 | ); 14 | 15 | my $data = $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)}); 16 | unless(defined $data){ 17 | $self->relogin(); 18 | return 0; 19 | } 20 | if($data->{retcode} ==0){ 21 | $self->psessionid($data->{result}{psessionid}) if $data->{result}{psessionid}; 22 | $self->vfwebqq($data->{result}{vfwebqq}) if $data->{result}{vfwebqq}; 23 | $self->clientid($data->{result}{clientid}) if $data->{result}{clientid}; 24 | $self->ptwebqq($data->{result}{ptwebqq}) if $data->{result}{ptwebqq}; 25 | $self->skey($data->{result}{skey}) if $data->{result}{skey}; 26 | my @cookies; 27 | push @cookies,Mojo::Cookie::Response->new( 28 | name => "ptwebqq", 29 | value => $data->{result}{ptwebqq}, 30 | domain => "qq.com", 31 | path => "/", 32 | ) if defined $data->{result}{ptwebqq}; 33 | push @cookies,Mojo::Cookie::Response->new( 34 | name => "skey", 35 | value => $data->{result}{skey}, 36 | domain => "qq.com", 37 | path => "/", 38 | ) if defined $data->{result}{skey}; 39 | $self->ua->cookie_jar->add(@cookies) if @cookies; 40 | $self->save_cookie(); 41 | $self->_cookie_proxy(); 42 | $self->login_state('success'); 43 | $self->info("重新连接(2)成功"); 44 | return 1; 45 | } 46 | else{ 47 | $self->relogin(); 48 | return 0; 49 | } 50 | } 51 | 1; 52 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/change_state.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::change_state{ 2 | my $self = shift; 3 | my $mode = shift; 4 | my $api_url = 'http://d1.web2.qq.com/channel/change_status2'; 5 | my $headers = { 6 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 7 | json => 1, 8 | }; 9 | my @query_string = ( 10 | newstatus => $mode, 11 | clientid => $self->clientid, 12 | psessionid => $self->psessionid, 13 | t => time, 14 | ); 15 | 16 | my $json = $self->http_get($self->gen_url($api_url,@query_string),$headers); 17 | return undef unless defined $json; 18 | return undef if $json->{retcode} !=0; 19 | $self->mode($mode); 20 | $self->info("登录状态已修改为：$mode"); 21 | return $mode; 22 | } 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Client/Remote/logout.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Client::logout { 2 | my $self = shift; 3 | $self->info("正在注销...\n"); 4 | $self->http_get($self->gen_url('https://ptlogin2.qq.com/logout',( 5 | pt4_token => $self->search_cookie('pt4_token'), 6 | pt4_hkey => $self->time33($self->skey), 7 | pt4_ptcz => $self->hash33($self->search_cookie("ptcz")), 8 | deep_logout => 1 9 | )),{Referer => 'http://'. $self->domain . '/'}); 10 | #my $expire = 0 - time; 11 | #$self->ua->cookie_jar->add( 12 | # Mojo::Cookie::Response->new(name=>"superuin",value=>undef,path=>"/",domain=>"qq.com",expires=>$expire), 13 | # Mojo::Cookie::Response->new(name=>"superkey",value=>undef,path=>"/",domain=>"qq.com",expires=>$expire), 14 | # Mojo::Cookie::Response->new(name=>"uin",value=>undef,path=>"/",domain=>"qq.com",expires=>$expire), 15 | # Mojo::Cookie::Response->new(name=>"key",value=>undef,path=>"/",domain=>"qq.com",expires=>$expire), 16 | #); 17 | $self->ptwebqq(undef); 18 | $self->skey(undef); 19 | $self->save_cookie(); 20 | $self->info("注销完毕\n"); 21 | return 1; 22 | } 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Counter.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Counter; 2 | use POSIX qw(); 3 | use Mojo::Util qw(md5_sum); 4 | sub new{ 5 | my $class = shift; 6 | my %p = @_; 7 | my $self = { 8 | id => $p{id} || md5_sum(rand), 9 | period => $p{period} || 600, 10 | client => $p{client}, 11 | slot => {}, 12 | }; 13 | if(defined $self->{client}){ 14 | $self->{client}->add_job("Counter <$self->{id}> Reset","00:00:00",sub{$self->reset()}); 15 | } 16 | bless $self,(ref $class) || $class; 17 | } 18 | sub count { 19 | my $self = shift; 20 | my $key = shift; 21 | my $ts = shift ; 22 | my $start = POSIX::mktime(0,0,0,(localtime)[3,4,5]); 23 | if(defined $ts){ 24 | return if time - $ts > $self->{period}; 25 | return if $ts-$start <0; 26 | } 27 | else{ $ts = time; } 28 | my $slot = int(($ts-$start)/$self->{period}); 29 | $self->{slot}{$key}[$slot]++; 30 | return $self; 31 | } 32 | sub look{ 33 | my $self = shift; 34 | my $key = shift; 35 | my $start = POSIX::mktime(0,0,0,(localtime)[3,4,5]); 36 | my $slot = int((time-$start)/$self->{period}); 37 | return defined $self->{slot}{$key}[$slot]?0+$self->{slot}{$key}[$slot]:0; 38 | } 39 | sub check { 40 | my $self = shift; 41 | $self->count(@_); 42 | return $self->look(@_); 43 | } 44 | sub reset{ 45 | my $self = shift; 46 | $self->{slot} = {}; 47 | return 1; 48 | } 49 | sub clear { 50 | my $self = shift; 51 | my $key = shift; 52 | delete $self->{slot}{$key}; 53 | return 1; 54 | } 55 | 1; 56 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Discuss/Member.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Discuss::Member; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | name 6 | id 7 | state 8 | client_type 9 | _discuss_id 10 | _flag 11 | )]; 12 | 13 | has uid => sub{ 14 | my $self = shift; 15 | return $self->{uid} if defined $self->{uid}; 16 | return $self->client->get_qq_from_id($self->id); 17 | }; 18 | sub qq {$_[0]->uid} 19 | sub nick {$_[0]->name} 20 | sub AUTOLOAD { 21 | my $self = shift; 22 | if($Mojo::Webqq::Discuss::Member::AUTOLOAD =~ /.*::d(.*)/){ 23 | my $attr = $1; 24 | $self->group->$attr(@_); 25 | } 26 | else{die("undefined subroutine $Mojo::Webqq::Discuss::Member::AUTOLOAD");} 27 | } 28 | sub displayname { 29 | my $self = shift; 30 | my $f = $self->client->search_friend(id=>$self->id); 31 | if(defined $f){ 32 | return $f->markname // $self->name; 33 | } 34 | else{ 35 | return $self->name; 36 | } 37 | } 38 | sub update{ 39 | my $self = shift; 40 | my $hash = shift; 41 | for(grep {substr($_,0,1) ne "_"} keys %$hash){ 42 | if(exists $hash->{$_}){ 43 | if(defined $hash->{$_} and defined $self->{$_}){ 44 | if($hash->{$_} ne $self->{$_}){ 45 | my $old_property = $self->{$_}; 46 | my $new_property = $hash->{$_}; 47 | $self->{$_} = $hash->{$_}; 48 | $self->client->emit("discuss_member_property_change"=>$self,$_,$old_property,$new_property); 49 | } 50 | } 51 | elsif( ! (!defined $hash->{$_} and !defined $self->{$_}) ){ 52 | my $old_property = $self->{$_}; 53 | my $new_property = $hash->{$_}; 54 | $self->{$_} = $hash->{$_}; 55 | $self->client->emit("discuss_member_property_change"=>$self,$_,$old_property,$new_property); 56 | } 57 | } 58 | } 59 | $self; 60 | } 61 | 62 | sub send { 63 | my $self = shift; 64 | $self->client->send_sess_message($self,@_); 65 | } 66 | 67 | sub discuss { 68 | my $self = shift; 69 | return scalar $self->client->search_discuss(id=>$self->_discuss_id); 70 | } 71 | 72 | 1; 73 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Friend.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Friend; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | flag 6 | id 7 | category 8 | name 9 | face 10 | markname 11 | is_vip 12 | vip_level 13 | state 14 | client_type 15 | _flag 16 | )]; 17 | has uid => sub{ 18 | my $self = shift; 19 | return $self->{uid} if defined $self->{uid}; 20 | return $self->client->get_qq_from_id($self->id); 21 | }; 22 | sub qq {$_[0]->uid} 23 | sub nick {$_[0]->name} 24 | sub displayname { 25 | my $self = shift; 26 | return defined $self->markname?$self->markname:$self->name; 27 | } 28 | sub update{ 29 | my $self = shift; 30 | my $hash = shift; 31 | for(grep {substr($_,0,1) ne "_"} keys %$hash){ 32 | if(exists $hash->{$_}){ 33 | if(defined $hash->{$_} and defined $self->{$_}){ 34 | if($hash->{$_} ne $self->{$_}){ 35 | my $old_property = $self->{$_}; 36 | my $new_property = $hash->{$_}; 37 | $self->{$_} = $hash->{$_}; 38 | $self->client->emit("friend_property_change"=>$self,$_,$old_property,$new_property); 39 | } 40 | } 41 | elsif( ! (!defined $hash->{$_} and !defined $self->{$_}) ){ 42 | my $old_property = $self->{$_}; 43 | my $new_property = $hash->{$_}; 44 | $self->{$_} = $hash->{$_}; 45 | $self->client->emit("friend_property_change"=>$self,$_,$old_property,$new_property); 46 | } 47 | } 48 | } 49 | $self; 50 | } 51 | 52 | sub send { 53 | my $self = shift; 54 | $self->client->send_friend_message($self,@_); 55 | } 56 | 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Group/Member.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Group::Member; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | name 6 | province 7 | sex 8 | id 9 | country 10 | city 11 | fullcard 12 | state 13 | client_type 14 | qage 15 | join_time 16 | last_speak_time 17 | level 18 | role 19 | bad_record 20 | _flag 21 | _group_id 22 | )]; 23 | sub card { # from Mojo::Webqq::Base 24 | my $self = shift; 25 | if (@_ == 0) { 26 | return defined $self->fullcard ? $self->fullcard : $self->{card}; 27 | } 28 | $self->{card} = shift; 29 | $self; 30 | }; 31 | has uid => sub{ 32 | my $self = shift; 33 | return $self->{uid} if defined $self->{uid}; 34 | return $self->client->get_qq_from_id($self->id); 35 | }; 36 | sub qq {$_[0]->uid} 37 | sub AUTOLOAD { 38 | my $self = shift; 39 | if($Mojo::Webqq::Group::Member::AUTOLOAD =~ /.*::g(.*)/){ 40 | my $attr = $1; 41 | $self->group->$attr(@_); 42 | } 43 | else{die("undefined subroutine $Mojo::Webqq::Group::Member::AUTOLOAD");} 44 | } 45 | sub nick {$_[0]->name}; 46 | sub displayname { 47 | my $self = shift; 48 | if($self->client->group_member_use_friend_markname){ 49 | my $f = $self->client->search_friend(id=>$self->id); 50 | if(defined $f){ 51 | return $f->markname // $self->card // $self->name; 52 | } 53 | else{ 54 | return defined $self->card?$self->card:$self->name; 55 | } 56 | } 57 | else{ 58 | return defined $self->card?$self->card:$self->name; 59 | } 60 | } 61 | 62 | sub update{ 63 | my $self = shift; 64 | my $hash = shift; 65 | for(grep {substr($_,0,1) ne "_"} keys %$hash){ 66 | if(exists $hash->{$_}){ 67 | if(defined $hash->{$_} and defined $self->{$_}){ 68 | if($hash->{$_} ne $self->{$_}){ 69 | my $old_property = $self->{$_}; 70 | my $new_property = $hash->{$_}; 71 | $self->{$_} = $hash->{$_}; 72 | $self->client->emit("group_member_property_change"=>$self,$_,$old_property,$new_property); 73 | } 74 | } 75 | elsif( ! (!defined $hash->{$_} and !defined $self->{$_}) ){ 76 | my $old_property = $self->{$_}; 77 | my $new_property = $hash->{$_}; 78 | $self->{$_} = $hash->{$_}; 79 | $self->client->emit("group_member_property_change"=>$self,$_,$old_property,$new_property); 80 | } 81 | } 82 | } 83 | $self; 84 | } 85 | 86 | sub send { 87 | my $self = shift; 88 | $self->client->send_sess_message($self,@_); 89 | } 90 | sub set_card { 91 | my $self = shift; 92 | my $card = shift; 93 | $self->group->set_group_member_card($self,$card); 94 | } 95 | sub group { 96 | my $self = shift; 97 | return scalar $self->client->search_group(id=>$self->_group_id); 98 | } 99 | sub shutup{ 100 | my $self = shift; 101 | my $time = shift; 102 | $self->group->shutup_group_member($time,$self); 103 | } 104 | 1; 105 | 106 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/List.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::List; 2 | use Mojo::Webqq::Base 'Mojo::EventEmitter'; 3 | sub new{ 4 | my $class = shift; 5 | my %opt = @_; 6 | my $self = { 7 | max_size => $opt{max_size}, 8 | _data => [], 9 | }; 10 | return bless $self,$class; 11 | } 12 | 13 | sub empty { 14 | my $self = shift; 15 | @{$self->{_data}} = (); 16 | return $self; 17 | } 18 | sub size { 19 | my $self = shift; 20 | return 0+@{$self->{_data}}; 21 | } 22 | sub append { 23 | my $self = shift; 24 | my $element = shift; 25 | if(defined $self->{max_size} and @{$self->{_data}} >= $self->{max_size}){ 26 | shift @{$self->{_data}}; 27 | } 28 | push @{$self->{_data}},$element; 29 | $self->emit(append => $element); 30 | return $self; 31 | } 32 | sub list { 33 | my $self = shift; 34 | return wantarray?@{$self->{_data}}:$self->{_data}; 35 | } 36 | sub pick{ 37 | my $self = shift; 38 | CORE::shift( @{$self->{_data}} ); 39 | } 40 | sub pick_all { 41 | my $self = shift; 42 | my @data = @{$self->{_data}}; 43 | $self->empty; 44 | return wantarray?@data:\@data; 45 | } 46 | 1; 47 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Message; 2 | use Mojo::Webqq::Base 'Mojo::Webqq::Message::Base'; 3 | has time => sub{time}; 4 | has source => 'local'; 5 | has from => "none"; 6 | has ttl => 5; 7 | has cb => undef; 8 | has allow_plugin => 1; 9 | has format => 'text'; 10 | has [qw(id via type class discuss_id sender_id receiver_id group_id content raw_content)]; 11 | has [qw(sender receiver group discuss)]; 12 | has [qw(state client_type)]; 13 | has code => -2; 14 | has msg =>'未初始化'; 15 | has info =>'未初始化'; 16 | has send_real_comp_sign => undef; #是否使用「真正的」大于/小于号。undef意为与$client->default_send_real_comp_sign一致。 17 | 18 | #兼容老版本属性msg_class/msg_id/msg_time 19 | sub AUTOLOAD { 20 | my $self = shift; 21 | if($Mojo::Webqq::Message::AUTOLOAD =~ /.*::msg_(.*)/){ 22 | my $attr = $1; 23 | $self->$attr(@_); 24 | } 25 | else{die("undefined subroutine $Mojo::Webqq::Message::AUTOLOAD");} 26 | } 27 | 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Emoji.pm: -------------------------------------------------------------------------------- 1 | my %EMOJI_MAP = qw( 2 | :100: 100分 3 | :1234: 1234 4 | :grinning: 笑嘻嘻 5 | :joy: 高兴 6 | :smiley: 微笑 7 | :emoji: 失望 8 | :smirk: 假笑 9 | :pensive: 沉思 10 | :grin: 露齿而笑 11 | :wink: 眨眼 12 | :scream: 尖叫 13 | :confounded: 糊涂 14 | :kissing_closed_eyes: 闭上眼睛亲吻 15 | :stuck_out_tongue_closed_eyes: 闭眼吐舌头 16 | :relieved: 放心 17 | :fearful: 担心 18 | :mask: 戴口罩 19 | :flushed: 脸红 20 | :unamused: 无趣 21 | :cold_sweat: 冒冷汗 22 | :astonished: 吃惊 23 | :sob: 流泪 24 | :stuck_out_tongue_winking_eye: 眨眼吐舌头 25 | :kissing_heart: 飞吻 26 | :rage: 愤怒 27 | :muscle: 秀肌肉 28 | :punch: 拳头猛击 29 | :thumbsup: 竖起大拇指 30 | :point_up: 竖起中指 31 | :clap: 鼓掌 32 | :v: 胜利 33 | :thumbsdown: 大拇指向下 34 | :pray: 祈祷 35 | :ok_hand: OK 36 | :point_left: 向左指 37 | :point_right: 向右指 38 | :point_up_2: 向上指 39 | :point_down: 向下指 40 | :eyes: 大眼珠 41 | :nose: 鼻子 42 | :lips: 嘴唇 43 | :ear: 耳朵 44 | :rice: 米饭 45 | :spaghetti: 意大利面 46 | :ramen: 拉面 47 | :rice_ball: 饭团 48 | :shaved_ice: 冰沙 49 | :sushi: 熟食 50 | :birthday: 生日蛋糕 51 | :bread: 面包 52 | :hamburger: 汉堡包 53 | :egg: 煎鸡蛋 54 | :fries: 薯条 55 | :beer: 一杯啤酒 56 | :beers: 啤酒 57 | :cocktail: 鸡尾酒 58 | :coffee: 咖啡 59 | :apple: 苹果 60 | :tangerine: 蜜橘 61 | :strawberry: 草莓 62 | :watermelon: 西瓜 63 | :pill: 胶囊 64 | :smoking: 抽烟 65 | :christmas_tree: 圣诞树 66 | :rose: 玫瑰 67 | :tada: 回头见 68 | :palm_tree: 椰子树 69 | :gift_heart: 心形礼物 70 | :ribbon: 丝带 71 | :balloon: 气球 72 | :shell: 贝壳 73 | :ring: 钻戒 74 | :bomb: 炸弹 75 | :crown: 皇冠 76 | :bell: 铃铛 77 | :star: 星星 78 | :sparkles: 闪耀 79 | :dash: 冲刺 80 | :sweat_drops: 汗滴 81 | :fire: 火焰 82 | :trophy: 奖杯 83 | :moneybag: 金钱袋 84 | :zzz: 睡觉 85 | :zap: 闪电 86 | :feet: 脚印 87 | :shit: 大便 88 | :syringe: 注射器 89 | :hotsprings: 温泉 90 | :mailbox: 邮箱 91 | :key: 钥匙 92 | :lock: 锁 93 | :airplane: 飞机 94 | :bullettrain_side: 子弹头列车 95 | :red_car: 红色小汽车 96 | :speedboat: 快艇 97 | :bike: 自行车 98 | :racehorse: 赛马 99 | :rocket: 火箭 100 | :bus: 公交车 101 | :boat: 帆船 102 | :woman: 女人 103 | :man: 男人 104 | :girl: 女孩 105 | :boy: 男孩 106 | :monkey_face: 猴子脸 107 | :octopus: 章鱼 108 | :pig: 猪 109 | :baby_chick: 小鸡 110 | :koala: 考拉 111 | :cow: 奶牛 112 | :chicken: 鸡 113 | :frog: 青蛙 114 | :ghost: 鬼魂 115 | :skull: 骷髅 116 | :bug: 毛毛虫 117 | :tropical_fish: 热带鱼 118 | :dog: 狗狗 119 | :tiger: 老虎 120 | :angel: 天生 121 | :penguin: 海豚 122 | :whale: 鲸鱼 123 | :mouse: 老鼠 124 | :womans_hat: 女士帽子 125 | :dress: 礼服 126 | :lipstick: 唇膏 127 | :high_heel: 高跟鞋 128 | :boot: 长筒靴 129 | :closed_umbrella: 雨伞 130 | :handbag: 手提袋 131 | :bikini: 比基尼 132 | :shirt: 衬衫 133 | :shoe: 鞋子 134 | :cloud: 多云 135 | :sunny: 晴天 136 | :umbrella: 下雨 137 | :moon: 弯月 138 | :snowman: 雪人 139 | :o: 圈 140 | :x: 叉 141 | :grey_question: 灰色问号 142 | :grey_exclamation: 灰色感叹号 143 | :telephone: 电话 144 | :camera: 相机 145 | :iphone: 手机 146 | :fax: 传真机 147 | :computer: 电脑 148 | :movie_camera: 摄像机 149 | :microphone: 麦克风 150 | :gun: 手枪 151 | :cd: 光盘 152 | :heartbeat: 心动 153 | :clubs: 梅花 154 | :mahjong: 麻将牌 155 | :part_alternation_mark: 衣架 156 | :slot_machine: 投币机 157 | :traffic_light: 红绿灯 158 | :construction: 施工 159 | :guitar: 吉他 160 | :barber: 理发店 161 | :bath: 浴缸 162 | :toilet: 坐便器 163 | :house: 房子 164 | :church: 教堂 165 | :bank: 银行 166 | :hospital: 医院 167 | :hotel: 旅店 168 | :atm: ATM 169 | :convenience_store: 便利店 170 | :mens: 男洗手间 171 | :womens: 女洗手间 172 | ); 173 | 174 | sub Mojo::Webqq::emoji_parse{ 175 | my $self = shift; 176 | my $data = shift; 177 | my @result; 178 | my $index = 0; 179 | my $last_emoji_start = undef; 180 | my $last_emoji_end = undef; 181 | while($data=~/:[a-z0-9_]+:/g){ 182 | if(exists $EMOJI_MAP{$&}){ 183 | $last_emoji_start = $-[0]; 184 | $last_emoji_end = $+[0]-1; 185 | push @result,{content=>substr($data,$index,$-[0]-$index),type=>"txt"} if $-[0]-$index >0; 186 | push @result,{content=>"[$EMOJI_MAP{$&}]",id=>$&,type=>"emoji"}; 187 | $index = $+[0]; 188 | } 189 | } 190 | if(defined $last_emoji_end){ 191 | push @result,{content=>substr($data,$last_emoji_end+1),type=>"txt"} if $last_emoji_end+1 < length($data); 192 | } 193 | else{ 194 | push @result,{content=>$data,type=>"txt"}; 195 | } 196 | return \@result; 197 | } 198 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Face.pm: -------------------------------------------------------------------------------- 1 | my %FACE_MAP = qw( 2 | 0 惊讶 3 | 1 撇嘴 4 | 2 色 5 | 3 发呆 6 | 4 得意 7 | 5 流泪 8 | 6 害羞 9 | 7 闭嘴 10 | 8 睡 11 | 9 大哭 12 | 10 尴尬 13 | 11 发怒 14 | 12 调皮 15 | 13 呲牙 16 | 14 微笑 17 | 21 飞吻 18 | 23 跳跳 19 | 25 发抖 20 | 26 怄火 21 | 27 爱情 22 | 29 足球 23 | 32 西瓜 24 | 33 玫瑰 25 | 34 凋谢 26 | 36 爱心 27 | 37 心碎 28 | 38 蛋糕 29 | 39 礼物 30 | 42 太阳 31 | 45 月亮 32 | 46 强 33 | 47 弱 34 | 50 难过 35 | 51 酷 36 | 53 抓狂 37 | 54 吐 38 | 55 惊恐 39 | 56 流汗 40 | 57 憨笑 41 | 58 大兵 42 | 59 猪头 43 | 62 拥抱 44 | 63 咖啡 45 | 64 饭 46 | 71 握手 47 | 72 便便 48 | 73 偷笑 49 | 74 可爱 50 | 75 白眼 51 | 76 傲慢 52 | 77 饥饿 53 | 78 困 54 | 79 奋斗 55 | 80 咒骂 56 | 81 疑问 57 | 82 嘘 58 | 83 晕 59 | 84 折磨 60 | 85 衰 61 | 86 骷髅 62 | 87 敲打 63 | 88 再见 64 | 91 闪电 65 | 92 炸弹 66 | 93 刀 67 | 95 胜利 68 | 96 冷汗 69 | 97 擦汗 70 | 98 抠鼻 71 | 99 鼓掌 72 | 100 糗大了 73 | 101 坏笑 74 | 102 左哼哼 75 | 103 右哼哼 76 | 104 哈欠 77 | 105 鄙视 78 | 106 委屈 79 | 107 快哭了 80 | 108 阴险 81 | 109 亲亲 82 | 110 吓 83 | 111 可怜 84 | 112 菜刀 85 | 113 啤酒 86 | 114 篮球 87 | 115 乒乓 88 | 116 示爱 89 | 117 瓢虫 90 | 118 抱拳 91 | 119 勾引 92 | 120 拳头 93 | 121 差劲 94 | 122 爱你 95 | 123 NO 96 | 124 OK 97 | 125 转圈 98 | 126 磕头 99 | 127 回头 100 | 128 跳绳 101 | 129 挥手 102 | 130 激动 103 | 131 街舞 104 | 132 献吻 105 | 133 左太极 106 | 134 右太极 107 | ); 108 | my %FACEID_MAP = reverse %FACE_MAP; 109 | sub Mojo::Webqq::face_to_txt{ 110 | my $self = shift; 111 | my $face = shift; 112 | if(ref $face eq 'ARRAY'){ 113 | return "[未知表情]" if $face->[0] ne "face"; 114 | return "[表情]" if $face->[1] == 0; 115 | return "[表情]" unless exists $FACE_MAP{$face->[1]}; 116 | return "[" . $FACE_MAP{$face->[1]} . "]"; 117 | } 118 | else{ 119 | return $face; 120 | } 121 | } 122 | sub Mojo::Webqq::face_parse { 123 | my $self = shift; 124 | my $data = shift; 125 | my @result; 126 | my $index = 0; 127 | my $last_face_start = undef; 128 | my $last_face_end = undef; 129 | while($data=~/\[[^\[\]]+\]/g){ 130 | my $face = substr($&,1,length($&)-2); 131 | if(exists $FACEID_MAP{$face}){ 132 | $last_face_start = $-[0]; 133 | $last_face_end = $+[0]-1; 134 | push @result,{content=>substr($data,$index,$-[0]-$index),type=>"txt"} if $-[0]-$index >0; 135 | push @result,{content=>$&,id=>$FACEID_MAP{$face},type=>"face"}; 136 | $index = $+[0]; 137 | } 138 | } 139 | if(defined $last_face_end){ 140 | push @result,{content=>substr($data,$last_face_end+1),type=>"txt"} if $last_face_end+1 < length($data); 141 | } 142 | else{ 143 | push @result,{content=>$data,type=>"txt"}; 144 | } 145 | return \@result; 146 | } 147 | 1; 148 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Queue.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Message::Queue; 2 | $Mojo::Webqq::Message::Queue::LAST_GET_TIME = undef; 3 | $Mojo::Webqq::Message::Queue::GET_INTERVAL = 3; 4 | sub new{ 5 | my $class = shift; 6 | my $callback_for_get ; 7 | my $callback_for_put ; 8 | my $callback_for_delay ; 9 | my $ioloop ; 10 | if(@_ == 1){ 11 | $callback_for_get = shift; 12 | } 13 | else{ 14 | my %opt = @_; 15 | $callback_for_get = $opt{get}; 16 | $callback_for_put = $opt{put}; 17 | $callback_for_delay = $opt{delay}; 18 | $ioloop = $opt{ioloop}; 19 | } 20 | my $self = { 21 | ioloop => $ioloop, 22 | queue => [], 23 | callback_for_get => undef, 24 | callback_for_delay => undef, 25 | callback_for_put => undef, 26 | callback_for_get_bak => undef, 27 | }; 28 | $self->{callback_for_get} = $callback_for_get if ref $callback_for_get eq "CODE"; 29 | $self->{callback_for_put} = $callback_for_put if ref $callback_for_put eq "CODE"; 30 | $self->{callback_for_delay} = $callback_for_delay if ref $callback_for_delay eq "CODE"; 31 | return bless $self,$class; 32 | } 33 | sub put{ 34 | my $self = shift; 35 | die "Mojo::Webqq::Message::Queue->put()失败，请检查是否已经设置了队列get()回调\n" 36 | unless ref $self->{callback_for_get} eq 'CODE'; 37 | push @{ $self->{queue} } ,$_[0]; 38 | if(defined $self->{ioloop} and ref $self->{callback_for_delay} eq "CODE"){ 39 | my $delay = 0; 40 | my $now = time; 41 | if(defined $Mojo::Webqq::Message::Queue::LAST_GET_TIME){ 42 | $delay = $now<$Mojo::Webqq::Message::Queue::LAST_GET_TIME+$Mojo::Webqq::Message::Queue::GET_INTERVAL? 43 | $Mojo::Webqq::Message::Queue::LAST_GET_TIME+$Mojo::Webqq::Message::Queue::GET_INTERVAL-$now 44 | : 0; 45 | } 46 | $self->{ioloop}->timer($delay,sub{ 47 | $self->{callback_for_delay}->($self->{queue}); 48 | $self->_notify_to_get(); 49 | }); 50 | $Mojo::Webqq::Message::Queue::LAST_GET_TIME = $now+$delay; 51 | } 52 | else{ 53 | $self->_notify_to_get(); 54 | } 55 | } 56 | sub get{ 57 | my $self = shift; 58 | my $cb = shift; 59 | die "Mojo::Webqq::Message::Queue->get()仅接受一个函数引用\n" unless ref $cb eq 'CODE'; 60 | $self->{callback_for_get} = $cb; 61 | $self->{callback_for_get_bak} = $cb; 62 | } 63 | sub _notify_to_get{ 64 | my $self = shift; 65 | my $msg = shift @{$self->{queue}}; 66 | $self->{callback_for_get}->($msg); 67 | } 68 | 69 | 1; 70 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Remote/_get_sess_sig.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Message::_get_sess_sig { 2 | my $self = shift; 3 | my($id,$to_uin,$service_type,) = @_; 4 | my $cache_data = $self->sess_sig_cache->retrieve("$id|$to_uin|$service_type"); 5 | return $cache_data if defined $cache_data; 6 | my $api_url = 'http://d1.web2.qq.com/channel/get_c2cmsg_sig2'; 7 | my @query_string = ( 8 | id => $id, 9 | to_uin => $to_uin, 10 | service_type => $service_type, 11 | clientid => $self->clientid, 12 | psessionid => $self->psessionid, 13 | t => time, 14 | ); 15 | my $headers = {Referer=>'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2',json=>1}; 16 | my $json = $self->http_get($self->gen_url($api_url,@query_string),$headers); 17 | return undef unless defined $json; 18 | return undef if $json->{retcode}!=0; 19 | return undef if $json->{result}{value} eq ""; 20 | $self->sess_sig_cache->store("$id|$to_uin|$service_type",$json->{result}{value},300); 21 | return $json->{result}{value} ; 22 | } 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Remote/_send_discuss_message.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::_send_discuss_message { 2 | my $self = shift; 3 | my $msg = shift; 4 | my $api_url = ($self->security?'https':'http') . '://d1.web2.qq.com/channel/send_discu_msg2'; 5 | 6 | my $callback = sub{ 7 | my $json = shift; 8 | $msg->parse_send_status_msg( $json ); 9 | if(!$msg->is_success and $msg->code != -3 and $msg->ttl > 0){ 10 | $self->debug("消息[ " .$msg->id . " ]发送失败，尝试重新发送，当前TTL: " . $msg->ttl); 11 | $self->message_queue->put($msg); 12 | #$self->send_discuss_message($msg); 13 | return; 14 | } 15 | else{ 16 | if(ref $msg->cb eq 'CODE'){ 17 | $msg->cb->( 18 | $self, 19 | $msg, 20 | ); 21 | } 22 | $self->emit(send_message => 23 | $msg, 24 | ); 25 | } 26 | }; 27 | 28 | my $headers = { 29 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 30 | json => 1, 31 | }; 32 | my @content = map { 33 | if($_->{type} eq "txt"){$_->{content}} 34 | elsif($_->{type} eq "face"){["face",0+$_->{id}]} 35 | } @{$msg->raw_content}; 36 | #for(my $i=0;$i<@content;$i++){ 37 | # if(ref $content[$i] eq "ARRAY"){ 38 | # if(ref $content[$i] eq "ARRAY"){ 39 | # splice @content,$i+1,0," "; 40 | # } 41 | # else{ 42 | # $content[$i+1] = " " . $content[$i+1]; 43 | # } 44 | # } 45 | #} 46 | my $content = [@content,["font",{name=>"宋体",size=>10,style=>[0,0,0],color=>"000000"}]]; 47 | my %s = ( 48 | did => $msg->discuss_id, 49 | face => $self->user->face || 591, 50 | content => $self->to_json($content), 51 | msg_id => $msg->id, 52 | clientid => $self->clientid, 53 | psessionid => $self->psessionid, 54 | ); 55 | $self->http_post( 56 | $api_url, 57 | $headers, 58 | form=>{r=>$self->to_json(\%s)}, 59 | $callback, 60 | ); 61 | 62 | } 63 | 1; 64 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Remote/_send_friend_message.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::_send_friend_message{ 2 | my($self,$msg) = @_; 3 | my $callback = sub{ 4 | my $json = shift; 5 | $msg->parse_send_status_msg( $json ); 6 | if(!$msg->is_success and $msg->ttl > 0){ 7 | $self->debug("消息[ " .$msg->id . " ]发送失败，尝试重新发送，当前TTL: " . $msg->ttl); 8 | $self->message_queue->put($msg); 9 | return; 10 | } 11 | else{ 12 | if(ref $msg->cb eq 'CODE'){ 13 | $msg->cb->( 14 | $self, 15 | $msg, 16 | ); 17 | } 18 | $self->emit(send_message => 19 | $msg, 20 | ); 21 | } 22 | }; 23 | my $api_url = ($self->security?'https':'http') . '://d1.web2.qq.com/channel/send_buddy_msg2'; 24 | my $headers = { 25 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 26 | json => 1, 27 | }; 28 | my @content = map { 29 | if($_->{type} eq "txt"){$_->{content}} 30 | elsif($_->{type} eq "face"){["face",0+$_->{id}]} 31 | } @{$msg->raw_content}; 32 | #for(my $i=0;$i<@content;$i++){ 33 | # if(ref $content[$i] eq "ARRAY"){ 34 | # if(ref $content[$i] eq "ARRAY"){ 35 | # splice @content,$i+1,0," "; 36 | # } 37 | # else{ 38 | # $content[$i+1] = " " . $content[$i+1]; 39 | # } 40 | # } 41 | #} 42 | my $content = [@content,["font",{name=>"宋体",size=>10,style=>[0,0,0],color=>"000000"}]]; 43 | my %s = ( 44 | to => $msg->receiver_id, 45 | face => $self->user->face || 570, 46 | content => $self->to_json($content), 47 | msg_id => $msg->id, 48 | clientid => $self->clientid, 49 | psessionid => $self->psessionid, 50 | ); 51 | $self->http_post( 52 | $api_url, 53 | $headers, 54 | form=>{r=>$self->to_json(\%s)}, 55 | $callback, 56 | ); 57 | } 58 | 1; 59 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Remote/_send_group_message.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::_send_group_message{ 2 | my($self,$msg) = @_; 3 | my $callback = sub{ 4 | my $json = shift; 5 | $msg->parse_send_status_msg( $json ); 6 | if( !$msg->is_success and $msg->ttl > 0){ 7 | $self->debug("消息[ " .$msg->id . " ]发送失败，尝试重新发送，当前TTL: " . $msg->ttl); 8 | $self->message_queue->put($msg); 9 | #$self->send_group_message($msg); 10 | return; 11 | } 12 | else{ 13 | if(ref $msg->cb eq 'CODE'){ 14 | $msg->cb->( 15 | $self, 16 | $msg, 17 | ); 18 | } 19 | $self->emit(send_message => 20 | $msg, 21 | ); 22 | } 23 | }; 24 | 25 | my $api_url = ($self->security?'https':'http') . '://d1.web2.qq.com/channel/send_qun_msg2'; 26 | my $headers = { 27 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 28 | json => 1, 29 | }; 30 | my @content = map { 31 | if($_->{type} eq "txt"){$_->{content}} 32 | elsif($_->{type} eq "face"){["face",0+$_->{id}]} 33 | } @{$msg->raw_content}; 34 | #for(my $i=0;$i<@content;$i++){ 35 | # if(ref $content[$i] eq "ARRAY"){ 36 | # if(ref $content[$i] eq "ARRAY"){ 37 | # splice @content,$i+1,0," "; 38 | # } 39 | # else{ 40 | # $content[$i+1] = " " . $content[$i+1]; 41 | # } 42 | # } 43 | #} 44 | my $content = [@content,["font",{name=>"宋体",size=>10,style=>[0,0,0],color=>"000000"}]]; 45 | my %s = ( 46 | group_uin => $msg->group_id, 47 | face => $self->user->face || 591, 48 | content => $self->to_json($content), 49 | msg_id => $msg->id, 50 | clientid => $self->clientid, 51 | psessionid => $self->psessionid, 52 | ); 53 | $self->http_post( 54 | $api_url, 55 | $headers, 56 | form=>{r=>$self->to_json(\%s)}, 57 | $callback, 58 | ); 59 | } 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/Remote/_send_sess_message.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::_send_sess_message{ 2 | my($self,$msg) = @_; 3 | if(not defined $msg->sess_sig){ 4 | $msg->send_status(code=>-5,msg=>"发送失败",info=>'无法获取到sess_sig'); 5 | if(ref $msg->cb eq 'CODE'){ 6 | $msg->cb->( 7 | $self, 8 | $msg, 9 | ); 10 | } 11 | $self->emit(send_message => 12 | $msg, 13 | ); 14 | return; 15 | } 16 | my $callback = sub{ 17 | my $json = shift; 18 | $msg->parse_send_status_msg( $json ); 19 | if(!$msg->is_success and $msg->ttl > 0){ 20 | $self->debug("消息[ " .$msg->id . " ]发送失败，尝试重新发送，当前TTL: " . $msg->ttl); 21 | $self->message_queue->put($msg); 22 | return; 23 | } 24 | else{ 25 | if(ref $msg->cb eq 'CODE'){ 26 | $msg->cb->( 27 | $self, 28 | $msg, 29 | ); 30 | } 31 | $self->emit(send_message => 32 | $msg, 33 | ); 34 | } 35 | }; 36 | 37 | my $api_url = ($self->security?'https':'http') . '://d1.web2.qq.com/channel/send_sess_msg2'; 38 | my $headers = { 39 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 40 | json => 1, 41 | }; 42 | my @content = map { 43 | if($_->{type} eq "txt"){$_->{content}} 44 | elsif($_->{type} eq "face"){["face",0+$_->{id}]} 45 | } @{$msg->raw_content}; 46 | #for(my $i=0;$i<@content;$i++){ 47 | # if(ref $content[$i] eq "ARRAY"){ 48 | # if(ref $content[$i] eq "ARRAY"){ 49 | # splice @content,$i+1,0," "; 50 | # } 51 | # else{ 52 | # $content[$i+1] = " " . $content[$i+1]; 53 | # } 54 | # } 55 | #} 56 | my $content = [@content,["font",{name=>"宋体",size=>10,style=>[0,0,0],color=>"000000"}]]; 57 | my %s = ( 58 | to => $msg->receiver_id , 59 | group_sig => $msg->sess_sig , 60 | face => $self->user->face || 591, 61 | content => $self->to_json($content), 62 | msg_id => $msg->id, 63 | service_type => $msg->via eq "group"?0:1, 64 | clientid => $self->clientid, 65 | psessionid => $self->psessionid, 66 | ); 67 | $self->http_post( 68 | $api_url, 69 | $headers, 70 | form=>{r=>$self->to_json(\%s)}, 71 | $callback, 72 | ); 73 | } 74 | 1; 75 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Message/XMLescape.pm: -------------------------------------------------------------------------------- 1 | #my %XML_ESCAPE_MAP = ( 2 | # '&' => '&', 3 | # '<' => '<', 4 | # '>' => '>', 5 | # '"' => '"', 6 | # ''' => '\'', 7 | # ''' => '\'', 8 | # ' ' => ' ', 9 | # '\' => "\\", 10 | #); 11 | use Encode (); 12 | use Mojo::Util qw(); 13 | sub Mojo::Webqq::xmlescape_parse { 14 | my $self = shift; 15 | my $data = shift; 16 | return $data if not defined $data; 17 | $data=~s/ / /g; 18 | my $unicode_data = Mojo::Util::html_unescape(Encode::decode("utf8",$data)); 19 | #my $newdata = Mojo::Util::html_unescape($data); 20 | #eval { 21 | # if ($data =~ /\&/ or $newdata =~ /[><&]/) { 22 | # $newdata = Encode::decode('utf8', $newdata); 23 | # Encode::_utf8_off($newdata); 24 | # } 25 | #}; 26 | #return $newdata; 27 | #return $data; 28 | return Encode::encode("utf8",$unicode_data); 29 | } 30 | 1; 31 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Base.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Model::Base; 2 | use Mojo::Webqq::Base -base; 3 | use Scalar::Util qw(blessed); 4 | use Data::Dumper; 5 | sub client { 6 | return $Mojo::Webqq::_CLIENT; 7 | } 8 | sub to_json_hash{ 9 | my $self = shift; 10 | my $hash = {}; 11 | for(keys %$self){ 12 | next if substr($_,0,1) eq "_"; 13 | next if $_ eq "member"; 14 | $hash->{$_} = $self->{$_}; 15 | } 16 | if(exists $self->{member}){ 17 | $hash->{member} = []; 18 | if(ref $self->{member} eq "ARRAY"){ 19 | for my $m(@{$self->{member}}){ 20 | my $member_hash = $m->to_json_hash(); 21 | push @{$hash->{member}},$member_hash; 22 | } 23 | } 24 | } 25 | 26 | return $hash; 27 | } 28 | sub dump{ 29 | my $self = shift; 30 | my $clone = {}; 31 | my $obj_name = blessed($self); 32 | for(grep {substr($_,0,1) ne '_' } keys %$self){ 33 | if(my $n=blessed($self->{$_})){ 34 | $clone->{$_} = "Object($n)"; 35 | } 36 | elsif($_ eq "member" and ref($self->{$_}) eq "ARRAY"){ 37 | my $member_count = @{$self->{$_}}; 38 | $clone->{$_} = [ "$member_count of Object(${obj_name}::Member)" ]; 39 | } 40 | else{ 41 | $clone->{$_} = $self->{$_}; 42 | } 43 | } 44 | local $Data::Dumper::Indent = 1; 45 | local $Data::Dumper::Terse = 1; 46 | $self->client->print("Object($obj_name) " . Data::Dumper::Dumper($clone)); 47 | return $self; 48 | } 49 | 50 | sub type{ 51 | my $self = shift; 52 | my %map = ( 53 | "Mojo::Webqq::Friend" => "friend", 54 | "Mojo::Webqq::Group" => "group", 55 | "Mojo::Webqq::Group::Member" => "group_member", 56 | "Mojo::Webqq::Discuss" => "discuss", 57 | "Mojo::Webqq::Disucc::Member" => "discuss_member", 58 | "Mojo::Webqq::User" => "user", 59 | "Mojo::Webqq::Recent::Friend" => "recent_friend", 60 | "Mojo::Webqq::Recent::Group" => "recent_group", 61 | "Mojo::Webqq::Recent::Discuss" => "recent_discuss", 62 | ); 63 | return $map{ref($self)}; 64 | } 65 | 66 | sub is_friend{ 67 | my $self = shift; 68 | ref $self eq "Mojo::Webqq::Friend"?1:0; 69 | } 70 | sub is_group{ 71 | my $self = shift; 72 | ref $self eq "Mojo::Webqq::Group"?1:0; 73 | } 74 | sub is_group_member{ 75 | my $self = shift; 76 | ref $self eq "Mojo::Webqq::Group::Member"?1:0; 77 | } 78 | sub is_discuss{ 79 | my $self = shift; 80 | ref $self eq "Mojo::Webqq::Discuss"?1:0; 81 | } 82 | sub is_discuss_member{ 83 | my $self = shift; 84 | ref $self eq "Mojo::Webqq::Discuss::Member"?1:0; 85 | } 86 | sub is_me{ 87 | my $self = shift; 88 | return 1 if ref $self eq "Mojo::Webqq::User"; 89 | if($self->is_group_member or $self->is_discuss_member){ 90 | return 1 if $self->id eq $self->client->user->id; 91 | } 92 | return 0; 93 | } 94 | 95 | 1; 96 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Ext.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Model::Ext; 2 | BEGIN{ 3 | eval{ 4 | require Webqq::Encryption; 5 | }; 6 | unless($@){ 7 | $Mojo::Webqq::Model::Ext::has_webqq_encryption = 1; 8 | } 9 | } 10 | our $_retcode; 11 | our $_verifycode; 12 | our $_md5_salt; 13 | our $_verifysession; 14 | our $_is_rand_salt; 15 | our $_api_check_sig; 16 | 17 | sub model_ext_authorize{ 18 | my $self = shift; 19 | if(not $Mojo::Webqq::Model::Ext::has_webqq_encryption){ 20 | $self->warn("未安装 Webqq::Encryption 模块，无法获取扩展信息，安装方法参见: https://metacpan.org/pod/distribution/Webqq-Encryption/lib/Webqq/Encryption.pod"); 21 | $self->model_ext(0); 22 | return; 23 | } 24 | 25 | if($self->login_type eq 'login' and $self->account !~ /^\d+$/){ 26 | $self->error("使用账号密码登录方式，account参数不是有效的QQ号码"); 27 | $self->stop(); 28 | } 29 | if($self->pwd){ 30 | $self->info("开始账号密码方式登录...") if $self->login_type eq 'login'; 31 | $self->info("尝取扩展信息授权...") if $self->login_type eq 'qrlogin'; 32 | my $ret = $self->_model_ext_prepare() && $self->_model_ext_check() && $self->_model_ext_login() && $self->_model_ext_check_sig(); 33 | if($ret){ 34 | $self->model_ext($ret); 35 | #$self->info("账号密码方式登录成功"); 36 | return 1; 37 | } 38 | else{ 39 | #$self->info("账号密码方式失败"); 40 | return 0; 41 | } 42 | } 43 | else{ 44 | $self->warn("未设置有效的登录密码，无法进行登录"); 45 | return 0; 46 | } 47 | return 1; 48 | } 49 | sub _model_ext_prepare { 50 | my $self = shift; 51 | $self->debug("账号登录中(prepare)..."); 52 | my(undef,$ua,$tx) = $self->http_get('https://xui.ptlogin2.qq.com/cgi-bin/xlogin?appid=715030901&daid=73&pt_no_auth=1&s_url=http%3A%2F%2Fqun.qq.com%2F',{Referer=>'http://qun.qq.com/',ua_debug_res_body=>0, blocking=> 1}); 53 | return $tx->res->code == 200?1:0; 54 | } 55 | 56 | sub _model_ext_check { 57 | my $self = shift; 58 | $self->debug("账号登录中(check)..."); 59 | my $content = $self->http_get( 60 | $self->gen_url('https://ssl.ptlogin2.qq.com/check', 61 | ( 62 | regmaster => '', 63 | pt_tea => 2, 64 | pt_vcode => 1, 65 | uin => ($self->login_type eq 'login'?$self->account:$self->uid), 66 | appid => 715030901, 67 | js_ver => 10233, 68 | js_type => 1, 69 | login_sig => $self->search_cookie("pt_login_sig"), 70 | u1 => 'http%3A%2F%2Fqun.qq.com%2F', 71 | r => rand(), 72 | pt_uistyle=> 40, 73 | pt_jstoken=> 485008785 74 | ) 75 | ), 76 | {blocking=>1,Referer => 'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?appid=715030901&daid=73&pt_no_auth=1&s_url=http%3A%2F%2Fqun.qq.com%2F'}, 77 | ); 78 | my($retcode,$verifycode,$md5_salt,$verifysession,$is_rand_salt) = $content =~/'([^']*)'/g; 79 | 80 | if($retcode == 0 ){ 81 | $_retcode = $retcode; 82 | $_verifycode = $verifycode; 83 | $_md5_salt = $md5_salt; 84 | $_verifysession = $verifysession; 85 | $_is_rand_salt = $is_rand_salt; 86 | } 87 | else{ 88 | $self->error("账号登录失败: 可能因为登录环境变化引起，解决方法参见：https://github.com/sjdy521/Mojo-Webqq/issues/183"); 89 | } 90 | return $retcode == 0? 1 : 0; 91 | } 92 | 93 | sub _model_ext_login{ 94 | my $self = shift; 95 | $self->debug("账号登录中(login)..."); 96 | my $content = $self->http_get( 97 | $self->gen_url('https://ssl.ptlogin2.qq.com/login', 98 | ( 99 | u => ($self->login_type eq 'login'?$self->account:$self->uid), 100 | verifycode => $_verifycode, 101 | pt_vcode_v1 => 0, 102 | pt_verifysession_v1 => ,$_verifysession // $self->search_cookie('verifysession'), 103 | p => Webqq::Encryption::pwd_encrypt($self->pwd,$_md5_salt,$_verifycode,1), 104 | pt_randsalt => $_is_rand_salt || 0,, 105 | pt_jstoken => 485008785, 106 | u1 => 'http%3A%2F%2Fqun.qq.com%2F', 107 | ptredirect => 1, 108 | h => 1, 109 | t => 1, 110 | g => 1, 111 | from_ui => 1, 112 | ptlang => 2052, 113 | action => '1-14-1515074375763', 114 | js_ver => 10233, 115 | js_type => 1, 116 | login_sig => $self->search_cookie("pt_login_sig"), 117 | pt_uistyle => 40, 118 | aid => 715030901, 119 | daid => 73, 120 | has_onekey => 1, 121 | ) 122 | ) . '&', 123 | { 124 | Referer => 'https://xui.ptlogin2.qq.com/cgi-bin/xlogin?appid=715030901&daid=73&pt_no_auth=1&s_url=http%3A%2F%2Fqun.qq.com%2F', 125 | blocking => 1, 126 | }, 127 | ); 128 | 129 | my($retcode,undef,$api_check_sig,undef,$info,$nick) = $content =~/'([^']*)'/g; 130 | if($retcode != 0){ 131 | $self->warn("账号登录失败: $info"); 132 | } 133 | else{ 134 | $_api_check_sig = $api_check_sig; 135 | } 136 | return $retcode == 0?1:0; 137 | } 138 | 139 | sub _model_ext_check_sig { 140 | my $self = shift; 141 | $self->debug("账号登录中(check_sig)..."); 142 | my(undef,$ua,$tx) = $self->http_get($_api_check_sig,{ua_debug_res_body=>0}); 143 | return $tx->res->code == 200?1:0; 144 | } 145 | 146 | 1; 147 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_discuss_info.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_get_discuss_info { 2 | my $self = shift; 3 | my $did = shift; 4 | my $callback = shift; 5 | my $api_url = 'http://d1.web2.qq.com/channel/get_discu_info'; 6 | my @query_string = ( 7 | did => $did, 8 | vfwebqq => $self->vfwebqq, 9 | clientid => $self->clientid, 10 | psessionid => $self->psessionid, 11 | t => time(), 12 | ); 13 | my $headers = { 14 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 15 | json => 1, 16 | ua_request_timeout => $self->model_update_timeout, 17 | ua_retry_times => 3, 18 | }; 19 | 20 | my $is_blocking = ref $callback eq "CODE"?0:1; 21 | my $handle = sub{ 22 | my $json = shift; 23 | return unless defined $json; 24 | return undef if $json->{retcode}!=0; 25 | return undef unless exists $json->{result}{info}; 26 | 27 | my %mem_list; 28 | my %mem_status; 29 | my %mem_info; 30 | my $minfo = []; 31 | 32 | for(@{ $json->{result}{info}{mem_list} }){ 33 | $mem_list{$_->{mem_uin}}{ruin} = $_->{ruin}; 34 | } 35 | 36 | for(@{ $json->{result}{mem_status} }){ 37 | $mem_status{$_->{uin}}{status} = $_->{status}; 38 | $mem_status{$_->{uin}}{client_type} = $_->{client_type}; 39 | } 40 | 41 | for(@{ $json->{result}{mem_info} }){ 42 | $mem_info{$_->{uin}}{nick} = $_->{nick}; 43 | } 44 | 45 | my $discuss_info = { 46 | id => $json->{result}{info}{did}, 47 | owner_id => $json->{result}{info}{discu_owner}, 48 | name => $json->{result}{info}{discu_name}, 49 | }; 50 | 51 | for(keys %mem_list){ 52 | my $m = { 53 | id => $_, 54 | name => $mem_info{$_}{nick}, 55 | uid => $mem_list{$_}{ruin}, 56 | _discuss_id => $discuss_info->{did}, 57 | }; 58 | if(exists $mem_status{$_}){ 59 | $m->{state} = $mem_status{$_}{status}; 60 | $m->{client_type} = $self->code2client($mem_status{$_}{client_type}); 61 | } 62 | else{ 63 | $m->{state} = 'offline'; 64 | $m->{client_type} = 'unknown'; 65 | } 66 | push @{$minfo},$m; 67 | } 68 | 69 | $discuss_info->{ member } = $minfo if @$minfo>0; 70 | return $discuss_info; 71 | }; 72 | if($is_blocking){ 73 | return $handle->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 74 | } 75 | else{ 76 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 77 | my $json = shift; 78 | $callback->( $handle->($json) ); 79 | }); 80 | } 81 | } 82 | 1; 83 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_discuss_list_info.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_get_discuss_list_info { 2 | my $self = shift; 3 | my $callback = shift; 4 | my $api_url = 'https://s.web2.qq.com/api/get_discus_list'; 5 | my @query_string = ( 6 | clientid => $self->clientid, 7 | psessionid => $self->psessionid, 8 | vfwebqq => $self->vfwebqq, 9 | t => time(), 10 | ); 11 | 12 | my $headers = { 13 | Referer => 'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 14 | json => 1, 15 | }; 16 | my $is_blocking = ref $callback eq "CODE"?0:1; 17 | my $handle = sub { 18 | my $json = shift; 19 | return unless defined $json; 20 | return undef if $json->{retcode}!=0; 21 | #{"retcode":0,"result":{"dnamelist":[{"name":"test","did":612950676}]}} 22 | for(@{ $json->{result}{dnamelist} }){ 23 | $_->{id} = delete $_->{did}; 24 | } 25 | 26 | return $json->{result}{dnamelist}; 27 | }; 28 | if($is_blocking){ 29 | return $handle->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 30 | } 31 | else{ 32 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 33 | my $json = shift; 34 | $callback->( $handle->($json) ); 35 | }); 36 | } 37 | } 38 | 39 | 1; 40 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_friend_info.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_friend_info{ 3 | my $self = shift; 4 | my $uin = shift; 5 | my $callback = shift; 6 | my $api_url = 'https://s.web2.qq.com/api/get_friend_info2'; 7 | my $headers = { 8 | Referer=>'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 9 | json=>1, 10 | ua_request_timeout=> $self->model_update_timeout, 11 | ua_retry_times => 3, 12 | }; 13 | my @query_string = ( 14 | tuin => $uin, 15 | vfwebqq => $self->vfwebqq, 16 | clientid => $self->clientid, 17 | psessionid => $self->psessionid, 18 | t => time, 19 | ); 20 | 21 | my $is_blocking = ref $callback eq "CODE"?0:1; 22 | my $handle = sub{ 23 | my $json = shift; 24 | return undef unless defined $json; 25 | return undef if $json->{retcode} !=0; 26 | my $friend_info = $json->{result}; 27 | $friend_info->{birthday} = join("-",@{ $friend_info->{birthday}}{qw(year month day)} ); 28 | $friend_info{state} = $self->code2state(delete $friend_info->{'stat'}); 29 | $friend_info->{id} = delete $friend_info->{uin}; 30 | $friend_info->{name} = $friend_info->{nick}; 31 | return $friend_info; 32 | }; 33 | if($is_blocking){ 34 | return $hande->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 35 | } 36 | else{ 37 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 38 | my $json = shift; 39 | $callback->( $handle->($json) ); 40 | }); 41 | } 42 | } 43 | 1; 44 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_friends_state.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_get_friends_state { 2 | my $self = shift; 3 | my $callback = shift; 4 | my $api_url = 'http://d1.web2.qq.com/channel/get_online_buddies2'; 5 | my $headers = { 6 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 7 | json => 1, 8 | }; 9 | my @query_string = ( 10 | vfwebqq => $self->vfwebqq, 11 | clientid => $self->clientid, 12 | psessionid => $self->psessionid, 13 | t => time, 14 | ); 15 | my $is_blocking = ref $callback eq "CODE"?0:1; 16 | my $handle = sub { 17 | my $json = shift; 18 | return undef unless defined $json; 19 | return undef if $json->{retcode} !=0; 20 | for(@{$json->{result}}){ 21 | $_->{client_type} = $self->code2client($_->{client_type}); 22 | $_->{state} = $_->{status}; 23 | delete $_->{status}; 24 | } 25 | return $json->{result}; 26 | }; 27 | if($is_blocking){ 28 | return $handle->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 29 | } 30 | else{ 31 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 32 | my $json = shift; 33 | $callback->( $handle->($json)); 34 | }); 35 | } 36 | } 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_group_info.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_group_info { 3 | my $self = shift; 4 | my $gcode = shift; 5 | my $callback = shift; 6 | my $api_url = 'https://s.web2.qq.com/api/get_group_info_ext2'; 7 | my @query_string = ( 8 | gcode => $gcode, 9 | vfwebqq => $self->vfwebqq, 10 | t => time(), 11 | ); 12 | 13 | my $headers = { 14 | Referer => 'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 15 | json=>1, 16 | ua_request_timeout => $self->model_update_timeout, 17 | ua_retry_times => 3, 18 | }; 19 | my $is_blocking = ref $callback eq "CODE"?0:1; 20 | my $handle = sub { 21 | my $json = shift; 22 | return unless defined $json; 23 | my $ginfo_status = exists $json->{result}{ginfo}?"[ginfo-ok]":"[ginfo-not-ok]"; 24 | my $minfo_status = ref $json->{result}{minfo} eq "ARRAY"?"[minfo-ok]":"[minfo-not-ok]"; 25 | 26 | return undef unless exists $json->{result}{ginfo}; 27 | $json->{result}{ginfo}{id} = delete $json->{result}{ginfo}{gid}; 28 | $json->{result}{ginfo}{code} = delete $json->{result}{ginfo}{code}; 29 | $json->{result}{ginfo}{name} = $self->xmlescape_parse($json->{result}{ginfo}{name}); 30 | $json->{result}{ginfo}{memo} = delete $json->{result}{ginfo}{memo}; 31 | $json->{result}{ginfo}{createtime} = delete $json->{result}{ginfo}{createtime}; 32 | $json->{result}{ginfo}{level} = delete $json->{result}{ginfo}{level}; 33 | $json->{result}{ginfo}{owner_id} = delete $json->{result}{ginfo}{owner}; 34 | $json->{result}{ginfo}{markname} = $self->xmlescape_parse($json->{result}{ginfo}{markname}); 35 | 36 | delete $json->{result}{ginfo}{fingermemo}; 37 | delete $json->{result}{ginfo}{face}; 38 | delete $json->{result}{ginfo}{option}; 39 | delete $json->{result}{ginfo}{class}; 40 | delete $json->{result}{ginfo}{flag}; 41 | delete $json->{result}{ginfo}{members}; 42 | 43 | #retcode等于0说明包含完整的ginfo和minfo 44 | if(exists $json->{result}{minfo} and ref $json->{result}{minfo} eq "ARRAY"){ 45 | my %cards; 46 | if(ref $json->{result}{cards} eq "ARRAY" and @{ $json->{result}{cards} }!=0){ 47 | for (@{ $json->{result}{cards} }){ 48 | $cards{$_->{muin}} = $_->{card}; 49 | } 50 | } 51 | my %state; 52 | for(@{ $json->{result}{stats} }){ 53 | $state{$_->{uin}}{client_type} = $self->code2client($_->{client_type}); 54 | $state{$_->{uin}}{state} = $self->code2state($_->{'stat'}); 55 | } 56 | for my $m(@{ $json->{result}{minfo} }){ 57 | if( not $self->group_member_card_ext_only){ 58 | $m->{card} = $self->xmlescape_parse($cards{$m->{uin}}) if exists $cards{$m->{uin}}; 59 | $m->{card} = $self->safe_truncate($m->{card},$self->group_member_card_cut_length); 60 | } 61 | $m->{name} = $self->xmlescape_parse(delete $m->{nick}); 62 | if(exists $state{$m->{uin}}){ 63 | $m->{state} = $state{$m->{uin}}{state}; 64 | $m->{client_type} = $state{$m->{uin}}{client_type}; 65 | } 66 | else{ 67 | $m->{state} = 'offline'; 68 | $m->{client_type} = 'unknown'; 69 | } 70 | $m->{_group_id} = $json->{result}{ginfo}{id}; 71 | $m->{id} = delete $m->{uin}; 72 | $m->{sex} = delete $m->{gender}; 73 | } 74 | $json->{result}{ginfo}{member} = delete $json->{result}{minfo}; 75 | } 76 | return $json->{result}{ginfo}; 77 | }; 78 | if($is_blocking){ 79 | return $handle->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 80 | } 81 | else{ 82 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 83 | my $json = shift; 84 | $callback->( $handle->($json) ); 85 | }); 86 | } 87 | } 88 | 1; 89 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_group_info_ext.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_group_info_ext { 3 | my $self = shift; 4 | my $uid = shift; 5 | my $callback = shift; 6 | #my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/get_group_members_new"; 7 | my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/get_group_members"; 8 | my $is_blocking = ref $callback eq "CODE"?0:1; 9 | my $handle = sub { 10 | my $json = shift; 11 | return if not defined $json; 12 | return if $json->{ec}!=0; 13 | if(ref $json->{mems} ne 'ARRAY'){ 14 | $self->warn("更新群[$uid]扩展信息失败: 返回数据异常"); 15 | return; 16 | } 17 | my %levelname; 18 | for(keys %{$json->{levelname}}){ 19 | $levelname{$_} = $json->{levelname}{$_}; 20 | } 21 | my %last_speak_time; 22 | for (keys %{$json->{times}}){ 23 | $last_speak_time{$_} = $json->{times}{$_}; 24 | } 25 | my %join_time; 26 | for (keys %{$json->{join}}){ 27 | $join_time{$_} = $json->{join}{$_}; 28 | } 29 | my %adm; 30 | $adm{$_} = 1 for @{$json->{adm}}; 31 | 32 | my %card; 33 | for(keys %{$json->{cards}}){ 34 | $card{$_} = $json->{cards}{$_}; 35 | } 36 | 37 | my $group = {member=>[]}; 38 | 39 | $group->{max_admin} = undef; 40 | $group->{admin_count} = undef; 41 | $group->{member_count} = undef; 42 | $group->{max_member} = undef; 43 | 44 | $group->{uid} = $uid; 45 | $group->{owner_uid} = $json->{owner}; 46 | for(@{$json->{mems}}){ 47 | my $member = {}; 48 | $member->{uid} = $_->{u}; 49 | 50 | if($member->{uid} eq $group->{owner_uid}){ 51 | $member->{role} = 'owner'; 52 | } 53 | elsif($adm{ $member->{uid} } == 1){ 54 | $member->{role} = 'admin'; 55 | } 56 | else{ 57 | $member->{role} = 'member'; 58 | } 59 | $member->{card} = (defined $card{$member->{uid}} and $card{$member->{uid}} ne "")?$self->xmlescape_parse($card{$member->{uid}}): undef; 60 | if ($self->group_member_use_fullcard) { 61 | $member->{fullcard} = $member->{card}; 62 | } 63 | if(not $self->group_member_card_ext_only){ 64 | $member->{card} = $self->safe_truncate($member->{card},$self->group_member_card_cut_length) if defined $member->{card}; 65 | } 66 | $member->{name} = $self->xmlescape_parse($_->{n}); 67 | $member->{last_speak_time} = $last_speak_time{$member->{uid}}; 68 | $member->{join_time} = $join_time{$member->{uid}}; 69 | push @{$group->{member}},$member; 70 | } 71 | return $group; 72 | }; 73 | if($is_blocking){ 74 | return $handle->( $self->http_post($api,{Referer=>"http://qinfo.clt.qq.com/member.html",json=>1},form=>{gc=>$uid,u=>$self->user->uid,bkn=>$self->get_csrf_token},) ); 75 | } 76 | else{ 77 | $self->http_post($api,{Referer=>"http://qinfo.clt.qq.com/member.html",json=>1},form=>{gc=>$uid,u=>$self->user->uid,bkn=>$self->get_csrf_token},sub{ 78 | my $json = shift; 79 | $callback->( $handle->($json) ); 80 | }); 81 | } 82 | } 83 | 1; 84 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_group_info_ext2.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_group_info_ext2 { 3 | my $self = shift; 4 | my $uid = shift; 5 | my $callback = shift; 6 | my $api = "http://qun.qq.com/cgi-bin/qun_mgr/search_group_members"; 7 | my $is_blocking = ref $callback eq "CODE"?0:1; 8 | my $handle = sub { 9 | my $json = shift; 10 | return if not defined $json; 11 | return if $json->{ec}!=0; 12 | #{"adm_max":10,"adm_num":1,"count":4,"ec":0,"levelname":{"1":"潜水","2":"冒泡","3":"吐槽","4":"活跃","5":"话唠","6":"传说"},"max_count":500,"mems":[{"card":"","flag":0,"g":0,"join_time":1410241477,"last_speak_time":1427191050,"lv":{"level":2,"point":404},"nick":"灰灰","qage":10,"role":0,"tags":"-1","uin":308165330},{"card":"","flag":0,"g":0,"join_time":1423016758,"last_speak_time":1427210847,"lv":{"level":2,"point":275},"nick":"小灰","qage":0,"role":1,"tags":"-1","uin":3072574066},{"card":"","flag":0,"g":0,"join_time":1427210502,"last_speak_time":1427210858,"lv":{"level":2,"point":1},"nick":"王鹏飞","qage":8,"role":2,"tags":"-1","uin":470869063},{"card":"小灰2号","flag":0,"g":0,"join_time":1422946743,"last_speak_time":1424144472,"lv":{"level":1,"point":0},"nick":"小灰2号","qage":0,"role":2,"tags":"-1","uin":1876225186}],"search_count":4,"svr_time":1427291710,"vecsize":1} 13 | my %role = ( 14 | 0 => "owner", 15 | 1 => "admin", 16 | 2 => "member", 17 | ); 18 | my %levelname; 19 | for(keys %{$json->{levelname}}){ 20 | $levelname{$_} = $json->{levelname}{$_}; 21 | } 22 | my $group = {member=>[]}; 23 | 24 | $group->{max_admin} = $json->{adm_max}; 25 | $group->{admin_count} = $json->{adm_num}; 26 | $group->{member_count} = $json->{count}; 27 | $group->{max_member} = $json->{max_count}; 28 | 29 | $group->{uid} = $uid; 30 | 31 | for(@{$json->{mems}}){ 32 | my $member = {}; 33 | $member->{level} = $levelname{$_->{lv}{level}}; 34 | $member->{bad_record} = $_->{flag}; 35 | $member->{sex} = $_->{g}?"female":"male"; 36 | $member->{uid} = $_->{uin}; 37 | $member->{role} = $role{$_->{role}}; 38 | $member->{card} = (defined $_->{card} and $_->{card} ne "")?$self->xmlescape_parse($_->{card}): undef; 39 | $member->{name} = $self->xmlescape_parse($_->{nick}); 40 | $member->{qage} = $_->{qage}; 41 | $member->{join_time} = $_->{join_time}; 42 | $member->{last_speak_time} = $_->{last_speak_time}; 43 | push @{$group->{member}},$member; 44 | } 45 | return $group; 46 | }; 47 | if($is_blocking){ 48 | return $handle->( $self->http_post($api,{Origin=>"http://qun.qq.com",Referer=>"http://qun.qq.com/member.html",json=>1},form=>{gc=>$uid,st=>0,end=>2000,sort=>0,bkn=>$self->get_csrf_token},) ); 49 | } 50 | else{ 51 | $self->http_post($api,{Origin=>"http://qun.qq.com",Referer=>"http://qun.qq.com/member.html",json=>1},form=>{gc=>$uid,st=>0,end=>2000,sort=>0,bkn=>$self->get_csrf_token},sub{ 52 | my $json = shift; 53 | $callback->( $handle->($json) ); 54 | }); 55 | } 56 | } 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_group_list_info.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_group_list_info{ 3 | my $self = shift; 4 | my $callback = shift; 5 | my $api_url = 'https://s.web2.qq.com/api/get_group_name_list_mask2'; 6 | my $headers = { 7 | Referer => 'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 8 | json=>1, 9 | ua_request_timeout => $self->model_update_timeout, 10 | ua_retry_times => 3, 11 | }; 12 | my %r = ( 13 | hash => $self->hash($self->ptwebqq,$self->uid), 14 | vfwebqq => $self->vfwebqq, 15 | ); 16 | my $is_blocking = ref $callback eq "CODE"?0:1; 17 | my $handle = sub{ 18 | my $json = shift; 19 | return undef unless defined $json; 20 | return undef unless exists $json->{result}{gnamelist}; 21 | my $group_list_info = $json->{result}{gnamelist}; 22 | my %gmarklist; 23 | for(@{ $group_list_info }){ 24 | $gmarklist{$_->{gid}} = $_->{markname}; 25 | } 26 | for(@{$group_list_info}){ 27 | $_->{markname} = $self->xmlescape_parse($gmarklist{$_->{gid}}); 28 | $_->{name} = $self->xmlescape_parse($_->{name}); 29 | $_->{id} = delete $_->{gid}; 30 | delete $_->{flag} ; 31 | } 32 | return $group_list_info; 33 | }; 34 | if($is_blocking){ 35 | return $handle->($self->http_get($api_url,$headers,form=>{r=>$self->to_json(\%r)},) ); 36 | } 37 | else{ 38 | $self->http_get($api_url,$headers,form=>{r=>$self->to_json(\%r)},sub{ 39 | my $json = shift; 40 | $callback->( $handle->($json) ); 41 | }); 42 | } 43 | } 44 | 1; 45 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_group_list_info_ext.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_group_list_info_ext { 3 | my $self = shift; 4 | my $callback = shift; 5 | my $api = 'http://qun.qq.com/cgi-bin/qun_mgr/get_group_list'; 6 | my $is_blocking = ref $callback eq "CODE"?0:1; 7 | my $handle = sub { 8 | my $json = shift; 9 | return if not defined $json; 10 | return if $json->{ec}!=0; 11 | #{"ec":0,"join":[{"gc":1299322,"gn":"perl技术","owner":4866832},{"gc":144539789,"gn":"PERL学习交流","owner":419902730},{"gc":213925424,"gn":"PERL","owner":913166583}],"manage":[{"gc":390179723,"gn":"IT狂人","owner":308165330}]} 12 | my @result; 13 | for my $t (qw(join manage create)){ 14 | for(@{$json->{$t}}){ 15 | my $group = {}; 16 | $group->{name} = $self->xmlescape_parse($_->{gn}); 17 | $group->{uid} = $_->{gc}; 18 | $group->{owner_uid} = $_->{owner}; 19 | $group->{role} = $t eq "join"?"attend":$t; 20 | push @result,$group; 21 | } 22 | } 23 | return \@result; 24 | }; 25 | if($is_blocking){ 26 | return $handle->($self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{bkn=>$self->get_csrf_token},)); 27 | } 28 | else{ 29 | $self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{bkn=>$self->get_csrf_token},sub{ 30 | my $json = shift; 31 | $callback->( $handle->($json) ); 32 | }); 33 | } 34 | }; 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_recent_info.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_get_recent_info { 2 | my $self = shift; 3 | my $callback = shift; 4 | my $api_url = 'http://d1.web2.qq.com/channel/get_recent_list2'; 5 | my $headers = { 6 | Referer => 'http://d1.web2.qq.com/proxy.html?v=20151105001&callback=1&id=2', 7 | json => 1, 8 | }; 9 | 10 | my %r = ( 11 | vfwebqq => $self->vfwebqq, 12 | clientid => $self->clientid, 13 | psessionid => $self->psessionid, 14 | ); 15 | my $is_blocking = ref $callback eq "CODE"?0:1; 16 | my $handle = sub{ 17 | my $json = shift; 18 | return undef unless defined $json; 19 | return undef if $json->{retcode}!=0 ; 20 | my %type = (0 => 'friend',1 => 'group', 2 => 'discuss'); 21 | my @recent; 22 | for(@{$json->{result}}){ 23 | next unless exists $type{$_->{type}}; 24 | $_->{type} = $type{$_->{type}}; 25 | if($_->{type} eq "friend"){$_->{id} = delete $_->{uin};} 26 | elsif($_->{type} eq "group"){$_->{id} = delete $_->{uin};} 27 | elsif($_->{type} eq "discuss"){$_->{id} = delete $_->{uin};} 28 | push @recent,$_; 29 | } 30 | return @recent>0?\@recent:undef; 31 | }; 32 | if($is_blocking){ 33 | return $handle->( $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)},) ); 34 | } 35 | else{ 36 | $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)},sub{ 37 | my $json = shift; 38 | $callback->( $handle->($json) ); 39 | }); 40 | } 41 | } 42 | 1; 43 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_user_friends.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_get_user_friends{ 2 | my $self = shift; 3 | my $callback = shift; 4 | my $api_url = 'https://s.web2.qq.com/api/get_user_friends2'; 5 | my $headers = { 6 | Referer=>'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 7 | json=>1, 8 | ua_request_timeout => $self->model_update_timeout, 9 | ua_retry_times => 3, 10 | }; 11 | my %r = ( 12 | hash => $self->hash($self->ptwebqq,$self->uid), 13 | vfwebqq => $self->vfwebqq, 14 | ); 15 | 16 | my $is_blocking = ref $callback eq "CODE"?0:1; 17 | my $handle = sub{ 18 | my $json = shift; 19 | my $friends_state = shift; 20 | return undef unless defined $json; 21 | return undef if $json->{retcode}!=0 ; 22 | my %categories ; 23 | my %info; 24 | my %marknames; 25 | my %vipinfo; 26 | my %state; 27 | if(defined $friends_state and ref $friends_state eq "ARRAY"){ 28 | for(@{$friends_state}){ 29 | $state{$_->{uin}}{state} = $_->{state}; 30 | $state{$_->{uin}}{client_type} = $_->{client_type}; 31 | } 32 | } 33 | for(@{ $json->{result}{categories}}){ 34 | $categories{ $_->{'index'} } = {'sort'=>$_->{'sort'},name=>$_->{name} }; 35 | } 36 | $categories{0} = {sort=>0,name=>'我的好友'} if not defined $categories{0}; 37 | for(@{ $json->{result}{info}}){ 38 | $info{$_->{uin}} = {face=>$_->{face},flag=>$_->{flag},nick=>$_->{nick}}; 39 | } 40 | for(@{ $json->{result}{marknames} }){ 41 | $marknames{$_->{uin}} = {markname=>$_->{markname},type=>$_->{type}}; 42 | } 43 | for(@{ $json->{result}{vipinfo} }){ 44 | $vipinfo{$_->{u}} = {vip_level=>$_->{vip_level},is_vip=>$_->{is_vip}}; 45 | } 46 | for(@{$json->{result}{friends}}){ 47 | my $uin = $_->{uin}; 48 | if(exists $state{$_->{uin}}){ 49 | $_->{state} = $state{$uin}{state}; 50 | $_->{client_type} = $state{$uin}{client_type}; 51 | } 52 | else{ 53 | $_->{state} = 'offline'; 54 | $_->{client_type} = 'unknown'; 55 | } 56 | $_->{category} = $self->xmlescape_parse($categories{$_->{categories}}{name}); 57 | $_->{name} = $self->xmlescape_parse($info{$uin}{nick}); 58 | $_->{face} = $info{$uin}{face}; 59 | $_->{markname} = $self->xmlescape_parse($marknames{$uin}{markname}); 60 | $_->{is_vip} = $vipinfo{$uin}{is_vip}; 61 | $_->{vip_level} = $vipinfo{$uin}{vip_level}; 62 | delete $_->{categories}; 63 | $_->{id} = delete $_->{uin}; 64 | } 65 | return $json->{result}{friends}; 66 | }; 67 | if($is_blocking){ 68 | my $json = $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)},); 69 | my $friends_state = $self->_get_friends_state(); 70 | return $handle->($json,$friends_state); 71 | } 72 | else{ 73 | $self->steps( 74 | sub{ 75 | my $delay = shift; 76 | $self->http_post($api_url,$headers,form=>{r=>$self->to_json(\%r)},$delay->begin(0,1)); 77 | $self->_get_friends_state($delay->begin(0,1)); 78 | }, 79 | sub{ 80 | my($delay,$json,$friends_state) = @_; 81 | $callback->( $handle->($json,$friends_state) ) if ref $callback eq "CODE"; 82 | }, 83 | ); 84 | } 85 | } 86 | 1; 87 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_user_friends_ext.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_user_friends_ext { 3 | my $self = shift; 4 | my $callback = shift; 5 | my $api = 'http://qun.qq.com/cgi-bin/qun_mgr/get_friend_list'; 6 | my $is_blocking = ref $callback eq "CODE"?0:1; 7 | my $handle = sub{ 8 | my $json = shift; 9 | return if not defined $json; 10 | return if $json->{ec}!=0; 11 | #{"ec":0,"result":{"0":{"mems":[{"name":"卖茶叶和眼镜per","uin":744891290}]},"1":{"gname":"朋友"},"2":{"gname":"家人"},"3":{"gname":"同学"}}} 12 | my @result; 13 | for my $category_index (keys %{$json->{result}}){ 14 | my $category = ($category_index==0 and !defined $json->{result}{$category_index}{gname})?"我的好友":($json->{result}{$category_index}{gname}); 15 | next if ref $json->{result}{$category_index}{mems} ne "ARRAY"; 16 | for my $f (@{ $json->{result}{$category_index}{mems} }){ 17 | my $friend = { 18 | category => $self->xmlescape_parse($category), 19 | displayname => $self->xmlescape_parse($f->{name}), 20 | uid => $f->{uin}, 21 | } ; 22 | push @result,$friend; 23 | } 24 | } 25 | return \@result; 26 | }; 27 | if($is_blocking){ 28 | return $handle->($self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{bkn=>$self->get_csrf_token},) ); 29 | } 30 | else{ 31 | $self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{bkn=>$self->get_csrf_token},sub{ 32 | my $json = shift; 33 | $callback->( $handle->($json) ); 34 | }); 35 | } 36 | } 37 | 1; 38 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_get_user_info.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_get_user_info{ 3 | my $self = shift; 4 | my $callback = shift; 5 | my $api_url ='https://s.web2.qq.com/api/get_self_info2'; 6 | my $headers = { 7 | Referer => 'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1', 8 | json => 1, 9 | ua_request_timeout => $self->model_update_timeout, 10 | ua_retry_times => 3, 11 | }; 12 | my @query_string = ( 13 | t => time, 14 | ); 15 | my $is_blocking = ref $callback eq "CODE"?0:1; 16 | my $handle = sub{ 17 | my $json = shift; 18 | return undef unless defined $json; 19 | return undef if $json->{retcode} !=0; 20 | my $user = $json->{result}; 21 | $user->{state} = $self->mode; 22 | $user->{name} = delete $user->{nick}; 23 | $user->{client_type} = 'web'; 24 | $user->{birthday} = join( "-", @{ $user->{birthday} }{qw(year month day)} ); 25 | $user->{signature} = delete $user->{lnick}; 26 | $user->{sex} = delete $user->{gender}; 27 | #my $single_long_nick = $self->get_single_long_nick( $self->uid ); 28 | #$json->{result}{signature} = $single_long_nick if defined $single_long_nick; 29 | $user->{uid} = $self->uid; 30 | $user->{id} = delete $user->{uin}; 31 | return $user; 32 | }; 33 | if($is_blocking){ 34 | return $handle->( $self->http_get($self->gen_url($api_url,@query_string),$headers,) ); 35 | } 36 | else{ 37 | $self->http_get($self->gen_url($api_url,@query_string),$headers,sub{ 38 | my $json = shift; 39 | $callback->( $handle->($json) ); 40 | }); 41 | } 42 | } 43 | 1; 44 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_invite_friend.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_invite_friend{ 3 | my $self = shift; 4 | my($uid,@qq) = @_; 5 | my $api = "http://qun.qq.com/cgi-bin/qun_mgr/add_group_member"; 6 | my $json = $self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{gc=>$uid,ul=>join("|",@qq),bkn=>$self->get_csrf_token}); 7 | return if not defined $json; 8 | return if $json->{ec}!=0; 9 | return 1; 10 | } 11 | 1; 12 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_kick_group_member.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_kick_group_member{ 3 | my $self = shift; 4 | my($uid,@qq) = @_; 5 | my $api = "http://qun.qq.com/cgi-bin/qun_mgr/delete_group_member"; 6 | my $json = $self->http_post($api,{Referer=>"http://qun.qq.com/member.html",json=>1},form=>{gc=>$uid,ul=>join("|",@qq),flag=>0,bkn=>$self->get_csrf_token}); 7 | return if not defined $json; 8 | return if $json->{ec}!=0; 9 | return 1; 10 | } 11 | 1; 12 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_qiandao.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::_qiandao { 2 | my($self,$uid) = @_; 3 | if(not defined $uid){ 4 | $self->warn("无效的群组号码"); 5 | return; 6 | } 7 | my $api = 'http://qiandao.qun.qq.com/cgi-bin/sign'; 8 | my $json = $self->http_post( 9 | $api, 10 | {json=>1,Referer=>"http://qiandao.qun.qq.com/index.html?groupUin=$uid&appID=100729587"}, 11 | form=>{ 12 | gc=>$uid, 13 | is_sign=>0, 14 | bkn=>$self->get_csrf_token, 15 | } 16 | ); 17 | return if not defined $json; 18 | #{"conti_count":1,"ec":0,"is_new":0,"is_sign":1,"now":1464858442,"rank":2,"sign_time":1464858442,"today_count":2,"total_count":1} 19 | return if $json->{ec} != 0; 20 | return if $json->{is_sign} != 1; 21 | return 1; 22 | } 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_remove_group_admin.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_remove_group_admin{ 3 | my $self = shift; 4 | my($uid,@qq) = @_; 5 | my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/set_group_admin"; 6 | my $json = $self->http_post($api,{Referer=>"http://qinfo.clt.qq.com/member.html",json=>1}, 7 | form=>{src=>"qinfo_v2",gc=>$uid,u=>join("|",$qq[0]),op=>0,bkn=>$self->get_csrf_token}); 8 | return if not defined $json; 9 | return if $json->{ec}!=0; 10 | return 1; 11 | } 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_set_group_admin.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_set_group_admin{ 3 | my $self = shift; 4 | my($uid,@qq) = @_; 5 | my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/set_group_admin"; 6 | my $json = $self->http_post( 7 | $api,{Referer=>"http://qinfo.clt.qq.com/member.html",json=>1}, 8 | form=>{src=>"qinfo_v2",gc=>$uid,u=>join("|",$qq[0]),op=>1,bkn=>$self->get_csrf_token} 9 | ); 10 | return if not defined $json; 11 | return if $json->{ec}!=0; 12 | return 1; 13 | } 14 | 1; 15 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_set_group_member_card.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_set_group_member_card{ 3 | my $self = shift; 4 | my($uid,$qq,$card) = @_; 5 | my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/set_group_card"; 6 | my $form = length $card?{gc=>$uid,u=>$qq,name=>$card,bkn=>$self->get_csrf_token}:{gc=>$uid,u=>$qq,bkn=>$self->get_csrf_token}; 7 | my $json = $self->http_post($api,{Referer=>"http://qinfo.clt.qq.com/member.html",json=>1},form=>$form); 8 | return if not defined $json; 9 | return if $json->{ec}!=0; 10 | return 1; 11 | } 12 | 1; 13 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/_shutup_group_member.pm: -------------------------------------------------------------------------------- 1 | use strict; 2 | sub Mojo::Webqq::Model::_shutup_group_member{ 3 | my $self = shift; 4 | my($uid,$t,@qq) = @_; 5 | my $api = "http://qinfo.clt.qq.com/cgi-bin/qun_info/set_group_shutup"; 6 | my $json = $self->http_post($api,{Referer=>"http://qinfo.clt.qq.com/qinfo_v3/member.html",json=>1},form=>{gc=>$uid,shutup_list=>$self->to_json([map {{uin=>$_,t=>$t}} @qq]),bkn=>$self->get_csrf_token}); 7 | return if not defined $json; 8 | return if $json->{ec}!=0; 9 | return 1; 10 | } 11 | 1; 12 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/get_qq_from_id.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::get_qq_from_id{ 2 | my $self = shift; 3 | return ; 4 | my $uin = shift; 5 | my $cache_data = $self->id_to_qq_cache->retrieve($uin); 6 | return $cache_data if defined $cache_data; 7 | my $api_url = 'https://s.web2.qq.com/api/get_friend_uin2'; 8 | my $headers = {Referer=>'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1',json=>1}; 9 | my @query_string = ( 10 | tuin => $uin, 11 | type => 1, 12 | vfwebqq => $self->vfwebqq, 13 | t => time, 14 | ); 15 | 16 | my $json = $self->http_get($self->gen_url($api_url,@query_string),$headers); 17 | return undef unless defined $json; 18 | return undef if $json->{retcode} !=0; 19 | $self->id_to_qq_cache->store($uin,$json->{result}{account}); 20 | return $json->{result}{account}; 21 | } 22 | 1; 23 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Model/Remote/get_single_long_nick.pm: -------------------------------------------------------------------------------- 1 | sub Mojo::Webqq::Model::get_single_long_nick{ 2 | my $self = shift; 3 | my $uin = shift; 4 | 5 | my $api_url = 'https://s.web2.qq.com/api/get_single_long_nick2'; 6 | my $headers = {Referer=>'https://s.web2.qq.com/proxy.html?v=20130916001&callback=1&id=1',json=>1}; 7 | my @query_string = ( 8 | tuin => $uin, 9 | vfwebqq => $self->vfwebqq, 10 | t => time, 11 | ); 12 | my $json = $self->http_get($self->gen_url($api_url,@query_string),$headers); 13 | return undef unless defined $json; 14 | return undef if $json->{retcode} !=0; 15 | #{"retcode":0,"result":[{"uin":308165330,"lnick":""}]} 16 | my $single_long_nick = $json->{result}[0]{lnick}; 17 | return $single_long_nick; 18 | } 19 | 1; 20 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin; 2 | sub load { 3 | my $self = shift; 4 | my @module_name; 5 | my %opt; 6 | if(ref $_[0] eq "ARRAY"){ 7 | @module_name = @{shift @_}; 8 | } 9 | else{ 10 | push @module_name,shift; 11 | } 12 | %opt= @_; 13 | 14 | for my $module_name (@module_name){ 15 | my $module_function = undef; 16 | my $module; 17 | if(substr($module_name,0,1) eq '+'){ 18 | substr($module_name,0,1) = ""; 19 | $module = $module_name; 20 | } 21 | else{ 22 | $module = "Mojo::Webqq::Plugin::" . $module_name; 23 | } 24 | eval "require $module"; 25 | $self->die("加载插件[ $module ]失败: $@\n") if $@; 26 | $module_function = *{"${module}::call"}{CODE}; 27 | $self->die("加载插件[ $module ]失败: 未获取到call函数引用\n") if ref $module_function ne 'CODE'; 28 | $self->debug("加载插件[ $module ]"); 29 | $self->plugins->{$module}{code} = $module_function; 30 | $self->plugins->{$module}{name} = $module; 31 | $self->plugins->{$module}{data} = $opt{data}; 32 | $self->plugins->{$module}{priority} = $opt{priority} || eval "\$${module}::PRIORITY" || 0; 33 | $self->plugins->{$module}{call_on_load} = $opt{call_on_load} || eval "\$${module}::CALL_ON_LOAD" || 0; 34 | if($self->plugins->{$module}{call_on_load}){ 35 | $self->emit("plugin_load",$module); 36 | $self->call($module); 37 | } 38 | else{ 39 | $self->plugins->{$module}{auto_call} = $opt{auto_call} || eval "\$${module}::AUTO_CALL" || 1 ; 40 | $self->emit("plugin_load",$module); 41 | } 42 | } 43 | return $self; 44 | } 45 | 46 | sub call{ 47 | my $self = shift; 48 | my @plugins; 49 | if(ref $_[0] eq 'ARRAY'){ 50 | @plugins = @{$_[0]}; 51 | shift; 52 | } 53 | else{ 54 | push @plugins,$_[0]; 55 | shift; 56 | } 57 | for(sort {$self->plugins->{$b}{priority} <=> $self->plugins->{$a}{priority}} @plugins){ 58 | if(exists $self->plugins->{$_}){ 59 | $self->info("执行插件[ $_ ]"); 60 | eval { 61 | &{$self->plugins->{$_}{code}}($self,$self->plugins->{$_}{data},@_); 62 | }; 63 | if($@){ 64 | $self->error("插件[ $_ ]执行错误: $@"); 65 | if($@ =~ /Can't create listen socket: Address already in use/){ 66 | $self->stop(); 67 | } 68 | next; 69 | } 70 | $self->emit("plugin_call",$_); 71 | } 72 | else{ 73 | $self->error("运行插件[ $_ ]失败：找不到该插件"); 74 | } 75 | } 76 | return $self; 77 | } 78 | 79 | 1; 80 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/FmPush.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::FmPush; 2 | use Mojo::Util qw(md5_sum); 3 | 4 | 5 | our $AUTHOR = 'heipidage'; 6 | our $SITE = 'http://www.coolapk.com/apk/com.swjtu.gcmformojo'; 7 | our $DESC = '接收消息通过魅族提供的推送接口发送到android手机'; 8 | our $PRIORITY = 97; 9 | use List::Util qw(first); 10 | sub call { 11 | my $client = shift; 12 | my $data = shift; 13 | $client->load("UploadQRcode") if !$client->is_load_plugin('UploadQRcode'); 14 | my $api_url = $data->{api_url} // 'https://api-push.meizu.com/garcia/api/server/push/unvarnished/pushByPushId'; 15 | my $api_key = 'eb034b0b4f42414baedaa04ddc7e6981'; 16 | my $app_id = '110370'; 17 | my $registration_ids = $data->{registration_ids} // []; 18 | if(ref $registration_ids ne 'ARRAY' or @{$registration_ids} == 0){ 19 | $client->die("[".__PACKAGE__."]registration_ids无效"); 20 | } 21 | my $registration_id = $registration_ids->[0]; 22 | 23 | $client->on(receive_message=>sub{ 24 | my($client,$msg) = @_; 25 | my $type = 'Mojo-Webqq'; 26 | my $title; 27 | my $message; 28 | my $msgId; 29 | my $senderType; 30 | my $isAt = 0; 31 | 32 | if($msg->is_at) { 33 | $isAt=1; 34 | } 35 | if($msg->type eq 'friend_message'){ 36 | return if $data->{is_ban_official} and $msg->sender->category eq '公众号'; 37 | $msgId = $msg->sender->id; 38 | $title = $msg->sender->displayname; 39 | $message = $msg->content; 40 | $senderType = '1'; 41 | } 42 | elsif($msg->type eq 'group_message'){ 43 | if(!$isAt) { 44 | return if ref $data->{ban_group} eq "ARRAY" and @{$data->{ban_group}} and first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->displayname eq $_} @{$data->{ban_group}}; 45 | return if ref $data->{allow_group} eq "ARRAY" and @{$data->{allow_group}} and !first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->displayname eq $_} @{$data->{allow_group}}; 46 | } 47 | $msgId = $msg->group->id; 48 | $title = $msg->group->displayname; 49 | $message = $msg->sender->displayname . ": " . $msg->content; 50 | $senderType = '2'; 51 | } 52 | return if !$title or !$message; 53 | 54 | my $messageJson = '{"content":"{\"isAt\":\"'.$isAt.'\",\"type\":\"'.$type.'\",\"title\":\"'.$title.'\",\"message\":\"'.$message.'\",\"msgId\":\"'.$msgId.'\",\"senderType\":\"'.$senderType.'\"}"}'; 55 | print "appId=".$app_id."messageJson=".$messageJson."pushIds=".$registration_id.$api_key; 56 | my $sign = md5_sum("appId=".$app_id."messageJson=".$messageJson."pushIds=".$registration_id.$api_key); 57 | 58 | $client->http_post($api_url, 59 | {ua_debug=>1,ua_debug_req_body=>1,ua_debug_res_body=>1,json=>1}, 60 | form=>{ 61 | appId => $app_id, 62 | pushIds => $registration_id, 63 | messageJson=>$messageJson, 64 | sign => $sign, 65 | }, 66 | sub{ 67 | #"{"multicast_id":9016211065189210367,"success":1,"failure":0,"canonical_ids":0,"results":[{"message_id":"0:1484103730761325%9b9e6c13f9fd7ecd"}]}" 68 | my $json = shift; 69 | if(not defined $json){ 70 | $client->debug("[".__PACKAGE__."]魅族消息推送失败: 返回结果异常"); 71 | return; 72 | } 73 | else{ 74 | $client->debug("[".__PACKAGE__."]魅族消息推送完成：$json->{multicast_id}/$json->{success}/$json->{failure}"); 75 | } 76 | } 77 | ); 78 | }); 79 | 80 | $client->on(all_event => sub{ 81 | my($client,$event,@args) =@_; 82 | my $type = 'Mojo-Sys'; 83 | my $message; 84 | my $msgId = 1; 85 | my $title; 86 | if($event eq 'login'){ 87 | $message = "登录成功"; 88 | $title = "登录事件"; 89 | } 90 | elsif($event eq 'input_qrcode'){ 91 | $message = $client->qrcode_upload_url // '获取二维码url失败'; 92 | $title = "扫描二维码事件"; 93 | } 94 | elsif($event eq 'stop'){ 95 | $message = "Mojo-Webqq已停止"; 96 | $title = "停止事件"; 97 | } 98 | else{return} 99 | 100 | my $messageJson = '{"content":"{\"type\":\"'.$type.'\",\"title\":\"'.$title.'\",\"message\":\"'.$message.'\",\"msgId\":\"'.$msgId.'\"}"}'; 101 | 102 | $client->http_post($api_url, 103 | { 104 | blocking=>1, 105 | json=>1, 106 | ua_connect_timeout=>5, 107 | ua_request_timeout=>5, 108 | ua_inactivity_timeout=>5, 109 | ua_retry_times=>1 110 | }, 111 | form=>{ 112 | 113 | appId => $app_id, 114 | pushIds => $registration_id, 115 | messageJson=>$messageJson, 116 | sign => md5_sum("appId=".$app_id."messageJson=".$messageJson."pushIds=".$registration_id.$api_key), 117 | 118 | }, 119 | sub{ 120 | my $json = shift; 121 | if(not defined $json){ 122 | $client->debug("[".__PACKAGE__."]魅族消息推送失败: 返回结果异常"); 123 | return; 124 | } 125 | else{ 126 | $client->debug("[".__PACKAGE__."]魅族消息推送完成：$json->{multicast_id}/$json->{success}/$json->{failure}"); 127 | } 128 | } 129 | ); 130 | }); 131 | } 132 | 1; 133 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/FuckAndroid.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::FuckAndroid; 2 | our $PRIORITY = 1; 3 | 4 | my @reply = ( 5 | "别在我面前提 %,ok?", 6 | "% 死全家，赶紧死...", 7 | "%，%，%，%..赶紧在地球上消失...", 8 | "% 就是个傻叉!!", 9 | "一提 % 就烦!!" 10 | ); 11 | sub call { 12 | my $client = shift; 13 | $client->on(receive_message=>sub{ 14 | my($client,$msg)=@_; 15 | return if not $msg->allow_plugin; 16 | return if $msg->content !~ /(安卓|android|google|谷歌|三星)/i; 17 | my $key_word = $1;$key_word=~s/\s+//; 18 | my $reply = $reply[int rand($#reply+1)]; 19 | $reply=~s/%/$key_word/g; 20 | $client->reply_message($msg,$reply,sub{$_[1]->from("bot")}) if $reply; 21 | }); 22 | } 23 | 1; 24 | 25 | __END__ 26 | 那天帮我老妈Android刷机，因为系统自动从4.4升级到5.0之后，手机一直发热 充电满了几个小时就没电了 27 | 刷完rom之后开机启动最后一步一定要输入三星的帐号和密码 28 | 输入法只有“语音输入”，要对着话筒讲话，再翻译成文字，不知道哪个sb搞的 29 | 没办法只能对着说，但提示连接不上google的服务，无法识别语音，然后也没办法添加其他键盘输入方式 30 | 然后就一直困在这里了，无法跳过去，大晚上的 老妈明天就要用，现在手机变成砖头，真是心急如麻 31 | 最后我苦思冥想了好几个小时 心里无数个草泥马 狂骂三星工程师或者rom制作者是一群傻逼 32 | 然后我发现 这款手机配置了一款手写笔，然后用手写板在输入框里点一下 终于可以手写输入了 33 | 注册个新的三星帐号，赶紧用手写笔输入帐号，但是当要在密码框里输入密码的时候，手写居然不支持…… ……支持……持……草泥马 34 | 输入帐号了，但是没办法输入密码 这怎么办，然后我又苦思冥想 各种百度 最后发现 先在可以输入的地方把密码输入好 35 | 然后再选择复制，然后再粘帖到密码框里 ，大晚上搞到了不知道几点，Android、三星、谷歌 我真是服了这群人了 36 | 这辈子都不想再碰Android手机了，被深深恶心到了，我觉得这是在挑战我作为地球高级智慧生物的底线 37 | 安装个应用还tm一堆乱七八糟的权限要确认，用装机助手刷个rom还tm一定要把我给root，装的rom没一个是纯净的 38 | 应用管理器里都卸载了，根本看不到的应用，在屏幕上还可以看到图标 点击还可以运行，都不知道算怎么回事 39 | 设置菜单里各种莫名其妙的名称 看都看不懂，三星、谷歌这帮工程师真是够差 40 | 设计出来的东西完全不是站在用户的角度去想 41 | 三星，谷歌，Android死全家，求转发 42 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/FuckDaShen.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::FuckDaShen; 2 | $Mojo::Webqq::Plugin::FuckDaShen::PRIORITY = 1; 3 | 4 | my @reply = ( 5 | "动不动就叫%...", 6 | "%能不能换点别的称呼...", 7 | "%，%，%，%..喜欢你就叫个够...", 8 | "请问%是指哪位?", 9 | "能不能别随随便便就叫%?" 10 | ); 11 | sub call { 12 | my $client = shift; 13 | $client->on(receive_message=>sub{ 14 | my($client,$msg)=@_; 15 | return if not $msg->allow_plugin; 16 | return if $msg->content !~ /(大\s*神|大\s*婶|大\s*侠)/; 17 | my $key_word = $1;$key_word=~s/\s+//; 18 | my $reply = $reply[int rand($#reply+1)]; 19 | $reply=~s/%/$key_word/g; 20 | $client->reply_message($msg,$reply,sub{$_[1]->from("bot")}) if $reply; 21 | }); 22 | } 23 | 1; 24 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/GasPrice.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::GasPrice; 2 | use strict; 3 | use POSIX qw(strftime); 4 | use Mojo::Util qw(url_escape); 5 | use List::Util qw(first); 6 | our $PRIORITY = 91; 7 | my $API = 'http://apis.baidu.com/showapi_open_bus/oil_price/find?prov='; 8 | 9 | sub call{ 10 | #获取qqClient 11 | my $client = shift; 12 | #获取加载该插件时候传入的参数数组 13 | my $data = shift; 14 | 15 | #如果参数有传是否需要@才进行回复，如果么有，则默认需要@才回复 16 | my $is_need_at = defined $data->{is_need_at} ? $data->{is_need_at}:0; 17 | my $key_word = defined $data->{command} ? $data->{command}:'油价'; 18 | my $msg_tail = defined $data->{msg_tail} ? $data->{msg_tail}:''; 19 | 20 | my $callBack = sub{ 21 | my($client,$msg)=@_; 22 | 23 | #如果消息中设定不允许插件处理，则直接返回 24 | return if( not $msg->allow_plugin ); 25 | #只处理 好友消息|群消息|临时消息 26 | return if( $msg->type !~ /^message|group_message|sess_message$/ ); 27 | #如果设置了需要@ 且消息类型是群消息，则判断消息中是否有@，如果没有则直接返回 28 | return if( $is_need_at and $msg->type eq "group_message" and !$msg->is_at ); 29 | 30 | #或者发送者和接受者的昵称 31 | my $sender_nick = $msg->sender->displayname; 32 | my $user_nick = $msg->receiver->displayname; 33 | 34 | #如果是群消息，则判断是否有设置禁止群和允许群（设置是由load插件的时候传入的参数设置） 35 | if($msg->type eq 'group_message'){ 36 | return if( ref $data->{ban_group} eq "ARRAY" and first { $_ =~ /^\d+$/ ? $msg->group->uid eq $_ : $msg->group->name eq $_} @{$data->{ban_group}} ); 37 | return if( ref $data->{allow_group} eq "ARRAY" and !first { $_ =~ /^\d+$/ ? $msg->group->uid eq $_ : $msg->group->name eq $_} @{$data->{allow_group}} ); 38 | } 39 | 40 | #获取接受消息的内容 41 | my $input = $msg->content; 42 | #把前面的@昵称去掉 43 | $input=~s/\@\Q$user_nick\E ?|\[[^\[\]]+\]\x01|\[[^\[\]]+\]//g; 44 | #如果去掉昵称后，收到的消息内容为空，则不用处理，直接返回 45 | return unless $input; 46 | my @ARGVS = split(/\s+/,$input); 47 | 48 | #这里设置需要获取的关键字，如果得到的不是所需关键字，则不处理，直接返回 49 | return if($ARGVS[0] ne $key_word); 50 | #如果匹配了关键字，即属于该插件处理的消息，设置该消息不允许其他插件处理 51 | $msg->allow_plugin(0); 52 | 53 | my $prov = $ARGVS[1] ? url_escape($ARGVS[1]) : url_escape("广东"); 54 | 55 | my $headers = { 56 | apikey => '4febc94b54b90f8cc8090af772c25a21',#api key 57 | json => 1, 58 | }; 59 | 60 | #使用http_get从API获取所需信息 61 | $client->http_get($API.$prov,$headers,sub{ 62 | my $json = shift; 63 | return unless defined $json; 64 | my $resultArray = $json->{showapi_res_body}->{list}; 65 | return if scalar(@$resultArray) <= 0 ; 66 | my $ct = $resultArray->[0]->{ct}; 67 | my $p0 = $resultArray->[0]->{p0}; 68 | my $p90 =$resultArray->[0]->{p90}; 69 | my $p93 = $resultArray->[0]->{p93}; 70 | my $p97 = $resultArray->[0]->{p97}; 71 | my $prov = $resultArray->[0]->{prov}; 72 | my $reply = "您好！".$prov."的油价情况如下:\n\t发布时间:".$ct."\n\t" 73 | . "0#:".$p0."\n\t" 74 | . "90#:".$p90."\n\t" 75 | . "93#:".$p93."\n\t" 76 | . "97#:".$p97; 77 | $reply = "\@$sender_nick " . $reply if $msg->type eq 'group_message'; 78 | $client->reply_message($msg,$reply,sub{ 79 | my($client,$msg) = @_; 80 | my $content = $msg->content; 81 | $content .= $msg_tail; 82 | $msg->content($content); 83 | $msg->from("bot");}) if $reply; 84 | }); 85 | }; 86 | $client->on(receive_message=>$callBack); 87 | } 88 | 1; 89 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/IPwhere.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::IPwhere; 2 | our $PRIORITY = 1; 3 | use IP::IPwhere; 4 | #use IP::QQWry; #使用纯真库注释掉本行 5 | use Encode; 6 | 7 | =pod 8 | 9 | 插件使用方法给加载插件的账号发 IPwhere IP 10 | 或者QQ群里发IPwhere IP. 11 | 12 | 例子： 13 | 14 | IPwhere 166.111.166.100 15 | 16 | result ： 17 | 18 | taobao 166.111.166.100:中国,北京市,北京市,教育网 19 | sina 166.111.166.100:中国,北京,北京, 20 | baidu 166.111.166.100:北京市海淀区 教育网 21 | pconline 166.111.166.100:北京市,北京市,,北京市 教育网 22 | qqwry 166.111.166.100:清华大学学生宿舍14号楼 23 | 24 | 25 | 本插件需要安装模块IP::IPwhere，如果你需要纯真的信息 26 | 还要安装IP::QQWry，以及下载纯真的数据库QQWry.Dat 27 | 下载地址: 28 | 29 | https://github.com/bollwarm/ipwhere/blob/master/QQWry.Dat 30 | 31 | oschina同步更新，如果github太慢通过osc下载 32 | 33 | https://git.oschina.net/ijz/ipwhere/raw/master/QQWry.Dat 34 | 安装库可以简单通过cpanm IP::IPwhere IP::QQWry 35 | 36 | 并把下面部分注释掉。 37 | 38 | my $qqwry = IP::QQWry->new('QQWry.Dat'); 39 | 40 | sub gquery { 41 | 42 | my ($ip)=shift; 43 | my ($base,$info) = $qqwry->query($ip); 44 | my $result; 45 | $result="qqwry $ip:"; 46 | $result.=decode('gbk',$base); 47 | $result.=decode('gbk',$info)."\n"; 48 | return $result; 49 | 50 | } 51 | =cut 52 | 53 | my $re=qr([0-9]|[0-9][0-9]|1[0-9][0-9]|2[0-4][0-9]|25[0-5]); 54 | my $ipre=qr/($re\.){3}$re$/; 55 | 56 | sub call { 57 | my $client = shift; 58 | $client->on(receive_message=>sub{ 59 | my($client,$msg)=@_; 60 | return if not $msg->allow_plugin; 61 | return if $msg->content !~ /^(ipwhere|IPwhere)\s*($ipre)/; 62 | my $arg= $1 if $msg->content=~ /^(ipwhere|IPwhere)\s*($ipre)/; 63 | $reply= Encode::encode("utf8",squery($arg)); 64 | # $reply.=Encode::encode("utf8",gquery($arg)); # 如果需要解析纯真数据库，吧本行注释去掉 65 | $msg->reply($reply,sub{$_[1]->from("bot")}) if $reply; 66 | }); 67 | } 68 | 1; 69 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/MobileInfo.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::MobileInfo; 2 | our $PRIORITY = 93; 3 | use Mojo::DOM; 4 | use Encode; 5 | 6 | sub call{ 7 | my $client = shift; 8 | my $data = shift; 9 | my $callback = sub{ 10 | my($client,$msg)=@_; 11 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 12 | if ($msg->content =~ m/^手机\s+([0-9]{7,11})/g) { 13 | my $phone = $1; 14 | return unless $phone; 15 | $msg->allow_plugin(0); 16 | my $reply; 17 | my $sender_nick = $msg->sender->displayname; 18 | $client->http_get("http://www.ip138.com:8080/search.asp?mobile=$phone&action=mobile",sub{ 19 | my $data = shift; 20 | return unless defined $data; 21 | $data =~ s/ //g; 22 | my $dom = Mojo::DOM->new($data); 23 | my @commands = $dom->find('td.tdc2')->each;#获取所有的子命令 24 | #$client->debug(encode('utf8',decode('gbk',join(" ",@commands)))); 25 | if (scalar(@commands) == 5) { 26 | $reply .= "\@$sender_nick 您查询的手机号码信息如下:\n"; 27 | $reply .= "手机号: ".(shift @commands)->text."\n"; 28 | $reply .= "归属地: ".encode("utf8",decode("gbk",(shift @commands)->text))."\n"; 29 | $reply .= "卡类型: ".encode("utf8",decode("gbk",(shift @commands)->text))."\n"; 30 | $reply .= "区 号: ".(shift @commands)->text."\n"; 31 | $reply .= "邮 编: ".(shift @commands)->text; 32 | } 33 | unless ($reply) { 34 | return; 35 | } 36 | $client->reply_message($msg,$reply); 37 | }); 38 | } 39 | }; 40 | $client->on(receive_message=>$callback,send_message=>$callback); 41 | } 42 | 1; 43 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Perlcode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Perlcode; 2 | our $PRIORITY = 97; 3 | use File::Temp qw/tempfile/; 4 | use File::Path qw/mkpath rmtree/; 5 | use POSIX qw(strftime); 6 | use Term::ANSIColor; 7 | use Storable; 8 | BEGIN{ 9 | Storable::nfreeze({}); #这一句是为了 提前加载 auto/Storable/nfreeze.al 防止chroot后再加载导致报错 10 | eval{require BSD::Resource}; 11 | our $is_hold_bsd_resource = 1 unless $@; 12 | } 13 | sub call{ 14 | my $client = shift; 15 | $client->die(__PACKAGE__ . "只能运行在linux系统上") if $^O !~ /linux/; 16 | $client->die(__PACKAGE__ . "依赖BSD::Resource模块，请先安装该模块") if !$is_hold_bsd_resource; 17 | my $callback = sub{ 18 | my($client,$msg) = @_; 19 | return if not $msg->allow_plugin; 20 | my $content = $msg->content; $content=~s/＞/>/g; 21 | if($content=~/^(?:>>>)(.*?)(?:__END__|$)/s or $content =~/perl\s+-e\s+'([^']+)'/s){ 22 | $msg->allow_plugin(0); 23 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 24 | my $doc = ''; 25 | my $code = $1; 26 | $code=~s/^\s+|\s+$//g; 27 | $code=~s/CORE:://g; 28 | $code=~s/CORE::GLOBAL:://g; 29 | return unless $code; 30 | $code=~s/(\n^__DATA__\s*?\n(.*?))(?:^__[A-Z]+__|\z)//gms; 31 | my $__data__ = $2; 32 | if(defined $__data__){ 33 | unless(open(Mojo::Webqq::Plugin::Perlcode::Sandbox::DATA ,"<",\$__data__)){ 34 | $client->warn("处理__DATA__出现异常: $!"); 35 | return 36 | } 37 | } 38 | $code = q#package Mojo::Webqq::Plugin::Perlcode::Sandbox;use feature qw(say);local $|=1;BEGIN{$^W=0;use File::Path;use BSD::Resource;setrlimit(RLIMIT_NOFILE,100,100);setrlimit(RLIMIT_CPU,8,8);setrlimit(RLIMIT_FSIZE,1024,1024);setrlimit(RLIMIT_NPROC,5,5);setrlimit(RLIMIT_STACK,1024*1024*10,1024*1024*10);setrlimit(RLIMIT_DATA,1024*1024*10,1024*1024*10);*CORE::GLOBAL::fork=sub{};}$|=1;{my($u,$g)=((getpwnam("nobody"))[2],(getgrnam("nobody"))[2]);mkpath('/tmp/webqq/bin/',{owner=>$u,group=>$g,mode=>0555}) unless -e '/tmp/webqq/bin';chdir '/tmp/webqq/bin' or die $!;chroot '/tmp/webqq/bin' or die "chroot fail: $!";chdir "/";($(, $))=($g,"$g $g");($<,$>)=($u,$u);}local %ENV=();# . $code; 39 | my ($stdout_buf,$stderr_buf,$is_stdout_cut,$is_stderr_cut); 40 | my $run;$run = $client->spawn( 41 | cmd =>sub{eval $code;print STDERR $@ if $@;}, 42 | exec_timeout => 3, 43 | stdout_cb => sub { 44 | my ($pid, $chunk) = @_; 45 | $stdout_buf.=$chunk if defined $chunk; 46 | if(count_lines($stdout_buf) > 8){ 47 | $run->kill($pid); 48 | $stdout_buf = join "\n",(split /\r?\n/,$stdout_buf,11)[0..9]; 49 | $stdout_buf .= "(已截断)"; 50 | } 51 | elsif(length($stdout_buf) > 200){ 52 | $run->kill($pid); 53 | $stdout_buf = substr($stdout_buf,0,200); 54 | $stdout_buf .= "(已截断)"; 55 | } 56 | }, 57 | stderr_cb => sub { 58 | my ($pid, $chunk) = @_; 59 | $stderr_buf.=$chunk if defined $chunk; 60 | if(count_lines($stderr_buf) > 8){ 61 | $run->kill($pid); 62 | $stderr_buf = join "\n",(split /\r?\n/,$stderr_buf,11)[0..9]; 63 | $stderr_buf .= "(已截断)"; 64 | } 65 | elsif(length($stderr_buf) > 350){ 66 | $run->kill($pid); 67 | $stderr_buf = substr($stderr_buf,0,500); 68 | $stderr_buf .= "(已截断)"; 69 | } 70 | }, 71 | exit_cb => sub { 72 | my($pid,$res)=@_; 73 | my $content; 74 | if(defined $stderr_buf){ 75 | $stderr_buf =~s/(?<=at )\(eval .+?\)(?= line)/CODE/g; 76 | $stderr_buf =~s/Mojo::Webqq::Plugin::Perlcode::Sandbox:://g; 77 | } 78 | $stderr_buf.= "(执行超时)" if $res->{is_timeout}; 79 | eval{ 80 | $stderr_buf = Term::ANSIColor::colorstrip($stderr_buf) if defined $stderr_buf; 81 | $stdout_buf = Term::ANSIColor::colorstrip($stdout_buf) if defined $stdout_buf; 82 | }; 83 | if(defined $stdout_buf and $stderr_buf){ 84 | if($stdout_buf=~/\n$/){$content = $stdout_buf.$stderr_buf} 85 | else{$content = $stdout_buf."\n".$stderr_buf} 86 | } 87 | elsif(defined $stdout_buf){$content=$stdout_buf} 88 | elsif(defined $stderr_buf){$content=$stderr_buf} 89 | $content = "代码打印内容为空" if ( !defined $content or $content eq ""); 90 | $client->reply_message($msg,$content); 91 | }, 92 | ); 93 | } 94 | }; 95 | $client->on(receive_message=>$callback); 96 | $client->on(send_message=>$callback); 97 | } 98 | 99 | sub count_lines{ 100 | my $data = shift; 101 | my $count =()=$data=~/\r?\n/g; 102 | return $count++; 103 | } 104 | 105 | 1; 106 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Perldoc.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Perldoc; 2 | our $PRIORITY = 96; 3 | use Pod::Perldoc; 4 | use Term::ANSIColor; 5 | use Mojo::Webqq::Cache; 6 | my $metacpan_module_api = 'http://api.metacpan.org/v0/module/'; 7 | my $metacpan_pod_api = 'http://api.metacpan.org/v0/pod/'; 8 | my $metacpan_cache = Mojo::Webqq::Cache->new; 9 | sub call{ 10 | my $client = shift; 11 | my $data = shift; 12 | my $callback = sub{ 13 | my($client,$msg)=@_; 14 | return if not $msg->allow_plugin; 15 | if($msg->content =~ /perldoc\s+-(v|f)\s+([^ ]+)/){ 16 | $msg->allow_plugin(0); 17 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 18 | my($p,$v) = ("-$1",$2); 19 | $client->spawn( 20 | cmd =>sub{ 21 | local @ARGV=($p,$v); 22 | require 5; 23 | exit(Pod::Perldoc->run()); 24 | }, 25 | exec_timeout => 5, 26 | exit_cb => sub { 27 | my($pid,$res)=@_; 28 | my $reply; 29 | if($res->{exit_status}==0){ 30 | $reply = $client->truncate($res->{stdout},max_lines=>8,max_bytes=>2000); 31 | $reply .= "\n查看更多内容: http://perldoc.perl.org/functions/$v.html" if $p eq "-f"; 32 | $reply .= "\n查看更多内容: http://perldoc.perl.org/perlvar.html" if $p eq "-v"; 33 | } 34 | elsif($res->{stderr}=~/exec of coderef failed: (.+?)\s*at /){ 35 | $reply = $1; 36 | $reply .= "\n查看更多内容: http://perldoc.perl.org/index-functions.html" if $p eq "-f"; 37 | $reply .= "\n查看更多内容: http://perldoc.perl.org/perlvar.html" if $p eq "-v"; 38 | } 39 | eval{$reply = Term::ANSIColor::colorstrip($reply);}; 40 | $client->reply_message($msg,$reply) if $reply; 41 | }, 42 | ); 43 | } 44 | elsif($msg->content =~ /perldoc\s+((\w+::)*\w+)/){ 45 | $msg->allow_plugin(0); 46 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 47 | my $module = $1; 48 | my $cache = $metacpan_cache->retrieve($module); 49 | if(defined $cache){ 50 | $client->reply_message($msg,$cache->{doc}); 51 | return; 52 | } 53 | $client->http_get($metacpan_module_api . $module,{json=>1},sub{ 54 | my $json = shift; 55 | return unless defined $json; 56 | my $doc; 57 | my $code; 58 | if(defined $json->{code} and $json->{code} == 404){ 59 | $doc = "模块名称: $module ($json->{message})" ; 60 | $code = 404; 61 | $metacpan_cache->store($module,{code=>$code,doc=>$doc},604800); 62 | $client->reply_message($msg,$doc); 63 | } 64 | else{ 65 | $code = 200; 66 | my $author = $json->{author}; 67 | my $version = $json->{version}; 68 | my $abstract= $json->{abstract}; 69 | my $podlink = 'https://metacpan.org/pod/' . $module; 70 | $doc = 71 | "模块: $module\n" . 72 | "版本: $version\n" . 73 | "作者: $author\n" . 74 | "简述: $abstract\n" . 75 | "链接: $podlink\n" 76 | ; 77 | $client->http_get($metacpan_pod_api . $module,{Accept=>"text/plain"},sub{ 78 | my $data = shift; 79 | return unless defined $data; 80 | my ($SYNOPSIS) = $data=~/^SYNOPSIS$(.*?)^[A-Za-z]+$/ms; 81 | if($SYNOPSIS){ 82 | $doc .= "用法概要: $SYNOPSIS\n" ; 83 | $doc=~s/\n+$//; 84 | $doc = $client->truncate($doc,max_bytes=>1000,max_lines=>8); 85 | } 86 | $metacpan_cache->store($module,{code=>$code,doc=>$doc},604800); 87 | $client->reply_message($msg,$doc); 88 | }); 89 | } 90 | }); 91 | } 92 | }; 93 | $client->on(receive_message=>$callback); 94 | $client->on(send_message=>$callback); 95 | } 96 | 1; 97 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/PostImgVerifycode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::PostImgVerifycode; 2 | our $PRIORITY = 0; 3 | our $CALL_ON_LOAD = 1; 4 | use MIME::Base64; 5 | BEGIN{ 6 | our $has_mime_lite = 0; 7 | eval{require MIME::Lite;}; 8 | $has_mime_lite = 1 if not $@; 9 | } 10 | sub call { 11 | my $client = shift; 12 | my $data = shift; 13 | $client->die("插件[". __PACKAGE__ ."]依赖模块 MIME::Lite，请先确认该模块已经正确安装") if not $has_mime_lite; 14 | $client->on(input_img_verifycode=>sub{ 15 | my($client,$filename) = @_; 16 | $client->die("插件[".__PACKAGE__."]必须设置提交验证码本机地址") unless defined $data->{post_host}; 17 | $data->{post_port} = "3000" unless defined $data->{post_port}; 18 | my $subject = $data->{subject} || "QQ帐号 " . $client->uid . " 登录验证码"; 19 | my $mime = MIME::Lite->new( 20 | Type => 'multipart/mixed', 21 | From => $data->{from}, 22 | To => $data->{to}, 23 | ); 24 | $mime->add("Subject"=>"=?UTF-8?B?" . MIME::Base64::encode_base64($subject,"") . "?="); 25 | $mime->attach( 26 | Type =>'TEXT', 27 | Data =>"请点击以下链接输入验证码: http://$data->{post_host}:$data->{post_port}/check_code" 28 | ); 29 | $mime->attach( 30 | Path => $filename, 31 | Disposition => 'attachment', 32 | Type => 'image/jpeg', 33 | ); 34 | my ($is_success,$err) = $client->mail( 35 | smtp=>$data->{smtp}, 36 | port=>$data->{port}, 37 | user=>$data->{user}, 38 | pass=>$data->{pass}, 39 | from=>$data->{from}, 40 | to =>$data->{to}, 41 | subject=>$subject, 42 | data=>$mime->as_string, 43 | ); 44 | if(not $is_success){ 45 | $client->error("插件[".__PACKAGE__."]邮件发送失败: $err"); 46 | return; 47 | } 48 | package Mojo::Webqq::Plugin::PostImgVerifycode::App; 49 | use Encode; 50 | use Mojolicious::Lite; 51 | use File::Basename qw(basename); 52 | my $img_path = basename($filename); 53 | my $img_data = ''; 54 | open my $img_handle,$filename or die $!; 55 | while((read $img_handle,my $buf,4096)!=0){ 56 | $img_data .= $buf; 57 | } 58 | close $img_handle; 59 | get '/check_code' => sub{ 60 | my $template = <<"TEMPLATE"; 61 | 62 | 63 | 64 | 65 | 66 |
67 |
68 | 验证码： 69 | 70 | 71 |
72 | 73 | 74 | TEMPLATE 75 | $_[0]->render(text => $template); 76 | }; 77 | get "/$img_path" => sub{$_[0]->render(data=>$img_data,format=>'image/jpg')}; 78 | get '/post_code' => sub{ 79 | my $code=$_[0]->param("code") || ""; $client->verifycode($code) if defined $code; 80 | $_[0]->render(text => "您的验证码已经提交: $code"); 81 | $client->debug(encode("utf8","插件[Mojo::Webqq::Plugin::PostImgVerifycode]获取到登录验证码为: $code")); 82 | }; 83 | package Mojo::Webqq::Plugin::PostImgVerifycode; 84 | use Mojo::IOLoop; 85 | use Mojo::Webqq::Server; 86 | my $server = Mojo::Webqq::Server->new(ioloop=>Mojo::IOLoop->new); 87 | $server->app($server->build_app("Mojo::Webqq::Plugin::PostImgVerifycode::App")); 88 | $server->app->secrets("hello world"); 89 | $server->app->log($client->log); 90 | $server->app->hook(after_render => sub { 91 | my ($c, $output, $format) = @_; 92 | if($c->req->url->path eq '/post_code'){ 93 | $server->stop; 94 | $server->ioloop->stop; 95 | undef $server; 96 | } 97 | }); 98 | #$server->listen([{host=>$data->{post_host},port=>$data->{post_port}}]); 99 | $server->listen(["http://$data->{post_host}:$data->{post_port}" ,]); 100 | $server->run; 101 | }); 102 | } 103 | 1; 104 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/PostQRcode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::PostQRcode; 2 | our $PRIORITY = 0; 3 | our $CALL_ON_LOAD = 1; 4 | use MIME::Base64; 5 | BEGIN{ 6 | our $has_mime_lite = 0; 7 | eval{require MIME::Lite;}; 8 | $has_mime_lite = 1 if not $@; 9 | } 10 | sub call{ 11 | my $client = shift; 12 | my $data = shift; 13 | $client->die("插件[". __PACKAGE__ ."]依赖模块 MIME::Lite，请先确认该模块已经正确安装") if not $has_mime_lite; 14 | $data->{max} = 10 if not defined $data->{max}; 15 | #$data->{charset} = "UTF-8" if not defined $data->{charset}; 16 | my $count = 0; 17 | $client->on(login=>sub{$count = 0}); 18 | $client->on(input_qrcode=>sub{ 19 | my($client,$filename) = @_; 20 | if($count > $data->{max}){ 21 | $client->fatal("等待扫描二维码超时"); 22 | $client->stop(); 23 | return 24 | } 25 | $data->{subject} = "QQ帐号" . (defined $client->uid?$client->uid:$client->account) . "扫描二维码" if not defined $data->{subject}; 26 | my $mime = MIME::Lite->new( 27 | Type => 'multipart/mixed', 28 | From => $data->{from}, 29 | To => $data->{to}, 30 | ); 31 | $mime->add("Subject"=>"=?UTF-8?B?" . MIME::Base64::encode_base64($data->{subject},"") . "?="); 32 | $mime->attach( 33 | Type =>"text/plain; charset=UTF-8", 34 | Data =>"请使用手机QQ扫描附件中的二维码", 35 | ); 36 | $mime->attach( 37 | Path => $filename, 38 | Disposition => 'attachment', 39 | Type => 'image/png', 40 | ); 41 | $data->{data} = $mime->as_string; 42 | my($is_success,$err) = $client->mail(%$data); 43 | if(not $is_success){ 44 | if($data->{smtp} eq 'smtp.qq.com'){ 45 | $client->error("插件[".__PACKAGE__."]邮件发送失败: " . $client->encode("utf8",$client->decode("gbk",$err))); 46 | } 47 | else{ 48 | $client->error("插件[".__PACKAGE__."]邮件发送失败: $err"); 49 | } 50 | } 51 | else{ 52 | $client->info("登录二维码已经发送到邮箱: $data->{to}"); 53 | } 54 | $count++; 55 | }); 56 | } 57 | 1; 58 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/PostQRcodeToTelegram.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::PostQRcodeToTelegram; 2 | our $PRIORITY = 0; 3 | our $CALL_ON_LOAD = 1; 4 | 5 | my @qrcode_message_ids; 6 | sub call{ 7 | my $client = shift; 8 | my $data = shift; 9 | $client->on(input_qrcode=>sub{ 10 | my($client,$qrcode_path) = @_; 11 | # Generate Telegram Bot API URL 12 | my $telegram_api = 'https://api.telegram.org/bot' . $data->{api_key} .'/sendPhoto'; 13 | my $response = $client->http_post($telegram_api,{json=>1},form=>{ 14 | chat_id => $data->{chat_id}, 15 | caption => 'QQ帐号' .(defined $client->uid?$client->uid:$client->account) .'登录二维码', 16 | photo=>{file=>$qrcode_path} 17 | }); 18 | 19 | if(not defined $response){ 20 | $client->warn("插件[".__PACKAGE__ . "]发送登录二维码失败，响应数据异常"); 21 | return 22 | } 23 | 24 | if (not $response->{"ok"}) { 25 | $client->warn("插件[".__PACKAGE__ . "]发送登录二维码失败，错误原因：". $response->{"description"}); 26 | return 27 | } 28 | push @qrcode_message_ids, $response->{"result"}->{"message_id"}; 29 | my $chat = $response->{"result"}->{"chat"}; 30 | my $chat_type = $chat->{"type"}; 31 | # Check response types: private, group, supergroup or channel 32 | if ($chat_type eq "private") { 33 | $client->info("插件[".__PACKAGE__ . "]二维码已发送给Telegram用户[ ". $chat->{"username"} . " ]"); 34 | } 35 | elsif ($chat_type eq "group" or $chat_type eq "supergroup") { 36 | $client->info("插件[".__PACKAGE__ . "]二维码已发送至Telegram群组[ ". $chat->{"title"} . " ]"); 37 | } 38 | elsif ($chat_type eq "channel") { 39 | $client->info("插件[".__PACKAGE__ . "]二维码已发送至Telegram频道[ ". $chat->{"title"} . " ]"); 40 | } else { 41 | $client->info("插件[".__PACKAGE__ . "]二维码已发送，目标未知"); 42 | } 43 | }); 44 | $client->on(qrcode_expire=>sub{ 45 | my $last_id = $qrcode_message_ids[-1]; 46 | my $telegram_api = 'https://api.telegram.org/bot' . $data->{api_key}; 47 | my $response = $client->http_post($telegram_api . '/editMessageCaption',{json=>1},form=>{ 48 | chat_id => $data->{chat_id}, 49 | message_id => $last_id, 50 | caption => '二维码已过期', 51 | }); 52 | if(not defined $response){ 53 | $client->warn("插件[".__PACKAGE__ . "]提示二维码过期失败，响应数据异常"); 54 | return 55 | } 56 | 57 | if (not $response->{"ok"}) { 58 | $client->warn("插件[".__PACKAGE__ . "]提示二维码过期失败，错误原因：". $response->{"description"}); 59 | return 60 | } 61 | }); 62 | $client->on(login=>sub{ 63 | my $telegram_api = 'https://api.telegram.org/bot' . $data->{api_key}; 64 | foreach my $message_id (@qrcode_message_ids) { 65 | $client->http_post($telegram_api . '/deleteMessage',{json=>1},form=>{ 66 | chat_id => $data->{chat_id}, 67 | message_id => $message_id, 68 | }); 69 | } 70 | @qrcode_message_ids = (); 71 | $client->http_post($telegram_api . '/sendMessage',{json=>1},form=>{ 72 | chat_id => $data->{chat_id}, 73 | text => "登录成功", 74 | }); 75 | }); 76 | } 77 | 1; 78 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/ProgramCode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::ProgramCode; 2 | our $PRIORITY = 94; 3 | use Encode; 4 | =head1 SYNOPSIS 5 | Support 26 kinds of programming languages 6 | usage: 7 | code|cpp>>>...your program code... 8 | cpp 9 | code|cpp>>> 10 | #include 11 | using namespace std; 12 | int main() { 13 | cout << "Hello World!"; 14 | return 0; 15 | } 16 | c 17 | code|c>>> 18 | #include 19 | int main() { 20 | printf("Hello World!\n"); 21 | return 0; 22 | } 23 | csharp 24 | code|csharp>>> 25 | using System; 26 | class MainClass { 27 | static void Main() { 28 | Console.WriteLine("Hello World!"); 29 | } 30 | } 31 | d 32 | code|d>>> 33 | import std.stdio; 34 | void main() 35 | { 36 | writeln("Hello World!"); 37 | } 38 | erlang 39 | code|erlang>>> 40 | main(_) -> 41 | io:format("Hello World!~n"). 42 | go 43 | code|go>>> 44 | package main 45 | import ( 46 | "fmt" 47 | ) 48 | func main() { 49 | fmt.Println("Hello World!") 50 | } 51 | idris 52 | code|idris>>> 53 | module Main 54 | main : IO () 55 | main = putStrLn "Hello World!" 56 | java 57 | code|java>>> 58 | public class Main { 59 | public static void main(String[] args) { 60 | System.out.println("Hello World!"); 61 | } 62 | } 63 | scala 64 | code|scala>>> 65 | object Main extends App { 66 | println("Hello World!") 67 | } 68 | php 69 | code|php>>> 70 | >> 74 | fn main() { 75 | println!("Hello World!"); 76 | } 77 | assembly 78 | code|assembly>>> 79 | section .data 80 | msg db "Hello World!", 0ah 81 | section .text 82 | global _start 83 | _start: 84 | mov rax, 1 85 | mov rdi, 1 86 | mov rsi, msg 87 | mov rdx, 13 88 | syscall 89 | mov rax, 60 90 | mov rdi, 0 91 | syscall 92 | =cut 93 | my %languages = ( 94 | #code|ruby>>> 95 | ruby => 'main.rb',#code|ruby>>>puts "Hello World!" 96 | perl => 'main.pl',#code|perl>>>print "Hello World!\n"; 97 | clojure => 'main.clj',#code|clojure>>>(println "Hello World!") 98 | coffeescript => 'main.coffee',#code|coffeescript>>>console.log "Hello World!" 99 | bash => 'main.sh',#code|bash>>>echo Hello World 100 | cpp => 'main.cpp', 101 | c => 'main.c', 102 | assembly => 'main.asm', 103 | java => '.java', 104 | scala => "main.scala", 105 | csharp => 'main.cs', 106 | d => 'main.d', 107 | erlang => 'main.erl', 108 | go => 'main.go', 109 | idris => 'main.idr', 110 | rust => "main.rs", 111 | php => 'main.php', 112 | elixir => 'main.ex',#code|elixir>>>IO.puts "Hello World!" 113 | fsharp => 'main.fs',#code|fsharp>>>printfn "Hello World!" 114 | haskell => 'main.hs',#code|haskell>>>main = putStrLn "Hello World!" 115 | javascript => 'main.js',#code|javascript>>>console.log("Hello World!"); 116 | julia => 'main.jl',#code|julia>>>println("Hello world!") 117 | lua => 'main.lua',#code|lua>>>print("Hello World!"); 118 | nim => 'main.nim',#code|nim>>>echo("Hello World!") 119 | ocaml => 'main.ml',#code|ocaml>>>print_endline "Hello World!" 120 | python => "main.py",#code|python>>>print("Hello World!") 121 | ); 122 | sub call{ 123 | my $client = shift; 124 | my $data = shift; 125 | my $callback = sub{ 126 | my($client,$msg)=@_; 127 | if ($msg->content =~ m/^code\s*\|\s*([a-zA-z]+?)\s*>>>(.*)/s) { 128 | my $language = $1; 129 | my $code = $2; 130 | return if not $msg->allow_plugin; 131 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 132 | return if not exists $languages{$language}; 133 | return if not $code; 134 | $msg->allow_plugin(0); 135 | my $url = "https://glot.io/run/$language?version=latest"; 136 | my $filename = $languages{$language}; 137 | if ($language eq 'java') { 138 | $msg->{content} =~ m/class\s+([\w]+)/g; 139 | $filename = $1.$languages{$language}; 140 | } 141 | my %r = ( 142 | files => [{name=>$filename,content=>$code}], 143 | command => "", 144 | stdin => "", 145 | ); 146 | $client->http_post($url,{json => 1,Referer => "https://glot.io/run/$language?version=latest"},json=>\%r,sub{ 147 | my $json = shift; 148 | return unless defined $json; 149 | if ($json->{stdout}) { 150 | $client->reply_message($msg,"执行<$language>结果：---->\n".$json->{stdout}); 151 | }else{ 152 | $client->reply_message($msg,"执行<$language>出错：---->\n".$json->{stdout}."--->".$json->{error}."--->".$json->{stderr}); 153 | } 154 | }); 155 | } 156 | }; 157 | $client->on(receive_message=>$callback,send_message=>$callback); 158 | } 159 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Pu.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Pu; 2 | $Mojo::Webqq::Plugin::Pu::PRIORITY = 1; 3 | BEGIN{ 4 | eval{require ZHOUYI::ZhanPu}; 5 | our $is_hold_module = 1 unless $@; 6 | } 7 | use Mojo::Util qw(); 8 | sub call { 9 | my $client = shift; 10 | $client->die(__PACKAGE__ . '依赖ZHOUYI::ZhanPu模块，请先通过命令"cpanm ZHOUYI::ZhanPu"安装') if !$is_hold_module; 11 | $client->on(receive_message=>sub{ 12 | my($client,$msg)=@_; 13 | return if not $msg->allow_plugin; 14 | return if $msg->content !~ /(周\s*易|占\s*卜|八\s*卦|算\s*命)/; 15 | $msg->allow_plugin(0); 16 | my $reply; 17 | eval{$reply = Mojo::Util::encode("utf8",ZHOUYI::ZhanPu::pu()); }; 18 | $client->error( __PACKAGE__ . $@); 19 | $msg->reply($reply,sub{$_[1]->from("bot")}) if $reply; 20 | }); 21 | } 22 | 1; 23 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Qiandao.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Qiandao; 2 | use List::Util qw(first); 3 | sub call { 4 | my $client = shift; 5 | my $data = shift; 6 | my $callback = sub{ 7 | my @groups; 8 | if(ref $data->{allow_group} eq "ARRAY"){ 9 | for my $g ($client->groups){ 10 | next if !first {$_=~/^\d+$/?$g->uid eq $_:$g->name eq $_} @{$data->{allow_group}}; 11 | push @groups,$g; 12 | } 13 | } 14 | elsif(ref $data->{ban_group} eq "ARRAY"){ 15 | for my $g ($client->groups){ 16 | next if first {$_=~/^\d+$/?$g->uid eq $_:$g->name eq $_} @{$data->{ban_group}}; 17 | push @groups,$g; 18 | } 19 | } 20 | else{ 21 | for($client->groups){push @groups,$_;} 22 | } 23 | for(@groups){$_->qiandao()} 24 | }; 25 | $client->on(login=>$callback) if $data->{is_qiandao_on_login}; 26 | $client->add_job("Qiandao",$data->{qiandao_time} || "09:30",$callback); 27 | } 28 | 1; 29 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Riddle.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Riddle; 2 | our $PRIORITY = 92; 3 | use Encode; 4 | use List::Util qw(first); 5 | sub call{ 6 | my $client = shift; 7 | my $data = shift; 8 | my $flag = 0; 9 | my $command = $data->{command} || "猜谜"; 10 | $client->on(receive_message=>sub{ 11 | my($client,$msg) = @_; 12 | if($msg->type eq "group_message"){ 13 | return if ref $data->{ban_group} eq "ARRAY" and first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->name eq $_} @{$data->{ban_group}}; 14 | return if ref $data->{allow_group} eq "ARRAY" and !first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->name eq $_} @{$data->{allow_group}} 15 | } 16 | return if ref $data->{ban_user} eq "ARRAY" and first {$_=~/^\d+$/?$msg->sender->uid eq $_:$sender_nick eq $_} @{$data->{ban_user}}; 17 | 18 | if($flag == 0 and $msg->content eq $command){ 19 | $msg->allow_plugin(0); 20 | $client->steps( 21 | sub{ 22 | my $delay =shift; 23 | $client->http_get('http://apis.baidu.com/gushi/grid/p1',{json=>1,apikey=>$data->{apikey}||'20d7db97e337ffa35ae0838439c9db5d'},form=>{count=>1,fmt=>0},$delay->begin(0,1)); 24 | }, 25 | sub{ 26 | my $delay = shift; 27 | my $json = shift; 28 | return if not defined $json; 29 | return if $json->{status} != 0; 30 | my $id = $json->{data}[0]{id} if ref $json->{data} eq "ARRAY"; 31 | return if not $id; 32 | $client->http_get('http://apis.baidu.com/gushi/grid/p2',{json=>1,apikey=>$data->{apikey}||'20d7db97e337ffa35ae0838439c9db5d'},form=>{id=>$id,fmt=>0},sub{ 33 | my $json = shift; 34 | return if not defined $json; 35 | return if $json->{status} != 0; 36 | return if ref $json->{data} ne "ARRAY"; 37 | my $answer = $json->{data}[0]{body}; 38 | $flag = 1; 39 | $msg->reply("文曲星君题戏三界($json->{data}[0]{id}):\n" . $json->{data}[0]{title},sub{$_[1]->from("bot")}); 40 | 41 | $client->wait( 42 | $data->{timeout} || 30,#等待答案超时时间 43 | sub{#超时公布答案 44 | $flag = 0; 45 | $msg->reply("本题答案：$answer\n偌大的三界之中,难道就没有能懂本星君心意之人么.\n吾独徘徊于天地之间,对酒影成双,知己难求,呜呼哉!"); 46 | }, 47 | receive_message=>sub{#查看是否有人给出正确答案 48 | my($client,$msg,$timer_id) = @_; 49 | return if $msg->content !~ /\Q$answer\E/; 50 | $flag = 0; 51 | $msg->reply("于千万人之中,文曲星君终于找到了有缘人:\n恭喜 \@" . $msg->sender->displayname . " 回答正确"); return 1; 52 | } 53 | ); 54 | }); 55 | }, 56 | ); 57 | } 58 | }); 59 | } 60 | 1; 61 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/ShowMsg.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::ShowMsg; 2 | our $PRIORITY = 100; 3 | use POSIX qw(strftime); 4 | use List::Util qw(first); 5 | sub call{ 6 | my $client = shift; 7 | my $data = shift; 8 | $client->on( 9 | receive_message=>sub{ 10 | my($client,$msg)=@_; 11 | if($msg->type eq 'friend_message'){ 12 | my $sender_nick = $msg->sender->displayname; 13 | my $sender_category = $msg->sender->category || "好友"; 14 | #my $receiver_nick = $msg->receiver->nick; 15 | my $receiver_nick = "我"; 16 | $client->msg({time=>$msg->time,level_color=>'green',level=>"好友消息",title_color=>'green',title=>"$sender_nick|$sender_category :",content_color=>'green'},$msg->content); 17 | 18 | } 19 | elsif($msg->type eq 'group_message'){ 20 | my $gname = $msg->group->name; 21 | my $sender_nick = $msg->sender->displayname; 22 | return if ref $data->{ban_group} eq "ARRAY" and first {$_=~/^\d+$/?$msg->group->uid eq $_:$gname eq $_} @{$data->{ban_group}}; 23 | return if ref $data->{allow_group} eq "ARRAY" and !first {$_=~/^\d+$/?$msg->group->uid eq $_:$gname eq $_} @{$data->{allow_group}}; 24 | $client->msg({time=>$msg->time,level_color=>'cyan',level=>"群消息",title_color=>'cyan',title=>"$sender_nick|$gname :",content_color=>'cyan'},$msg->content); 25 | } 26 | elsif($msg->type eq 'discuss_message'){ 27 | my $dname = $msg->discuss->name; 28 | my $sender_nick = $msg->sender->displayname; 29 | $client->msg({time=>$msg->time,level_color=>'magenta',level=>"讨论组消息",title_color=>'magenta',title=>"$sender_nick|$dname :",content_color=>'magenta'},$msg->content); 30 | } 31 | elsif($msg->type eq 'sess_message'){ 32 | my $sender_nick; 33 | my $receiver_nick = "我"; 34 | my $gname; 35 | my $dname; 36 | if($msg->via eq "group"){ 37 | $sender_nick = $msg->sender->displayname; 38 | $gname = $msg->group->name; 39 | $client->msg({time=>$msg->time,level_color=>'green',level=>"群临时消息",title_color=>'green',title=>"$sender_nick|$gname :",content_color=>'green'},$msg->content); 40 | } 41 | elsif($msg->via eq "discuss"){ 42 | $sender_nick = $msg->sender->displayname; 43 | $dname = $msg->discuss->name; 44 | $client->msg({time=>$msg->time,level_color=>'green',level=>"讨论组临时消息",title_color=>'green',title=>"$sender_nick|$dname :",content_color=>'green'},$msg->content); 45 | } 46 | } 47 | }, 48 | send_message=>sub{ 49 | my($client,$msg)=@_; 50 | my $attach = ''; 51 | if($msg->is_success){ 52 | if($client->log_level eq 'debug' and defined $msg->info and $msg->info ne "发送正常" ){ 53 | $attach = "[" . $msg->info . "]"; 54 | } 55 | } 56 | else{ 57 | $attach = "[发送失败".(defined $msg->info?"(".$msg->info.")":"") . "]"; 58 | } 59 | if($msg->type eq 'friend_message'){ 60 | my $sender_nick = "我"; 61 | my $receiver_nick = $msg->receiver->displayname; 62 | $client->msg({time=>$msg->time,level_color=>'green',level=>"好友消息",title_color=>'green',title=>"$sender_nick->$receiver_nick :",content_color=>'green'},$msg->content . $attach); 63 | } 64 | elsif($msg->type eq 'group_message'){ 65 | my $gname = $msg->group->name; 66 | my $sender_nick = "我"; 67 | $client->msg({time=>$msg->time,level_color=>'cyan',level=>"群消息",title_color=>'cyan',title=>"$sender_nick->$gname :",content_color=>'cyan'},$msg->content . $attach); 68 | } 69 | elsif($msg->type eq 'discuss_message'){ 70 | my $dname = $msg->discuss->name; 71 | my $sender_nick = "我"; 72 | $client->msg({time=>$msg->time,level_color=>'magenta',level=>"讨论组消息",title_color=>'magenta',title=>"$sender_nick->$dname :",content_color=>'magenta'},$msg->content . $attach); 73 | } 74 | elsif($msg->type eq 'sess_message'){ 75 | my $sender_nick = "我"; 76 | my $receiver_nick; 77 | my $gname; 78 | my $dname; 79 | if($msg->via eq "group"){ 80 | $receiver_nick = $msg->receiver->displayname; 81 | $gname = $msg->group->name; 82 | $client->msg({time=>$msg->time,level_color=>'green',level=>"群临时消息",title_color=>'green',title=>"$sender_nick->$receiver_nick|$gname :",content_color=>'green'},$msg->content . $attach); 83 | } 84 | elsif($msg->via eq "discuss"){ 85 | $receiver_nick = $msg->receiver->displayname; 86 | $dname = $msg->discuss->name; 87 | $client->msg({time=>$msg->time,level_color=>'green',level=>"讨论组临时消息",title_color=>'green',title=>"$sender_nick->$receiver_nick|$dname :",content_color=>'green'},$msg->content . $attach); 88 | } 89 | } 90 | } 91 | ); 92 | } 93 | 94 | 1; 95 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/ShowQRcode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::ShowQRcode; 2 | our $PRIORITY = 0; 3 | our $CALL_ON_LOAD=1; 4 | 5 | sub call 6 | { 7 | my $client = shift; 8 | $client->on(input_qrcode=>sub 9 | { 10 | my($client,$qrcode_path) = @_; 11 | my $command; 12 | if($^O=~/^MSWin32/i) # Windows 13 | { 14 | $command="start $qrcode_path"; 15 | eval(system($command)); 16 | $client->error($@) if $@; 17 | } 18 | elsif($^O=~/^linux/i) # Linux 19 | { 20 | $command="xdg-open $qrcode_path"; 21 | eval(system($command)); 22 | $client->error($@) if $@; 23 | } 24 | elsif($^O=~/^darwin/i) # Mac OS X 25 | { 26 | $command="open $qrcode_path"; 27 | eval(system($command)); 28 | $client->error($@) if $@; 29 | } 30 | } 31 | ); 32 | } 33 | 34 | 35 | 1; 36 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/SmartReply.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::SmartReply; 2 | use POSIX qw(strftime); 3 | use Encode; 4 | use List::Util qw(first); 5 | use Mojo::Util; 6 | my $api = 'http://www.tuling123.com/openapi/api'; 7 | my %ban; 8 | my @limit_reply = ( 9 | "对不起，请不要这么频繁的艾特我", 10 | "对不起，您的艾特次数太多", 11 | "说这么多话不累么，请休息几分钟", 12 | ); 13 | sub call{ 14 | my $client = shift; 15 | my $data = shift; 16 | 17 | my $notice_reply = ref $data->{notice_reply} eq "ARRAY"?$data->{notice_reply}:\@limit_reply; 18 | my $notice_limit = $data->{notice_limit} || 8; 19 | my $warn_limit = $data->{warn_limit} || 10; 20 | my $ban_limit = $data->{ban_limit} || 12; 21 | my $ban_time = $data->{ban_time} || 1200; 22 | my $friend_reply = $data->{friend_reply} // 1; 23 | my $group_reply = $data->{group_reply} // 1; 24 | my $is_need_at = defined $data->{is_need_at}?$data->{is_need_at}:1; 25 | 26 | my $counter = $client->new_counter(id=>'SmartReply',period=>$data->{period} || 600); 27 | $client->on(login=>sub{%ban = ();$counter->reset();}); 28 | $client->on(receive_message=>sub{ 29 | my($client,$msg) = @_; 30 | return if not $msg->allow_plugin; 31 | return if $msg->type !~ /^friend_message|group_message|sess_message$/; 32 | return if !$friend_reply and $msg->type eq 'friend_message'; 33 | return if !$group_reply and $msg->type eq 'group_message'; 34 | return if exists $ban{$msg->sender->id}; 35 | 36 | my $sender_nick = $msg->sender->displayname; 37 | my $user_nick = $msg->receiver->displayname; 38 | 39 | my $trigger = 0; 40 | 41 | if($msg->type eq 'group_message'){ 42 | return if ref $data->{ban_group} eq "ARRAY" and first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->name eq $_} @{$data->{ban_group}}; 43 | return if ref $data->{allow_group} eq "ARRAY" and !first {$_=~/^\d+$/?$msg->group->uid eq $_:$msg->group->name eq $_} @{$data->{allow_group}}; 44 | return if ref $data->{ban_user} eq "ARRAY" and first {$_=~/^\d+$/?$msg->sender->uid eq $_:$sender_nick eq $_} @{$data->{ban_user}}; 45 | $trigger = 1 if $data->{is_need_at} and $msg->type eq "group_message" and $msg->is_at; 46 | } 47 | else{ 48 | return if ref $data->{ban_user} eq "ARRAY" and first {$_=~/^\d+$/?$msg->sender->uid eq $_:$sender_nick eq $_} @{$data->{ban_user}}; 49 | } 50 | 51 | if(ref $data->{keyword} eq "ARRAY" and @{$data->{keyword}} > 0){ 52 | $trigger = 1 if first { $msg->content =~ /\Q$_\E/} @{$data->{keyword}}; 53 | } 54 | 55 | return if not $trigger; 56 | 57 | my $id = ($msg->type eq 'group_message'?$msg->group->id : 'placeholder') . "|" .$msg->sender->id; 58 | my $limit = $counter->check( $id ); 59 | if($limit >= $ban_limit){ 60 | $ban{$msg->sender->id} = 1; 61 | $client->reply_message($msg,"\@$sender_nick " . "您已被列入黑名单，$ban_time秒内提问无视",sub{$_[1]->msg_from("bot")}); 62 | $counter->clear( $id ); 63 | $client->timer($ban_time ,sub{delete $ban{$msg->sender->id};}); 64 | return; 65 | } 66 | if($limit >= $warn_limit){ 67 | $client->reply_message($msg,"\@$sender_nick " . "警告，您艾特过于频繁，即将被列入黑名单，请克制",sub{$_[1]->from("bot")}); 68 | return; 69 | } 70 | if($limit >= $notice_limit){ 71 | $client->reply_message($msg,"\@$sender_nick " . $limit_reply->[int rand(@$limit_reply)],sub{$_[1]->from("bot")}); 72 | return; 73 | } 74 | 75 | $msg->allow_plugin(0); 76 | 77 | my $input = $msg->content; 78 | $input=~s/\@\Q$user_nick\E ?|\[[^\[\]]+\]\x01|\[[^\[\]]+\]//g; 79 | return unless $input; 80 | 81 | my $json = { 82 | "key" => $data->{apikey} || "f771372ffd054183bfcdf260d7c7ad5a", 83 | "userid" => $msg->sender->id, 84 | "info" => $input, 85 | }; 86 | 87 | $json->{"loc"} = $msg->sender->city if $msg->type eq "group_message" and $msg->sender->city; 88 | $client->http_post($api,{json=>1},json=>$json,sub{ 89 | my $json = shift; 90 | return unless defined $json; 91 | return if $json->{code}=~/^4000[1-7]$/; 92 | my $reply; 93 | if($json->{code} == 100000){ 94 | return unless $json->{text}; 95 | $reply = $json->{text}; 96 | } 97 | elsif($json->{code} == 200000){ 98 | $reply = "$json->{text}$json->{url}"; 99 | } 100 | else{return} 101 | $reply=~s##\n#g; 102 | eval{$reply= Mojo::Util::html_unescape($reply);}; 103 | $client->warn("html entities unescape fail: $@") if $@; 104 | $reply = "\@$sender_nick " . $reply if $msg->type eq 'group_message' and rand(100)>20; 105 | $reply = $client->truncate($reply,max_bytes=>500,max_lines=>8) if ($msg->type eq 'group_message' and $data->{is_truncate_reply}); 106 | $client->reply_message($msg,$reply,sub{$_[1]->from("bot")}) if $reply; 107 | }); 108 | 109 | }); 110 | } 111 | 1; 112 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/StockInfo.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::StockInfo; 2 | $Mojo::Webqq::Plugin::StockInfo::PRIORITY = 95; 3 | use strict; 4 | use 5.010; 5 | use Encode; 6 | 7 | sub call{ 8 | my $client = shift ; 9 | my $data = shift; 10 | $client->on(receive_message => sub { 11 | my($client,$msg)=@_; 12 | return unless $msg->allow_plugin; 13 | return unless $msg->content =~ /^gp\s+(.*)$/ or $msg->content =~ /^股票\s+(.*)$/; 14 | $msg->allow_plugin(0); 15 | 16 | my $stockid = stockid_convert($1); 17 | return unless defined $stockid; 18 | 19 | my $url="http://qt.gtimg.cn/q=$stockid"; 20 | $client->http_get($url,sub{ 21 | my $res = shift; 22 | $res = encode("utf8",decode("gbk",$res)); 23 | my $reply_msg = stockinfo_convert($res); 24 | $client->reply_message($msg,$reply_msg); 25 | }) 26 | 27 | }); 28 | } 29 | 30 | sub stockid_convert{ 31 | my $info = shift; 32 | ### $info 33 | my $stockid; 34 | if( $info =~ /^(\d\d\d)(\d\d\d)/ ){ 35 | my $stockid_head_num = "$1"; 36 | my $stockid_tail_num = "$2"; 37 | my @sz=qw/000 001 002 031 038 131 150 159 160 161 162 163 164 165 166 167 169 184 200 300/; 38 | my @sh=qw/201 202 203 204 500 502 505 510 511 512 513 518 580 600 601 603 900/; 39 | my $stockid_site; 40 | if( grep {$_ =~ /^$stockid_head_num$/ }@sz) 41 | { 42 | $stockid_site="sz"; 43 | }elsif ( grep {$_ =~ /^$stockid_head_num$/ }@sh ) { 44 | $stockid_site="sh"; 45 | }else{ 46 | print "不属于股票id(${stockid_head_num}${stockid_tail_num})\n"; 47 | return undef; 48 | } 49 | $stockid = "$stockid_site"."$stockid_head_num"."$stockid_tail_num"; 50 | }else{ 51 | return undef; 52 | } 53 | return $stockid; 54 | } 55 | sub stockinfo_convert{ 56 | 57 | my $res = shift; 58 | ### $res 59 | ( 60 | undef, 61 | my $name, #名称 62 | my $code, #代码 63 | #3-5 64 | my $current_price, #当前价格 65 | my $yesterday_price, #昨日收盘 66 | my $today_open_price, #今日开盘 67 | #6-8 68 | my $totalNumber, #成交量 69 | my $outNumber, #外盘 70 | my $innerNumber, #内盘 71 | 72 | #9~18 73 | my $buy1, 74 | my $buyPrice1, 75 | my $buy2, 76 | my $buyPrice2, 77 | my $buy3, 78 | my $buyPrice3, 79 | my $buy4, 80 | my $buyPrice4, 81 | my $buy5, 82 | my $buyPrice5, 83 | 84 | #19~28 85 | my $sell1, 86 | my $sellPrice1, 87 | my $sell2, 88 | my $sellPrice2, 89 | my $sell3, 90 | my $sellPrice3, 91 | my $sell4, 92 | my $sellPrice4, 93 | my $sell5, 94 | my $sellPrice5, 95 | undef, 96 | my $CurrentTime, 97 | my $UpdownPrice, 98 | my $UpdownPercent, 99 | my $HighPrice, 100 | my $LowPrice, 101 | undef, 102 | undef, 103 | my $totalMony, 104 | my $changePercent, 105 | my $shiYing, 106 | undef, 107 | undef, 108 | undef, 109 | my $zhenFu, 110 | ) = split /~/,$res; 111 | my $reply; 112 | $reply .= "股票名称: $name($code)\n"; 113 | $reply .= "------------------------\n"; 114 | $reply .= "当前价格:$current_price\t开盘价格:$today_open_price\t昨日收盘:$yesterday_price\n"; 115 | $reply .= sprintf "幅度 :%-15s换手率 :%-17s\n",$UpdownPercent."%",$changePercent."%"; 116 | $reply .= "成交量 :$totalNumber\n"; 117 | $reply .= "------------------------\n"; 118 | $reply .= sprintf "买一 :%-8s %-5s卖一 :%-8s %-5s\n",$buy1,$buyPrice1,$sell1,$sellPrice1; 119 | $reply .= sprintf "买二 :%-8s %-5s卖二 :%-8s %-5s\n",$buy2,$buyPrice2,$sell2,$sellPrice2; 120 | $reply .= sprintf "买三 :%-8s %-5s卖三 :%-8s %-5s\n",$buy3,$buyPrice3,$sell3,$sellPrice3; 121 | $reply .= sprintf "买四 :%-8s %-5s卖四 :%-8s %-5s\n",$buy4,$buyPrice4,$sell4,$sellPrice4; 122 | $reply .= sprintf "买五 :%-8s %-5s卖五 :%-8s %-5s\n",$buy5,$buyPrice5,$sell5,$sellPrice5; 123 | return $reply; 124 | } 125 | 1; 126 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/Translation.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::Translation; 2 | use strict; 3 | use Mojo::Util qw(url_escape encode md5_sum decode); 4 | our $PRIORITY = 93; 5 | sub call { 6 | my ($client,$data) = @_; 7 | my $api = 'http://api.fanyi.baidu.com/api/trans/vip/translate'; 8 | my $appid = $data->{appid} || '20160516000021158'; 9 | my $appsecret = $data->{appsecret} || '2QoSmvMuun8btJmsl446'; 10 | my $callback = sub{ 11 | my($client,$msg) = @_; 12 | return if not $msg->allow_plugin; 13 | return if $msg->class eq "send" and $msg->from ne "api" and $msg->from ne "irc"; 14 | if($msg->content =~ /^翻译\s+(.*)/s){ 15 | my $query = $1; 16 | return if not $query; 17 | $msg->allow_plugin(0); 18 | my $salt = time; 19 | $client->http_get($api,{json=>1},form=>{ 20 | q => $query, 21 | from => 'auto', 22 | to => 'auto', 23 | appid => $appid, 24 | salt => $salt, 25 | sign => md5_sum($appid . $query . $salt . $appsecret), 26 | },sub{ 27 | my $json = shift; 28 | if( not defined $json ){$msg->reply("翻译失败: api接口不可用")} 29 | elsif(defined $json and exists $json->{error_code}){ 30 | $msg->reply("翻译失败: api接口不可用(" . $json->{error_code} . " " . $json->{error_msg} . ")"); 31 | } 32 | elsif(defined $json){ 33 | $msg->reply( join " ",map {$_->{dst}} @{ $json->{trans_result} } ); 34 | } 35 | }); 36 | } 37 | }; 38 | $client->on(receive_message=>$callback,send_message=>$callback); 39 | } 40 | 1; 41 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/UploadQRcode.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::UploadQRcode; 2 | our $CALL_ON_LOAD=1; 3 | use strict; 4 | sub call{ 5 | my $client = shift; 6 | my $data = shift; 7 | $client->on(input_qrcode=>sub{ 8 | my($client,$qrcode_path,$qrcode_data) = @_; 9 | #需要产生随机的云存储路径，防止好像干扰 10 | my $json = $client->http_post('https://sm.ms/api/upload',{json=>1},form=>{ 11 | format=>'json', 12 | smfile=>{filename=>$qrcode_path,content=>$qrcode_data}, 13 | }); 14 | if(not defined $json){ 15 | $client->warn("二维码图片上传云存储失败: 响应数据异常"); 16 | return; 17 | } 18 | elsif(defined $json and $json->{code} ne 'success' ){ 19 | $client->warn("二维码图片上传云存储失败: " . $json->{msg}); 20 | return; 21 | } 22 | $client->qrcode_upload_url($json->{data}{url}); 23 | $client->info("二维码已上传云存储[ ". $json->{data}{url} . " ]"); 24 | }); 25 | } 26 | 1; 27 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/UploadQRcode2.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Plugin::UploadQRcode2; 2 | our $CALL_ON_LOAD=1; 3 | use strict; 4 | use Mojo::Util (); 5 | use Time::HiRes (); 6 | use Digest::SHA (); 7 | sub call{ 8 | my $client = shift; 9 | my $data = shift; 10 | $client->on(input_qrcode=>sub{ 11 | my($client,$qrcode_path,$qrcode_data) = @_; 12 | #需要产生随机的云存储路径，防止好像干扰 13 | my $uniq_path = "mojo_webqq_" . substr(Time::HiRes::gettimeofday(),4) . sprintf("%.6f",rand(1)) . ".png"; 14 | my $url = upload($client,$data,$uniq_path,$qrcode_data); 15 | return if not defined $url; 16 | $client->qrcode_upload_url($url); 17 | $client->info("二维码已上传云存储[ $url ]"); 18 | }); 19 | } 20 | 21 | sub upload { 22 | my($client,$opt,$name,$data) = @_; 23 | my $mydomain = $opt->{mydomain} // "qr.perfi.wang"; 24 | my $appid = $opt->{appid} // 10063136; 25 | my $bucket = $opt->{bucket} // 'qr'; 26 | my $secretid = $opt->{secretid} // 'AKIDGfoZzPrHrWW98rqFbCF5EHP0DenTqO4N'; 27 | my $secretkey = $opt->{secretkey} // 'eT2sPJnvXQ3IGF4yaaBLGkOXDVAsEqlo'; 28 | my $now = time; 29 | my $expire = $opt->{expire} // 120; 30 | $expire = $now + $expire; 31 | my $rand = int rand 1000000; 32 | 33 | my $fileid = Mojo::Util::url_escape("/$appid/$bucket/$name"); 34 | $fileid=~s/%2F/\//g; 35 | my $orignal = "a=$appid&b=$bucket&k=$secretid&e=$expire&t=$now&r=$rand&f=$fileid"; 36 | my $signtemp = Digest::SHA::hmac_sha1($orignal,$secretkey); 37 | my $sign = Mojo::Util::b64_encode($signtemp . $orignal,""); 38 | 39 | my $json = $client->http_post("http://web.file.myqcloud.com/files/v1/$appid/$bucket/$name", 40 | { Authorization=>$sign, json=>1 ,ua_debug_req_body=>0}, 41 | form=>{ 42 | op=>'upload', 43 | insertOnly=>1, 44 | filecontent=>{filename=>$name,content=>$data}, 45 | } 46 | ); 47 | if(not defined $json){ 48 | $client->warn("二维码图片上传云存储失败: 响应数据异常"); 49 | return; 50 | } 51 | elsif(defined $json and $json->{code} != 0 ){ 52 | $client->warn("二维码图片上传云存储失败: " . $json->{message}); 53 | return; 54 | } 55 | 56 | my $url = $json->{data}{source_url}; 57 | $url=~s/(^https?:\/\/)([^\/]+)(.*)/$1$mydomain$3/ if (defined $url and defined $mydomain); 58 | if(not defined $url){ 59 | $client->warn("二维码图片上传云存储失败：未获取到有效地址"); 60 | return; 61 | } 62 | return $url; 63 | } 64 | 1; 65 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Plugin/ZiYue.pm: -------------------------------------------------------------------------------- 1 | 2 | package Mojo::Webqq::Plugin::ZiYue; 3 | $Mojo::Webqq::Plugin::ZiYue::PRIORITY = 1; 4 | 5 | 6 | my @reply =qw( 7 | 巧言令色，鲜矣仁！ 8 | 不患人之不己知，患不知人也。 9 | 温故而知新，可以为师矣。 10 | 君子不器。 11 | 君子周而不比，小人比而不周。 12 | 学而不思则罔，思而不学则殆。 13 | 攻乎异端，斯害也已。 14 | 夷狄之有君，不如诸夏之亡也。 15 | 自既灌而往者，吾不欲观之矣。 16 | 事君尽礼，人以为谄也。 17 | 《关雎》，乐而不淫，哀而不伤。 18 | 里仁为美。择不处仁，焉得知？ 19 | 唯仁者能好人，能恶人。 20 | 苟志于仁矣，无恶也。 21 | 朝闻道，夕死可矣。 22 | 放于利而行，多怨。 23 | 君子喻于义，小人喻于利。 24 | 见贤思齐焉，见不贤而内自省也。 25 | 父母在，不远游，游必有方。 26 | 三年无改于父之道，可谓孝矣。 27 | 古者言之不出，耻躬之不逮也。 28 | 以约失之者鲜矣。 29 | 君子欲讷于言而敏于行。 30 | 德不孤，必有邻。 31 | 晏平仲善与人交，久而敬之。 32 | 伯夷、叔齐不念旧恶，怨是用希。 33 | 雍也可使南面。 34 | 谁能出不由户？何莫由斯道也？ 35 | 人之生也直，罔之生也幸而免。 36 | 觚不觚，觚哉！觚哉！ 37 | 自行束修以上，吾未尝无诲焉。 38 | 天生德于予，恒 其如予何？ 39 | 仁远乎哉？我欲仁，斯仁至矣。 40 | 君子坦荡荡，小人长戚戚。 41 | 兴于诗，立于礼，成于乐。 42 | 民可使由之，不可使知之。 43 | 三年学，不至于谷，不易得也。 44 | 不在其位，不谋其政。 45 | 学如不及，犹恐失之。 46 | 凤鸟不至，河不出图，吾已矣夫！ 47 | 吾未见好德如好色者也。 48 | 语之而不惰者，其回也与！ 49 | 三军可夺帅也，匹夫不可夺志也。 50 | 岁寒，然后知松柏之后凋也。 51 | 知者不惑，仁者不忧，勇者不惧。 52 | 从我于陈、蔡者，皆不及门也。 53 | 论笃是与，君子者乎？色庄者乎？ 54 | 听讼，吾犹人也。必也使无讼乎？ 55 | 鲁卫之政，兄弟也。 56 | 如有王者，必世而后仁。 57 | 君子和而不同，小人同而不和。 58 | 君子泰而不骄，小人骄而不泰。 59 | 刚、毅、木、讷近仁。 60 | 善人教民七年，亦可以即戎矣。 61 | 以不教民战，是谓弃之。 62 | 士而怀居，不足以为士矣。 63 | 贫而无怨难，富而无骄易。 64 | 其言之不怍，则为之也难。 65 | 君子上达，小人下达。 66 | 古之学者为己，今之学者为人。 67 | 君子耻其言之过其行。 68 | 不患人之不己知，患其不能也。 69 | 骥不称其力，称其德也。 70 | 上好礼，则民易使也。 71 | 由！知德者鲜矣。 72 | 人无远虑，必有近忧。 73 | 已矣乎！吾未见好德如好色者也。 74 | 躬自厚而薄责于人，则远怨矣。 75 | 君子疾没世而名不称焉。 76 | 君子求诸己，小人求诸人。 77 | 君子矜而不争，群而不党。 78 | 君子不以言举人，不以人废言。 79 | 巧言乱德。小不忍，则乱大谋。 80 | 人能弘道，非道弘人。 81 | 过而不改，是谓过矣。 82 | 当仁，不让于师。 83 | 君子贞而不谅。 84 | 事君，敬其事而后其食。 85 | 有教无类。 86 | 道不同不相为谋。 87 | 辞达而已矣。 88 | 性相近也，习相远也。 89 | 唯上知与下愚不移。 90 | 乡原，德之贼也。 91 | 道听而涂说，德之弃也。 92 | 巧言令色，鲜矣仁。 93 | 年四十而见恶焉，其终也已。 94 | ); 95 | sub call { 96 | my $client = shift; 97 | $client->on(receive_message=>sub{ 98 | my($client,$msg)=@_; 99 | return if not $msg->allow_plugin; 100 | return if $msg->content !~ /(子\s*曰|论\s*语|者\s*也)/; 101 | $msg->allow_plugin(0); 102 | my $key_word = $1;$key_word=~s/\s+//; 103 | my $reply = $reply[int rand($#reply+1)]; 104 | $reply=~s/%/$key_word/g; 105 | $msg->reply($reply,sub{$_[1]->from("bot")}) if $reply; 106 | }); 107 | } 108 | 1; 109 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Recent/Discuss.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Recent::Discuss; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | did 6 | type 7 | )]; 8 | 9 | sub update{ 10 | my $self = shift; 11 | my $hash = shift; 12 | for(keys %$self){ 13 | $self->{$_} = $hash->{$_} if exists $hash->{$_} ; 14 | } 15 | $self; 16 | } 17 | 1; 18 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Recent/Friend.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Recent::Friend; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | id 6 | type 7 | )]; 8 | 9 | sub update{ 10 | my $self = shift; 11 | my $hash = shift; 12 | for(keys %$self){ 13 | $self->{$_} = $hash->{$_} if exists $hash->{$_} ; 14 | } 15 | $self; 16 | } 17 | 1; 18 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Recent/Group.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Recent::Group; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | gid 6 | type 7 | )]; 8 | 9 | sub update{ 10 | my $self = shift; 11 | my $hash = shift; 12 | for(keys %$self){ 13 | $self->{$_} = $hash->{$_} if exists $hash->{$_} ; 14 | } 15 | $self; 16 | } 17 | 1; 18 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/Server.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::Server; 2 | use base qw(Mojo::Server::Daemon); 3 | 1; 4 | -------------------------------------------------------------------------------- /lib/Mojo/Webqq/User.pm: -------------------------------------------------------------------------------- 1 | package Mojo::Webqq::User; 2 | use strict; 3 | use Mojo::Webqq::Base 'Mojo::Webqq::Model::Base'; 4 | has [qw( 5 | face 6 | birthday 7 | phone 8 | occupation 9 | allow 10 | college 11 | id 12 | uid 13 | sex 14 | blood 15 | constel 16 | homepage 17 | state 18 | country 19 | city 20 | personal 21 | name 22 | shengxiao 23 | email 24 | token 25 | client_type 26 | province 27 | mobile 28 | signature 29 | )]; 30 | sub qq {$_[0]->uid} 31 | sub nick {$_[0]->name} 32 | sub displayname { 33 | my $self = shift; 34 | return $self->name; 35 | } 36 | 37 | 1; 38 | -------------------------------------------------------------------------------- /screenshot/How_to_chat_like_a_hacker.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hexsum/Mojo-Webqq/303d6be0dda024aee44f75aa09535abfd478ca67/screenshot/How_to_chat_like_a_hacker.jpg -------------------------------------------------------------------------------- /screenshot/IRCShell.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hexsum/Mojo-Webqq/303d6be0dda024aee44f75aa09535abfd478ca67/screenshot/IRCShell.png -------------------------------------------------------------------------------- /screenshot/donate.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hexsum/Mojo-Webqq/303d6be0dda024aee44f75aa09535abfd478ca67/screenshot/donate.jpg -------------------------------------------------------------------------------- /script/check_dependencies.pl: -------------------------------------------------------------------------------- 1 | my %dependent_modules = ( 2 | 'Crypt::OpenSSL::RSA' => undef, 3 | 'Crypt::OpenSSL::Bignum' => undef, 4 | 'Compress::Raw::Zlib' => undef, 5 | 'IO::Compress::Gzip' => undef, 6 | 'Time::HiRes' => undef, 7 | 'Time::Piece' => undef, 8 | 'Time::Seconds' => undef, 9 | 'Digest::SHA' => undef, 10 | 'Digest::MD5' => undef, 11 | 'Encode::Locale' => undef, 12 | 'IO::Socket::SSL' => undef, 13 | 'Term::ANSIColor' => undef, 14 | ); 15 | print "Checking dependencies ...\n"; 16 | print "--------------------------------\n"; 17 | for my $module (keys %dependent_modules){ 18 | eval "require $module"; 19 | $dependent_modules{$module} = $@?0:1; 20 | printf "%-25s is %s\n", $module,$@?"not ok":"ok"; 21 | } 22 | print "--------------------------------\n"; 23 | printf "Check result: %d/%d\n",scalar(grep {$dependent_modules{$_}==1} keys %dependent_modules),scalar(keys %dependent_modules); 24 | if( scalar(grep {$dependent_modules{$_}==0} keys %dependent_modules) == 0){ 25 | print "Congratulations, all dependencies is ok\n"; 26 | } 27 | else{ 28 | print "The below dependence is not found:\n\n"; 29 | for(grep {$dependent_modules{$_}==0} keys %dependent_modules){ 30 | print "$_\n"; 31 | } 32 | print "\n"; 33 | print "You need to install these missing modules by do this command: \n\n"; 34 | print " cpanm " . join(" ",grep {$dependent_modules{$_}==0} keys %dependent_modules) . "\n"; 35 | print "\n"; 36 | 37 | print "If you are using Centos, yum is the recommended way which is efficient and reliable:\n\n"; 38 | print " yum -y install " . join(" ",map {s/::/-/g;"perl-" . $_ } grep {$dependent_modules{$_}==0} keys %dependent_modules) . "\n"; 39 | print "\n"; 40 | } 41 | -------------------------------------------------------------------------------- /t/https.t: -------------------------------------------------------------------------------- 1 | # Before `make install' is performed this script should be runnable with 2 | # `make test'. After `make install' it should work as `perl https.t' 3 | 4 | ######################### 5 | 6 | # change 'tests => 1' to 'tests => last_test_to_print'; 7 | sub https_test{ 8 | use Mojo::UserAgent; 9 | my $ua = Mojo::UserAgent->new; 10 | $ua->proxy->detect; 11 | $ua->transactor->name("Mozilla/5.0 (Windows NT 6.1) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/39.0.2171.65"); 12 | my $tx = $ua->get('https://www.baidu.com'); 13 | if (my $res = $tx->success) { return $res->code } 14 | else { 15 | my $err = $tx->error; 16 | die "$err->{code} response: $err->{message}" if $err->{code}; 17 | die "Connection error: $err->{message}"; 18 | } 19 | } 20 | use Test::More tests => 1; 21 | ok( https_test()== 200,"https support"); 22 | 23 | ######################### 24 | 25 | # Insert your test code below, the Test::More module is use()ed here so read 26 | # its man page ( perldoc Test::More ) for help writing this test script. 27 | -------------------------------------------------------------------------------- /t/load_module.t: -------------------------------------------------------------------------------- 1 | # Before `make install' is performed this script should be runnable with 2 | # `make test'. After `make install' it should work as `perl load_module.t' 3 | 4 | ######################### 5 | 6 | # change 'tests => 1' to 'tests => last_test_to_print'; 7 | use Test::More tests => 1; 8 | BEGIN { use_ok('Mojo::Webqq') }; 9 | 10 | ######################### 11 | 12 | # Insert your test code below, the Test::More module is use()ed here so read 13 | # its man page ( perldoc Test::More ) for help writing this test script. 14 | --------------------------------------------------------------------------------