root/lang/perl/mobirc/trunk/lib/App/Mobirc/Plugin/DocRoot.pm @ 6171

Revision 6171, 1.3 kB (checked in by tokuhirom, 7 years ago)

ちょっとあんたなに勝手に utf8 フラッグもってってるのよ!
というわけで cho45++

Line 
1package App::Mobirc::Plugin::DocRoot;
2use strict;
3use warnings;
4use App::Mobirc::Util;
5use XML::LibXML;
6
7sub register {
8    my ($class, $global_context, $conf) = @_;
9
10    DEBUG "Rewrite Document Root";
11
12    $global_context->register_hook(
13        'html_filter' => sub { _html_filter_docroot($_[0], $_[1], $conf) },
14    );
15}
16
17sub _html_filter_docroot {
18    my ($c, $content, $conf) = @_;
19
20    my $root = $conf->{root};
21    $root =~ s!/$!!;
22
23    my $doc = XML::LibXML->new->parse_html_string($content);
24    for my $elem ($doc->findnodes('//a')) {
25        if (my $href = $elem->getAttribute('href')) {
26            if ($href =~ m{^/}) {
27                $elem->setAttribute(href => $root . $href);
28            }
29        }
30    }
31    for my $elem ($doc->findnodes('//link')) {
32        $elem->setAttribute(href => $root . $elem->getAttribute('href'));
33    }
34    for my $elem ($doc->findnodes('//script')) {
35        $elem->setAttribute(src => $root . $elem->getAttribute('src'));
36    }
37
38    U $doc->toStringHTML;
39}
40
411;
42__END__
43
44=head1 NAME
45
46App::Mobirc::Plugin::DocRoot - rewrite document root
47
48=head1 SYNOPSIS
49
50    - module: App::Mobirc::Plugin::DocRoot
51      config:
52        root: /foo/
53
54=head1 DESCRIPTION
55
56rewrite path.
57
58=head1 AUTHOR
59
60Tokuhiro Matsuno
61
62=head1 SEE ALSO
63
64L<App::Mobirc>
65
Note: See TracBrowser for help on using the browser.