Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 191 lines (161 sloc) 5.395 kb
7725dae @mizzy Change shebang suit for perlbrew environment and so on.
authored
1 #!/usr/bin/env perl
1434a9c @mizzy Initial commit
authored
2
3 use strict;
4 use warnings;
5 use JSON::Syck;
6 use LWP::Simple;
7 use URI;
8 use HTML::TreeBuilder::XPath;
9 use Text::Xslate;
10 use Image::Resize;
11
12 my $style = HTML::Element->new('style');
13 $style->attr('type', 'text/css');
14 $style->push_content(<<STYLE);
15 h1, h2, h3, h4, h5, h6, p, ul, ol, dl, pre, blockquote, table
16 {margin-top:0.6em; text-indent:0em;}
17 .font_size
18 {font-size:x-large;}
19 STYLE
20
0b7c856 @mizzy If URL is no given, fall back to STDIN
authored
21 my $uri = shift;
577b6db @mizzy fix.
authored
22 my $book = $uri ? JSON::Syck::Load(get($uri)) : JSON::Syck::Load(do { local $/; <STDIN> });
1434a9c @mizzy Initial commit
authored
23
24 mkdir 'tmp' unless -d 'tmp';
25 mkdir 'out' unless -d 'out';
26
27 # Get cover image
28 if ( $book->{cover_image} ) {
29 my $uri = URI->new($book->{cover_image});
30 my $file = ($uri->path_segments)[-1];
31 mirror($uri, "out/$file") unless -f "out/$file";
32 $book->{cover_file} = $file;
33 my $image = Image::Resize->new("out/$file");
34 my $gd = $image->resize(600, 800);
35 open my $out, '>', "out/$file" or die $!;
36 print $out $gd->jpeg;
37 close $out;
38 }
39
b1dc812 @mizzy Support pats as higher level of chapters
authored
40 $book->{parts}->[0]->{chapters} = $book->{chapters} unless $book->{parts};
41
42 for my $part ( @{ $book->{parts} } ) {
34d05af @mizzy Missed geting parts
authored
43 get_content($part);
b1dc812 @mizzy Support pats as higher level of chapters
authored
44 for my $chapter ( @{ $part->{chapters} } ) {
45 get_content($chapter);
46 for my $section ( @{ $chapter->{sections} } ) {
47 get_content($section);
48 for my $subsection ( @{ $section->{subsections} } ) {
49 get_content($subsection);
50 }
1434a9c @mizzy Initial commit
authored
51 }
52 }
53 }
54
55 my $tx = Text::Xslate->new( syntax => 'TTerse' );
56
57 warn "Writing index.html ...\n";
58 open my $out, '>', 'out/index.html' or die $!;
59 print $out $tx->render('index.tx', $book);
60 close $out;
61
62 warn "Writing toc.ncx ...\n";
63 open $out, '>', 'out/toc.ncx' or die $!;
64 print $out $tx->render('ncx.tx', $book);
65 close $out;
66
67 my $book_title = $book->{title};
68 $book_title =~ s/\s/_/g;
69
e6fde63 @mizzy some fixes
authored
70 set_startup_page($book);
71
1434a9c @mizzy Initial commit
authored
72 warn "Writing ${book_title}.opf ...\n";
73 open $out, '>', "out/${book_title}.opf" or die $!;
74 print $out $tx->render('opf.tx', $book);
75 close $out;
76
77 warn "Executing kindlegen ...\n";
78 `kindlegen out/${book_title}.opf`;
79
80 exit;
81
82 sub get_content {
83 my $object = shift;
84 return if !$object->{uri};
85
86 my $uri = URI->new($object->{uri});
87 my $file = ($uri->path_segments)[-1];
88 my $fragment = $uri->fragment;
89
e6fde63 @mizzy some fixes
authored
90 $file =~ s/\..+/.html/ unless $file =~ /\.html$/;
0cfbca2 @youpy add .html if no extension
youpy authored
91 $file .= '.html' unless $file =~ /\.html$/; # add .html if no extension
e6fde63 @mizzy some fixes
authored
92 $object->{file} = $file;
93 $object->{href} = $fragment ? "$file#$fragment" : $file;
94
95 return if -f "tmp/$file";
96
3f20037 @mizzy Show message if getting files actually
authored
97 warn "Getting $object->{title} ...\n";
e6fde63 @mizzy some fixes
authored
98 mirror($uri, "tmp/$file");
1434a9c @mizzy Initial commit
authored
99
100 my $tree = HTML::TreeBuilder::XPath->new;
e61b659 @mizzy Call $tree->no_expand_entities(1) to avoid HTML entities decoded.fix #7.
authored
101 $tree->no_expand_entities(1);
1434a9c @mizzy Initial commit
authored
102 $tree->parse_file("tmp/$file");
e61b659 @mizzy Call $tree->no_expand_entities(1) to avoid HTML entities decoded.fix #7.
authored
103 $tree->eof;
1434a9c @mizzy Initial commit
authored
104
105 if ( $book->{content_xpath} ) {
0b50780 @Cside included meta elements to avoid garbage characters
Cside authored
106 my $content = ($tree->findnodes($book->{content_xpath}))[0]->as_XML;
107 my $meta = join '', map { $_->as_XML } $tree->findnodes('//head/meta');
1434a9c @mizzy Initial commit
authored
108 $tree = HTML::TreeBuilder::XPath->new;
49e9e5e @mizzy Recover deleted line.
authored
109 $tree->no_expand_entities(1);
0b50780 @Cside included meta elements to avoid garbage characters
Cside authored
110 $tree->parse(<<"HTML");
111 <html>
112 <head>
113 $meta
114 </head>
115 <body>
116 $content
117 </body>
118 </html>
119 HTML
1434a9c @mizzy Initial commit
authored
120 $tree->eof;
121 }
122
123 if ( $book->{exclude_xpath} ) {
124 my @excludes = ($tree->findnodes($book->{exclude_xpath}));
125 for my $exclude ( @excludes ) {
126 $exclude->detach;
127 }
128 }
129
9f5dc4f @mizzy Get css files and use this files instead of default style of webiblo.
authored
130 my @links = $tree->findnodes('//link[@rel="stylesheet"]');
131 for my $link ( @links ) {
132 warn "Getting $uri ...\n";
133 my $href = $link->attr('href');
134 my $base = $uri->as_string;
135 $base =~ s{/[^/]+$}{};
136 $href = "$base/$href" if $href !~ m!^https?://!;
137 my $file = (URI->new($href)->path_segments)[-1];
138 mirror($href, "out/$file") unless -f "out/$file";
139 }
1434a9c @mizzy Initial commit
authored
140
9f5dc4f @mizzy Get css files and use this files instead of default style of webiblo.
authored
141 if ( ! scalar @links ) {
142 my $head = ($tree->findnodes('/html/head'))[0];
143 $head->push_content($style)
144 };
e6fde63 @mizzy some fixes
authored
145
1434a9c @mizzy Initial commit
authored
146 my @images = $tree->findnodes('//img');
147 for my $image ( @images ) {
e6fde63 @mizzy some fixes
authored
148 warn "Getting $uri ...\n";
149 my $src = $image->attr('src');
1434a9c @mizzy Initial commit
authored
150 my $base = $uri->as_string;
151 $base =~ s{/[^/]+$}{};
e6fde63 @mizzy some fixes
authored
152 $src = "$base/$src" if $src !~ m!^https?://!;
153 my $file = (URI->new($src)->path_segments)[-1];
154 mirror($src, "out/$file") unless -f "out/$file";
192b031 @mizzy Quit separate getting image to a function and rewrite image path in HTML...
authored
155 $image->attr('src', $file);
1434a9c @mizzy Initial commit
authored
156 }
157
158 open my $out, '>', "out/$file" or die $!;
a1f8ec3 @mizzy Revert "onclick attributes cause errors.So sanitize them."
authored
159 print $out $tree->as_XML;
1434a9c @mizzy Initial commit
authored
160 close $out;
e6fde63 @mizzy some fixes
authored
161 }
1434a9c @mizzy Initial commit
authored
162
e6fde63 @mizzy some fixes
authored
163 sub set_startup_page {
164 my $book = shift;
165
166 for my $part ( @{ $book->{parts} } ) {
167 if ( $part->{href} ) {
168 $book->{startup_page} = $part->{href};
169 return;
170 }
171 for my $chapter ( @{ $part->{chapters} } ) {
172 if ( $chapter->{href} ) {
173 $book->{startup_page} = $chapter->{href};
174 return;
175 for my $section ( @{ $chapter->{sections} } ) {
176 if ( $section->{href} ) {
177 $book->{startup_page} = $section->{href};
178 return;
179 }
180 for my $subsection ( @{ $section->{subsections} } ) {
181 if ( $subsection->{href} ) {
182 $book->{startup_page} = $subsection->{href};
183 return;
184 }
185 }
186 }
187 }
188 }
189 }
1434a9c @mizzy Initial commit
authored
190 }
Something went wrong with that request. Please try again.