论坛徽章:: 0

电梯直达

1楼 [收藏(0)] [报告]

发表于 2009-02-03 13:19 |只看该作者 |倒序浏览

10可用积分

目前有一些Html需要对其Source的内容进行整理。

Html的内容如下所示

<html>

<head>
<title>XXXXXXX</title>
</head>

<body>

AAAAABBBBB
CCCCCDDDDDEEEEEFFFFFGGGGG
HHHHH<o:p></o:p>

</body>

</html>

现在想要在Source中的将无用的Span信息进行删除。

如AAAAA ----> AAAAA
BBBBB ----> BBBBB
CCCCC ----> CCCCC
这样的可变Tag如何能除掉?

因为Tag涉及到作用域问题，不能简单地用匹配模式进行整理。
Html::TreeBuilder这个模块看了下，还是没弄清楚如何处理好可变Tag。

最佳答案

ynchnluiti

查看完整内容

试试下面代码

文库|博客

ynchnluiti

巨富豪门

论坛徽章:: 3

2楼 [报告]

发表于 2009-02-03 13:19 |只看该作者

试试下面代码

{
my $mainspan;
my $h = HTML::TreeBuilder->new_from_content( decode($encode, $s) );
for my $p ($h->look_down(_tag => q{p}) ) {
for my $span( $h->look_down(_tag => q{span}) ) {
if ( defined $span->attr('lang') ) {
$span->attr(lang=>undef);
$mainspan = $span;
last;
}
}
for my $span( $p->look_down(_tag => q{span}) ) {
$span->replace_with_content($span->content_refs_list);
}
my @content = $p->content_list;
if (@content) {
$p->detach_content();
$mainspan->push_content(@content);
$p->push_content($mainspan);
}
}
$s = encode( $encode, $h->as_HTML('<>&',' ',{}) ) . "\n";
$s =~ s/span_space/ /g;
print $s;
$h->delete;
}

复制代码

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

islue

稍有积蓄

论坛徽章:: 0

3楼 [报告]

发表于 2009-02-03 14:12 |只看该作者

回复 #1 niaya 的帖子

因为Tag涉及到作用域问题，不能简单地用匹配模式进行整理。

没看懂，只是要去掉span的话
s{<span.*?>(.*?)}{\1}g
大致这个意思，不行吗？

用HTML::TreeBuilder抽取信息的话可以这样做，无视attribute就是了

my $tree = new HTML::TreeBuilder;
$tree->parse($file);
my @span = $tree->look_down('_tag', 'span');
foreach my $span (@span) {
  print $span->as_text;
}

不过看上去你想要的是inline操作对吧，那样的话，HTML::Parser或者HTML::TokeParser::Simple可能更合适一些。

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

niaya

白手起家

论坛徽章:: 0

4楼 [报告]

发表于 2009-02-03 16:49 |只看该作者

原帖由 islue 于 2009-2-3 14:12 发表

没看懂，只是要去掉span的话
s{(.*?)}{\1}g
大致这个意思，不行吗？

用HTML::TreeBuilder抽取信息的话可以这样做，无视attribute就是了

my $tree = new HTML::TreeBuilder;
$tree->parse($file);
...

不好意思，可能有些没解释清楚。

我不是想删除所有的span标签，只是想删除上面提到的几个.当一个标签中出现这样的结构时 只去掉lang=EN-US即可。（结果变成）

另外我说的作用域是这样的
Perl是可移植的。Perl
蓝色是一个作用域，而红色是另一个作用域
如果只是删除距离最近的的话。代码就会变成
Perl是可移植的。Perl
要找到成对匹配的和。

看一下下面的例子吧(借用下大骆驼书的前言作为Html的Body部分)

<body lang=ZH-CN link=blue vlink=purple style='tab-interval:21.0pt;text-justify-trim:
punctuation'>
Perl 是不同的语言。从一开始， Perl就设计成可以把简单工作简单化，<span
face=宋体>同时又不失去处理困难问题
能力的语言。<o:p></o:p>
</body>

复制代码

整理完成后变为

<body lang=ZH-CN link=blue vlink=purple style='tab-interval:21.0pt;text-justify-trim:
punctuation'>
<p style='margin-top:0in;margin-right:0in;margin-bottom:0in;margin-left:.2in;
margin-bottom:.0001pt'> Perl 是不同的语言。从一开始， Perl 就设计成可以把简单工作简单化，同时又不失去处理困难问题能力的语言。<o:p></o:p>
</body>

复制代码

[ 本帖最后由 niaya 于 2009-2-3 17:04 编辑 ]

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

ynchnluiti

巨富豪门

论坛徽章:: 3

5楼 [报告]

发表于 2009-02-04 02:04 |只看该作者

回复 #3 niaya 的帖子

不太会用
删除属性$span->attr('lang', undef);

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

Lonki

小富即安

论坛徽章:: 0

6楼 [报告]

发表于 2009-02-04 12:57 |只看该作者

use strict;
use warnings;
use Encode;
use HTML::TreeBuilder;

my $html = q^

是不同的语言。
^;
### Decode HTML if it's non en_US
$html = decode('GBK', $html);

### Build HTML tree
my $tree = HTML::TreeBuilder->new_from_content($html);
print $tree->as_HTML, "\n";

### Strip attributes specified
my @stripAttrs = qw/class face lang/;
my @spanTags = $tree->look_down('_tag' => 'span');
for my $tag (@spanTags) {
    for my $attr (@stripAttrs) {
        $tag->attr($attr, undef) if $tag->attr($attr);
    }
}
print $tree->as_HTML, "\n";

### MUST delete the tree explicitly
$tree = $tree->delete;

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

ynchnluiti

巨富豪门

论坛徽章:: 3

7楼 [报告]

发表于 2009-02-04 15:00 |只看该作者

#!/usr/bin/perl -w
use warnings;
use strict;
use Encode;
use HTML::Entities;
use HTML::TreeBuilder;
my $encode = 'gbk';# change it according to your env
my $html = <<'__HTML__';
<body lang=ZH-CN link=blue vlink=purple style='tab-interval:21.0pt;text-justify-trim:
punctuation'>
Perl 是不同的语言。从一开始， Perl就设计成可以把简单工作简单化，<span
face=宋体>同时又不失去处理困难问题
能力的语言。<o:p></o:p>
</body>
__HTML__
{
my $h = HTML::TreeBuilder->new_from_content( decode($encode, $html) );
my $p = $h->look_down(_tag => q{p});
my $mainspan;
for my $span( $h->look_down(_tag => q{span}) ){
if ( defined $span->attr('lang') ) {
$span->attr(lang=>undef);
$mainspan = $span;
last;
}
}
#print decode_entities($mainspan->as_HTML), "\n";
for my $span( $h->look_down(_tag => q{span}) ){
$span->replace_with_content($span->content_refs_list);
}
my @content = $p->content_list;
$p->detach_content();
$mainspan->push_content(@content);
$p->push_content($mainspan);
print encode( $encode, $h->as_HTML('<>&',' ',{}) ), "\n";
$h->delete;
}
__END__
<html>
<head>
</head>
<body lang="ZH-CN" link="blue" style="tab-interval:21.0pt;text-justify-trim:
punctuation" vlink="purple">
Perl 是不同的语言。从一开始， Perl就设计成可以把简单工作简单化，同时又不失去处理困难问题能力的语言。
</body>
</html>

复制代码

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

niaya

白手起家

论坛徽章:: 0

8楼 [报告]

发表于 2009-02-05 14:40 |只看该作者

首先感谢楼上朋友们的回答。非常感谢。

现在参考的是6楼的代码。

在编译到（$mainspan->push_content(@content);）时，提示以下警告信息：

Can't call method push_content on an undefined value.

是指@content为Undef了吗？这个问题怎么解决？

实战分享：从技术角度谈机器学习入门| 【大话IT】RadonDB低门槛向MySQL集群下战书 | ChinaUnix打赏功能已上线！ | 新一代分布式关系型数据库RadonDB知多少？

ynchnluiti

巨富豪门

论坛徽章:: 3

9楼 [报告]

发表于 2009-02-05 14:48 |只看该作者

原帖由 niaya 于 2009-2-5 14:40 发表
首先感谢楼上朋友们的回答。非常感谢。

现在参考的是6楼的代码。

在编译到（$mainspan->push_content(@content);）时，提示以下警告信息：

Can't call method push_content on an undefined value.

...

$mainspan为undefined了。就是没找对