设为首页收藏本站

教师网络培训和服务平台

 找回密码
 注册
搜索
查看: 399|回复: 1

Perl语言批量下载人民教育网高中物理电子课本(jpg)

[复制链接]

1

主题

0

好友

50

积分

发表于 2016-7-5 14:39:03 |显示全部楼层
说个问题:
扫描质量 - 分辨率未免太低了,既然要发布电子课本,不如发好一点的,教育在于普及,难道怕别人盗版么?
脚本应保存为utf8文本格式

  1. =info
  2.     Edit: vicyang
  3.     Mail: 523066680@163.com
  4.     Date: 2016-06
  5. =cut

  6. use v5.16;
  7. use utf8;
  8. use Encode;
  9. use LWP::UserAgent;
  10. use LWP::Simple qw/getstore get/;
  11. use IO::Handle;
  12. STDOUT->autoflush(1);

  13. our $website = "\x68\x74\x74\x70\x3A\x2F\x2F\x77\x77\x77\x2E\x70\x65\x70\x2E\x63\x6F\x6D\x2E\x63\x6E\x2F\x67\x7A\x77\x6C\x2F\x6A\x73\x7A\x78\x2F\x74\x62\x6A\x78\x2F\x6B\x62\x2F\x64\x7A\x6B\x62\x2F";

  14. our $bookpage;
  15. our $WORKDIR;
  16. our $page1maps;
  17. my  ($path, $begin, $end);

  18. my @booklist = qw/
  19.     bx1  bx2 xx11 xx12 xx21 xx22 xx23 xx31 xx32 xx33 xx34 xx35 /;


  20. for my $book ( @booklist[0 .. $#booklist]  )
  21. {
  22.     print "Now is downloading: $book\n";
  23.     $bookpage = $website. $book . "/";
  24.     $WORKDIR  =  "D:\\Extra\\Book\\Physics_test\\" . $book;

  25.     CreatePath($WORKDIR);

  26.     ($path, $begin, $end) = get_pgnum_range( $bookpage );
  27.     print "Path: $path, $begin to $end\n";

  28.     #页面1 对应的 页码
  29.     $page1maps = get_who_map_page1( $bookpage );

  30.     get_picture( $bookpage, $path, $begin, $end );
  31. }

  32. system("pause");

  33. sub get_pgnum_range
  34. {
  35.     my $bookpage = shift;
  36.     my $all;
  37.     $all = get($bookpage);   #使用lwp::simple 得到的是unicode,
  38.                              #使用lwp::UserAgent 得到的是GB2312
  39.     my @pglist;
  40.     my $path;

  41.     $all =~s/.*封面//s;      #如果有封面,剔除

  42.     #./201102/t20110217_1021412.htm
  43.     for my $e ( split("\r?\n", $all)  )
  44.     {
  45.         if ($e=~/href="\.\/([^"]*_)(\d+).htm"/)
  46.         {
  47.             $path = $1;
  48.             push @pglist, $2;
  49.         }
  50.     }

  51.     @pglist = sort @pglist;
  52.     return $path, @pglist[ 0, $#pglist ];
  53. }

  54. sub get_who_map_page1
  55. {
  56.     my $bookpage = shift;
  57.     my $all = get($bookpage);

  58.     $all=~s/\r?\n//g;
  59.     if ( $all=~/\d+_(\d+)\.htm[^.]+第/ )
  60.     {
  61.         return $1;
  62.     }
  63.     else
  64.     {
  65.         die "first page code not found! ";
  66.     }
  67. }


  68. sub get_picture
  69. {
  70.     my ($bookpage, $path, $begin, $end) = @_;

  71.     our $page1maps;
  72.     our $WORKDIR;
  73.     my  $all;           #网页内容
  74.     my  $subpage;       #子页面
  75.     my  $pic;           #图片名
  76.     my  $count = 0;     #页码计数
  77.     my  $fname;         #文件名

  78.     #该网页地址是逆序的,书本page+1,网址代码-1

  79.     for (my $n = $end; $n >= $begin; $n-- )
  80.     {
  81.         $subpage = $bookpage . $path . $n . ".htm";

  82.         $all = get( $subpage ) or next;
  83.         if ( $all=~/IMG src="?\.\/([^".]*.jpg)"?/i )  #不一定有""符号
  84.         {
  85.             $pic = $1;
  86.             $subpage =~s /[^\/]+$/$pic/;

  87.             if ( $n <= $page1maps )
  88.             {
  89.                 $count++;
  90.                 $fname = sprintf("%03d.jpg", $count);
  91.             }
  92.             else
  93.             {
  94.                 $fname = $pic;
  95.             }

  96.             getstore($subpage, $WORKDIR."\\".$fname) or die "$!";
  97.             print "$pic\n";
  98.         }
  99.     }
  100. }

  101. sub CreatePath
  102. {
  103.     my $path = shift;
  104.     my @arr=split(/[\\\/]/, $path);
  105.     my $main;

  106.     $main = shift @arr;  #以盘符开始

  107.     for my $s (@arr)
  108.     {
  109.         $main .= "/" . $s;
  110.         mkdir( $main ) if ( ! -d $main );
  111.     }
  112. }

复制代码

1

主题

0

好友

50

积分

发表于 2016-7-5 14:45:32 |显示全部楼层
$website 变量存储的是主要链接, 因为论坛不给发布就转成16进制了

my @booklist = qw/
    bx1  bx2 xx11 xx12 xx21 xx22 xx23 xx31 xx32 xx33 xx34 xx35 /;

@booklist 是书籍列表,必修1 2 以及 选修1-1 ....
您需要登录后才可以回帖 登录 | 注册

Archiver|手机版|人教网 ( 京ICP备05019902号   

GMT+8, 2017-9-25 06:59

回顶部