author | Pranshu Sharma <pranshu@bauherren.ovh> |
Wed, 18 Dec 2024 02:18:43 +1000 | |
changeset 14 | 31e45dd2a894 |
parent 13 | da3b9ba1a7f0 |
child 15 | c8e6e4e514f3 |
permissions | -rwxr-xr-x |
0 | 1 |
#!/usr/bin/perl |
1
0b7be2e78d3b
Added more documentation
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
0
diff
changeset
|
2 |
# Author: Pranshu Sharma <pranshu@bauherren.ovh> |
0 | 3 |
|
4 |
use v5.36.0; |
|
5 |
use strict; |
|
6 |
use warnings; |
|
7 |
||
8 |
use XML::LibXML; |
|
9 |
use File::Find; |
|
10 |
use File::Copy qw(copy move); |
|
11 |
use Cwd; |
|
12 |
use experimental qw(declared_refs); |
|
13 |
use Data::Dumper; |
|
5 | 14 |
use POSIX; |
7 | 15 |
# !! Add seperatio between title and identifier |
0 | 16 |
|
17 |
# Fix up CLI interface |
|
18 |
# Add option ro set cache to 0 through command line |
|
19 |
# Print required elisp code it is in $req_config |
|
20 |
# Add config option for $max_rss and $max_cat |
|
8 | 21 |
# Document link to file x from file x no work |
0 | 22 |
# Variable for map_css |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
23 |
# Remove the desc |
0 | 24 |
# Domain thing as well |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
25 |
# 2 articles 1 day better sorting |
7 | 26 |
# cataogry linking |
0 | 27 |
my $cache = 1; |
28 |
||
29 |
my $config_file = "genorg-conf"; |
|
30 |
my $dir = "blog"; |
|
31 |
my $outdir = "out/"; |
|
32 |
my $emacs = "emacs"; |
|
8 | 33 |
my $art_css = "astyle.css"; |
34 |
my $cat_css ="cstyle.css"; |
|
0 | 35 |
my $no_name_dir = "c"; |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
36 |
my $cache_file = "genorg-cache/cache.xml"; |
0 | 37 |
my $domain = "p.bauherren.ovh"; |
38 |
my $max_rss = 30; |
|
39 |
# The first page has one less article. Think of it as a feature. |
|
14 | 40 |
my $max_cat = 30; |
8 | 41 |
my $blog_title = "Pranshu's blog"; |
9 | 42 |
my ($home, $about) = ("home.html", "about.html"); |
43 |
my $etc_files; |
|
44 |
my $nav_id = "nav"; |
|
14 | 45 |
my $rdesc = "description"; |
0 | 46 |
|
47 |
my $username = $ENV{LOGNAME} || $ENV{USER} || getpwuid ($<); |
|
48 |
my $template = <<"END"; |
|
49 |
#+title: Test document |
|
50 |
#+subtitle: This is the subtitle |
|
14 | 51 |
#+date: IMPORANT |
0 | 52 |
#+author: $username |
14 | 53 |
#+keywords: tag->thing | rel->a |
0 | 54 |
#+options: html-link-use-abs-url:nil html-postamble:auto |
55 |
#+options: html-preamble:t html-scripts:nil html-style:t |
|
56 |
#+options: html5-fancy:nil tex:t |
|
57 |
#+html_doctype: html5 |
|
58 |
END |
|
59 |
||
60 |
my $req_config = <<"END"; |
|
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
61 |
(require 'org) |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
62 |
(require 'ob) |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
63 |
(org-link-set-parameters "genorg" |
0 | 64 |
:follow nil |
65 |
:export |
|
66 |
#'(lambda (link desc _ _) |
|
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
67 |
(format "<a class=\"rakim\" href=\"%s\">%s</a>" desc link)) |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
68 |
:store nil) |
0 | 69 |
END |
70 |
||
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
71 |
my $custom_code = "(list 1)"; |
5 | 72 |
|
8 | 73 |
my $navbar = <<"END" =~ s/\n\s+//gr; |
74 |
<ul> |
|
9 | 75 |
<li> <a href="LINK">Home</a> </li> |
76 |
<li> <a href="LINK">Catagories</a> </li> |
|
77 |
<li> <a href="LINK">About</a> </li> |
|
8 | 78 |
</ul> |
79 |
END |
|
80 |
||
0 | 81 |
my $elisp_code = <<"END" =~ s/\n\s+//gr; |
82 |
(let ((ls '(LIST))) |
|
83 |
(require 'org) |
|
84 |
(mapc |
|
85 |
(lambda (b) |
|
86 |
(with-current-buffer b |
|
87 |
(when (and (not (string-match "^ " (buffer-name b))) |
|
88 |
(eq major-mode 'org-mode)) |
|
89 |
(org-export-to-file 'html (pop ls))))) |
|
90 |
(buffer-list)) |
|
9 | 91 |
(kill-emacs)) |
0 | 92 |
END |
93 |
||
94 |
||
95 |
my ($h_intro, $h_c_intro, $h_cat_li, $h_chap, $h_en_cat, $h_en, $h_end) |
|
96 |
= split /SPLIT/ ,<<"END" =~ s/\n\s+//gr; |
|
97 |
<!DOCTYPE html> |
|
98 |
<html lang="en"> |
|
99 |
<head> |
|
100 |
<meta charset="UTF-8"> |
|
101 |
<meta name="viewport" content="width=device-width, initial-scale=1.0"> |
|
102 |
<title>TITLE</title> |
|
8 | 103 |
<link rel="stylesheet" href="CSS"> |
0 | 104 |
</head> |
8 | 105 |
<body> |
106 |
NAV |
|
107 |
<h1> BTIT </h1> |
|
0 | 108 |
SPLIT |
109 |
<ul id="cataogries"> |
|
110 |
SPLIT |
|
111 |
<li> <a href="LINK"> CATAG (NUMBER)</a> |
|
112 |
SPLIT |
|
113 |
</ul> |
|
114 |
<div> |
|
8 | 115 |
<h2> All articles <a id="rss" href="rss.xml">(rss)</span> </h2> <hr> |
0 | 116 |
SPLIT |
117 |
<a href="LINK"> |
|
8 | 118 |
<strong> TITLE </strong> <span>DATE</span> <i>CATAG</i> |
0 | 119 |
<hr> |
120 |
</a> |
|
121 |
SPLIT |
|
122 |
<a href="LINK"> |
|
123 |
<strong> TITLE </strong> <span>DATE</span> |
|
124 |
<hr> |
|
125 |
</a> |
|
126 |
SPLIT |
|
127 |
</div> |
|
128 |
</body> |
|
129 |
</html> |
|
130 |
END |
|
131 |
||
132 |
my $help = <<"END"; |
|
133 |
genorg [option] [dir|file] |
|
134 |
Option can be: |
|
135 |
-t FILE : Make a template org file at FILE |
|
136 |
-h : Help |
|
137 |
-c FILE : sepcify a new config file instead of genorg-conf |
|
138 |
-r : unconditionally remake org files |
|
139 |
||
140 |
If no option is set, accept a directory to generate. |
|
141 |
||
142 |
$config_file follow the syntax of: |
|
143 |
VAR VALUE |
|
144 |
where VAR can be: |
|
145 |
emacs-path : The value should be path of emacs. 'emacs' by default. |
|
14 | 146 |
acss : The path of the css file to use for articles. |
147 |
ccss : Path of css to use for cataogry pages. |
|
0 | 148 |
in_dir : The directory that contains the files. |
149 |
out_dir : the output directory. |
|
150 |
no_name_dir: The directory for generate files. This means in_dir/no_name_dir |
|
151 |
cannot exist. |
|
12
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
152 |
etc_files : Space sperated list of files to be navved up |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
153 |
cache : xml cache file |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
154 |
home : home file |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
155 |
about : about file |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
156 |
domain : domain (for rss) |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
157 |
title : title of the blog |
14 | 158 |
max_rss : max_rss entries |
159 |
max_cat : max catagory entries before next page |
|
13 | 160 |
|
161 |
As soon as config file comes accross '>>---', the rest of the file |
|
162 |
is now the elisp code used in emacs startup. |
|
0 | 163 |
END |
164 |
||
165 |
||
166 |
my $rss_entry = <<"END" =~ s/\n\s+//gr; |
|
167 |
<?xml version=\"1.0\" encoding=\"UTF-8\" ?> |
|
168 |
<rss version=\"2.0\"> |
|
169 |
<channel> |
|
14 | 170 |
<title>TITLE</title> |
171 |
<link>BLINK</link> |
|
172 |
<description>RDESC</description>" |
|
0 | 173 |
END |
174 |
||
175 |
my %config_vars = |
|
176 |
( |
|
177 |
'emacs-path' => \$emacs, |
|
14 | 178 |
acss => \$art_css, |
179 |
ccss => \$cat_css, |
|
0 | 180 |
indir => \$dir, |
181 |
outdir => \$outdir, |
|
9 | 182 |
no_name_dir => \$no_name_dir, |
12
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
183 |
etc_files => \$etc_files, |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
184 |
cache => \$cache_file, |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
185 |
home => \$home, |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
186 |
about => \$about, |
1be91608b33c
addded way more cusotmisation options and fixed up docu
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
11
diff
changeset
|
187 |
domain => \$domain, |
14 | 188 |
title => \$blog_title, |
189 |
rdesc => \$rdesc, |
|
190 |
max_rss => \$max_rss, |
|
191 |
max_cat => \$max_cat |
|
0 | 192 |
); |
193 |
||
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
194 |
|
0 | 195 |
sub read_config ($path) { |
196 |
open my $fh, '<', $path or die "Couldn't open config file\n"; |
|
197 |
while (<$fh>) { |
|
198 |
next if /^\s+$/; |
|
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
199 |
if (/^>>---+/) { |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
200 |
local $/; |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
201 |
$custom_code = <$fh>; |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
202 |
return; |
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
203 |
} |
0 | 204 |
chomp; |
205 |
my ($directive, $rest) = split /\s+/, $_, 2; |
|
14 | 206 |
if (exists $config_vars{$directive}) { |
0 | 207 |
${$config_vars{$directive}} = $rest; |
208 |
} else { |
|
14 | 209 |
die "Unknown variable $directive\n"; |
0 | 210 |
} |
211 |
} |
|
212 |
close $fh; |
|
213 |
} |
|
214 |
||
215 |
sub help_and_bye { |
|
216 |
print $help; |
|
217 |
exit; |
|
218 |
} |
|
219 |
||
220 |
sub template ($file) { |
|
14 | 221 |
$file // do {print $template; exit(1)}; |
0 | 222 |
$file =~ s/\.org$//; |
223 |
open my $fh, '>', $file . ".org" or die $file . " couldn't be opened\n"; |
|
224 |
print $fh $template; |
|
225 |
close $fh; |
|
226 |
} |
|
227 |
||
228 |
# Reletive file from the perspect of file1, to file2 |
|
229 |
sub prel_path ($from, $to) { |
|
14 | 230 |
return $to if $from eq $to; |
0 | 231 |
my \(@f1, @f2) = map [m{/[^/]+}g], ($from, $to); |
232 |
# return substr($f1[$#f1], 1) if $from =~ $to; |
|
233 |
while (@f1 && @f2 && $f1[0] =~ $f2[0]) { |
|
234 |
shift @f1; |
|
235 |
shift @f2; |
|
236 |
} |
|
237 |
my $p = @f1-1; |
|
238 |
local $" = ""; |
|
239 |
"../" x ($p > 0 ? $p : 0) . substr("@f2", 1); |
|
240 |
} |
|
241 |
||
242 |
my @org_exps; |
|
243 |
my @files_to_make; |
|
7 | 244 |
my @files_to_move; |
9 | 245 |
my @navify_files; |
0 | 246 |
|
247 |
sub wanted { |
|
248 |
my $n_path = $outdir . prel_path ($dir, "$File::Find::name/"); |
|
249 |
# We need to mirror the direcotry structure |
|
250 |
if (-d) { |
|
251 |
push @files_to_make, $n_path || die "Couldn't make directory $n_path\n" |
|
252 |
unless -d $n_path; |
|
253 |
return; |
|
254 |
} |
|
255 |
if (/\.org$/) { |
|
256 |
push @org_exps, substr $n_path, length($outdir); |
|
257 |
} else { |
|
7 | 258 |
push @files_to_move, $File::Find::name |
0 | 259 |
} |
9 | 260 |
|
0 | 261 |
} |
262 |
||
3 | 263 |
my @modified_files; |
0 | 264 |
|
265 |
# Export @org_exps |
|
266 |
sub conv_files { |
|
267 |
my %changed_files; |
|
268 |
# Remove files that are already converted |
|
269 |
for my $rel_file (@org_exps) { |
|
270 |
# Emacs need the full file path |
|
271 |
my ($file, $to) = map { getcwd . "/$_" . $rel_file} ($dir, $outdir); |
|
272 |
s/org$/html/ for ($to, $rel_file); |
|
273 |
unless ($cache && -f $to && (stat($to))[9] > (stat($file))[9]) { |
|
274 |
$changed_files{$file} = $to; |
|
3 | 275 |
push @modified_files, $rel_file; |
0 | 276 |
} |
277 |
} |
|
278 |
%changed_files // exit; |
|
279 |
$elisp_code =~ s/LIST/join '', map "\"$_\" ", values %changed_files /e; |
|
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
280 |
open my $fh, '-|', ($emacs, '-Q','--eval', "(progn $custom_code)", keys %changed_files, "--eval" , "$elisp_code"); |
0 | 281 |
close $fh; |
282 |
\%changed_files |
|
283 |
} |
|
284 |
||
285 |
my $cdir; |
|
286 |
||
287 |
$ARGV[0] // die "No arguments provided\n"; |
|
288 |
while ($_ = shift @ARGV) { |
|
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
289 |
/^-c$/ && do { print "$req_config\n"; exit }; |
0 | 290 |
/^(-h|--?help)$/ && help_and_bye; |
291 |
/^-t$/ && do { template shift @ARGV ; exit }; |
|
292 |
/^-c$/ && do { $config_file = shift @ARGV; next }; |
|
293 |
/^-d$/ && do { $cache = 0; next }; |
|
294 |
$cdir = $_; |
|
295 |
} |
|
296 |
$cdir || die "directory not provided\n"; |
|
297 |
main(); |
|
298 |
||
299 |
my %catags; |
|
300 |
my @arts; |
|
3 | 301 |
my $cache_dom; |
0 | 302 |
|
303 |
sub main { |
|
14 | 304 |
-d $cdir or help_and_bye; |
305 |
mkdir $outdir; |
|
306 |
chdir $cdir or die "Couldn't access $cdir\n"; |
|
307 |
read_config $config_file; |
|
308 |
s!/*$!/! for ($outdir, $dir); |
|
309 |
my @navify_files = map {"$dir$_"} ($about, $home, $etc_files ? split(/[ \t]+/, $etc_files) : ()); |
|
310 |
-d $dir or die "$dir doesn't exist \n"; |
|
311 |
find (\&wanted, $dir); |
|
312 |
for my $f (@files_to_move) { |
|
313 |
my $dest = $f =~ s#$dir/?#$outdir#er; |
|
314 |
if (grep(m#^$f$#, @navify_files)) { |
|
315 |
# YAY we have to sub navbar and copy whoop whoop |
|
316 |
open my $file_tc, '<', $f or die "file no open, grrr!"; |
|
317 |
open my $file_out, '>', $dest; |
|
318 |
local $/; |
|
319 |
print $file_out ((<$file_tc>) =~ s/NAV/nav_up("$dest" =~ s%.+?\/%%r,1)/er); |
|
320 |
map \&close, ($file_tc, $file_out); |
|
321 |
} else { |
|
322 |
copy $f, $dest; |
|
8 | 323 |
} |
14 | 324 |
} |
325 |
mkdir for @files_to_make; |
|
326 |
values %{conv_files()}; |
|
327 |
$cache_dom = XML::LibXML->load_xml(location => $cache_file) if $cache && -f $cache_file; |
|
328 |
chdir $outdir; |
|
329 |
@arts = sort { $b->{date} <=> $a->{date}} map { html_fixup($_) } @org_exps; |
|
330 |
finalise_html(); |
|
331 |
chdir '..'; |
|
332 |
populate_cache(); |
|
3 | 333 |
} |
334 |
||
335 |
sub populate_cache { |
|
336 |
my $dom = XML::LibXML::Document->new('1.0', 'UTF-8'); |
|
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
337 |
my $root = $dom->createElement('root'); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
338 |
my %c_els; |
3 | 339 |
for my $art (@arts) { |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
340 |
# We need the: related, file, date |
8 | 341 |
my ($art_el, $date, $title, $ca, $related, $utitle) = |
342 |
map {$dom->createElement($_)} ("art", "date", "title", "catag", "related", "utitle"); |
|
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
343 |
$art_el->{path} = $art->{file}; |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
344 |
$ca->appendText($art->{catag}); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
345 |
$title->appendText($art->{title}); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
346 |
$date->appendText($art->{date}->text_easy); |
8 | 347 |
$utitle->appendText($art->{utitle}); |
7 | 348 |
my @ll = @{$art->{links}}; |
349 |
if (@ll) { |
|
350 |
my $links = $dom->createElement('links'); |
|
351 |
for (@ll) { |
|
352 |
my $link = $dom->createElement("link"); |
|
353 |
$link->{catag} = $_->[0]; |
|
354 |
$link->appendText($_->[1]); |
|
355 |
$links->appendChild($link); |
|
356 |
} |
|
357 |
$art_el->appendChild($links); |
|
358 |
} |
|
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
359 |
my $rel_str; |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
360 |
for my $thing ($art->{related}) { |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
361 |
for (@{$thing}) { |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
362 |
my ($catag, $artt) = @{$_}; |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
363 |
my $rel_str .= "\"$catag\"" . ($artt && "->\"$artt\""); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
364 |
$related->appendText("\"$catag\"" . ($artt && "->\"$artt\" ")); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
365 |
} |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
366 |
} |
8 | 367 |
$art_el->appendChild($_) for ($date, $ca, $related, $title, $utitle); |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
368 |
$root->appendChild($art_el); |
3 | 369 |
} |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
370 |
$root->appendChild($_) for values %c_els; |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
371 |
$dom->setDocumentElement($root); |
5 | 372 |
open my $fh, '>' , $cache_file; |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
373 |
print $fh ($dom->toString(1) =~ s/(.+)/$1\n<!-- Nicley formated :() -->/r); |
3 | 374 |
close $fh; |
0 | 375 |
} |
376 |
||
377 |
sub entry { |
|
378 |
my ($data, $catagory) = @_; |
|
379 |
my $str = defined $catagory |
|
380 |
? ($h_en_cat =~ s/CATAG/$data->{catag}/er) : $h_en; |
|
381 |
my $prel_path = "/$no_name_dir/" . (defined $catagory ? "c" : "c/b"); |
|
382 |
$str =~ s/DATE/$data->{date}->fmt/er |
|
8 | 383 |
=~ s/TITLE/$data->{utitle}/er |
0 | 384 |
=~ s|LINK|prel_path($prel_path, '/'. $data->{file})|er |
385 |
} |
|
386 |
||
387 |
sub rss_en ($data) { |
|
388 |
my $thing = <<"END" =~ s/\n\s+//gr; |
|
5 | 389 |
<item> |
0 | 390 |
<title>TITLE</title> |
391 |
<link>LINK</link> |
|
392 |
<description>DESC</description> |
|
393 |
</item> |
|
394 |
END |
|
8 | 395 |
$thing |
396 |
=~ s|LINK|"$domain/" . $data->{file}|er |
|
397 |
=~ s/TITLE/$data->{utitle}/er; |
|
0 | 398 |
} |
399 |
||
400 |
sub min ($x, $y) { |
|
401 |
($x, $y)[$x > $y] |
|
402 |
} |
|
403 |
||
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
404 |
# @_ has to be in format of [STRING, LINK] |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
405 |
sub list2paginaiton { |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
406 |
my $page = shift; |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
407 |
'<ul>' . join ("", map { |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
408 |
my ($str, $file) = @{$_}; |
8 | 409 |
$str = "<span class=\"psel\">$str</span>" if $file && ($file == $page); |
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
410 |
defined $file ? |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
411 |
"<li><a href=\"$file.html\">$str</a>" : $str |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
412 |
} ((["←", $page - 1]) x!! ($page - 1), |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
413 |
@_, |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
414 |
(["→", $page + 1]) x ($page != $_[$#_]->[1]))) . '</ul>' |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
415 |
} |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
416 |
|
9 | 417 |
sub move_on_if_neccasary ($fh, $art_num, $total_articles, $path, $title, $rp) { |
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
418 |
return $fh if $art_num == 0 || $art_num % $max_cat; |
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
419 |
my $cpage = $art_num / $max_cat; |
5 | 420 |
print $fh panigation($cpage, ceil($total_articles / $max_cat), $path); |
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
421 |
open $fh, '>', $path . '/' . ($cpage + 1).'.html'; |
9 | 422 |
# ($h_intro . $h_c_intro, $blog_title, "a/c"); |
423 |
print $fh cssbs($h_intro, $title, $rp); |
|
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
424 |
$fh; |
0 | 425 |
} |
426 |
||
3 | 427 |
sub panigation ($page, $no_pages, $dir) { |
428 |
if ($no_pages < 9) { |
|
429 |
list2paginaiton ($page, (map [$_, $_], (1..$no_pages))) |
|
430 |
} elsif (4 < $page <= ($no_pages - 4)) { |
|
431 |
list2paginaiton |
|
432 |
($page, |
|
433 |
[1, 1], |
|
434 |
["<li>..."], |
|
435 |
(map [$_, $_], (($page-2)..($page+2))), |
|
436 |
["<li>..."], |
|
437 |
[($no_pages) x 2]) |
|
438 |
} elsif ($page < 6) { |
|
439 |
list2paginaiton $page, |
|
440 |
((map [$_, $_], (1..5)), |
|
441 |
["<li>..."], |
|
442 |
[($no_pages) x 2]) |
|
443 |
} else { |
|
444 |
list2paginaiton $page, |
|
445 |
([1,1], |
|
446 |
["<li>..."], |
|
447 |
(map [$_, $_], (($no_pages - 5)..$no_pages))) |
|
448 |
} |
|
449 |
} |
|
450 |
||
7 | 451 |
sub get_art($cat, $id) { |
452 |
for (@arts) { |
|
453 |
return $_ if $_->{catag} eq $cat && $_->{title} eq $id |
|
454 |
} |
|
5 | 455 |
} |
456 |
||
9 | 457 |
sub nav_up { |
458 |
my ($path) = @_; |
|
459 |
my @links = ($home, 'c/1.html', $about); |
|
14 | 460 |
my $nav = shift ? "<div class=\"$nav_id\">$navbar</div>" : $navbar; |
9 | 461 |
$nav =~ s#LINK#prel_path("/$path", "/". shift @links)#ger; |
462 |
} |
|
463 |
||
8 | 464 |
sub cssbs($s,$t,$p){ |
465 |
$s =~ s|CSS|prel_path("/$p","/$cat_css")|er |
|
466 |
=~ s/TITLE|BTIT/$t/ger |
|
14 | 467 |
=~ s/NAV/nav_up($p,1)/er; |
9 | 468 |
} |
469 |
||
470 |
sub modify_art ($file, $dom) { |
|
471 |
# I guess we can rely on navbar not changed, if it did then user |
|
472 |
# would need to call with -d option |
|
473 |
return $dom unless grep /^$file$/, @modified_files; |
|
474 |
# We add css, navbar |
|
475 |
for ($dom->findnodes('/html/body')) { |
|
476 |
# my @cds = $_->childNodes; |
|
477 |
my $nav_el = $dom->createElement('div'); |
|
14 | 478 |
$nav_el->{class} = $nav_id; |
9 | 479 |
$nav_el->appendWellBalancedChunk(nav_up($file)); |
480 |
$_->insertBefore($nav_el, $_->childNodes->[0]) |
|
481 |
} |
|
482 |
for ($dom->findnodes('/html/head')) { |
|
483 |
my $link = $dom->createElement('link'); |
|
484 |
$link->{rel} = "stylesheet"; |
|
485 |
$link->{href} = prel_path("/$file", "/$art_css"); |
|
486 |
$_->appendChild($link); |
|
487 |
} |
|
488 |
$dom; |
|
8 | 489 |
} |
490 |
||
14 | 491 |
sub rss_st { |
492 |
$rss_entry |
|
493 |
=~ s/TITLE/$blog_title/er |
|
494 |
=~ s/BLINK/$domain/er |
|
495 |
=~ s/RDESC/$rdesc/er; |
|
496 |
} |
|
497 |
||
0 | 498 |
sub finalise_html { |
499 |
mkdir $no_name_dir; |
|
500 |
open my $fh, '>', "$no_name_dir/1.html"; |
|
501 |
open my $mrss, '>', "$no_name_dir/rss.xml"; # The master rss file |
|
14 | 502 |
print $mrss rss_st(); |
8 | 503 |
print $fh cssbs($h_intro . $h_c_intro, $blog_title, "a/c"); |
0 | 504 |
my (%c_files, %r_files); # Cataogry files and rss |
8 | 505 |
|
506 |
for my $cat (sort { $catags{$b} <=> $catags{$a} } keys(%catags)) { |
|
507 |
my $num = $catags{$cat}; |
|
0 | 508 |
# ($h_intro, $h_c_intro, $h_cat_li, $h_chap, $h_en_cat, $h_en, $h_end) |
509 |
print $fh $h_cat_li =~ s/NUMBER/$num/re |
|
3 | 510 |
=~ s/CATAG/$cat/er |
511 |
=~ s=LINK="$cat/1.html"=er; |
|
0 | 512 |
mkdir "$no_name_dir/$cat"; |
513 |
open $c_files{$cat}, '>', "$no_name_dir/$cat/1.html"; |
|
514 |
open $r_files{$cat}, '>', "$no_name_dir/$cat/rss.xml"; |
|
14 | 515 |
print {$r_files{$cat}} rss_st(); |
8 | 516 |
print {$c_files{$cat}} |
517 |
cssbs($h_intro, "$cat <a id=\"rss\" href=\"rss.xml\">(rss)</span> ", "a/b/c"); |
|
0 | 518 |
} |
519 |
print $fh $h_chap; |
|
520 |
# :-) |
|
521 |
my $total_articles = () = map {(1)x$_} values %catags; |
|
522 |
# Now we iterate through the articles and add their index |
|
523 |
my ($n_fh, $n_mrss, %n_rss) = (0,0); |
|
524 |
my %n_cat; |
|
525 |
for my $art (@arts) { |
|
8 | 526 |
# TODO do we need $title? |
0 | 527 |
my ($catag, $title) = @{$art}{qw(catag title)}; |
528 |
my $rentry = rss_en $art; |
|
529 |
if (($n_rss{$catag} // 0) < $max_rss) { |
|
530 |
print {$r_files{$catag}} $rentry; |
|
531 |
++$n_rss{$catag}; |
|
532 |
} |
|
533 |
if ($n_mrss < $max_rss) { |
|
534 |
print $mrss $rentry; |
|
535 |
++$n_mrss |
|
536 |
} |
|
2
c4ca65113229
Pagination major progress
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
1
diff
changeset
|
537 |
# ($fh, $art_num, $total_articles, $path) |
9 | 538 |
$fh = move_on_if_neccasary |
539 |
$fh, $n_fh, $total_articles, $no_name_dir, "All articles", "a/c"; |
|
0 | 540 |
$n_fh++; |
541 |
print $fh entry $art, 1; |
|
3 | 542 |
my $ncat = \$n_cat{$catag}; |
543 |
++$$ncat; |
|
544 |
my $cfh = \$c_files{$catag}; |
|
9 | 545 |
$$cfh = move_on_if_neccasary |
546 |
$$cfh, $$ncat, $catags{$catag}, "$no_name_dir/$catag", $catag, "a/c/b"; |
|
3 | 547 |
print {$$cfh} entry $art; |
548 |
my $a_file = $art->{file}; |
|
7 | 549 |
if (1 or grep /^$a_file$/, @modified_files) { |
9 | 550 |
my $doom = modify_art($a_file, linkify($art)); |
3 | 551 |
open my $h_file, '>', $a_file; |
7 | 552 |
print $h_file $doom->toStringHTML; |
3 | 553 |
close $h_file; |
554 |
} |
|
0 | 555 |
} |
5 | 556 |
print $fh panigation ((ceil $n_fh / $max_cat) x 2, $no_name_dir) if $max_cat < $total_articles; |
0 | 557 |
print $fh $h_end; |
558 |
close $fh; |
|
559 |
for (values %c_files) { |
|
560 |
print $_ $h_end; |
|
7 | 561 |
close $_; |
0 | 562 |
} |
563 |
print $mrss '</channel> </rss>'; |
|
564 |
for (values %r_files) { |
|
565 |
print $_ '</channel> </rss>';; |
|
7 | 566 |
close $_; |
0 | 567 |
} |
568 |
} |
|
569 |
||
7 | 570 |
sub linkify ($art) { |
571 |
# if $art->{dom} is undefined, we must sadly parse again |
|
572 |
my @links; |
|
573 |
my @olinks = @{$art->{links} //[]}; |
|
574 |
my $bom = $art->{dom} // XML::LibXML->load_html(location => $art->{file}); |
|
575 |
for ($bom->findnodes('//a[@class="rakim"]')) { |
|
576 |
my $key; |
|
577 |
my $link_text; |
|
578 |
if (@olinks) { |
|
579 |
$key = pop @olinks; |
|
580 |
} else { |
|
581 |
($key) = parse_keywords($_->to_literal); |
|
582 |
$link_text = $_->{href}; |
|
583 |
$_->removeChild($_->firstChild()); |
|
584 |
$_->appendText($link_text); |
|
585 |
} |
|
586 |
push @links, $key; |
|
587 |
my $l = get_art(@{$key})->{file} or die "Link not found in $art->{filename}\n"; |
|
588 |
$_->{href} = prel_path("/".$art->{file}, "/$l"); |
|
589 |
} |
|
590 |
$art->{links} = \@links; |
|
591 |
return $bom |
|
592 |
} |
|
593 |
||
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
594 |
# I don't want to prepopulate, as it is not known which ones are |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
595 |
# usless and outdated, and it would be a waste of cycles parsing |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
596 |
# something to know it is not needed |
5 | 597 |
sub getcache ($fn) { |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
598 |
$cache_dom || return 0; |
5 | 599 |
for my $d ($cache_dom->findnodes("/root/art[\@path=\"$fn\"]")) { |
600 |
# TODO related |
|
601 |
my %dome = ('file' => $fn); |
|
8 | 602 |
(@dome{'title', 'catag', 'utitle'}, my $date) = |
5 | 603 |
map |
604 |
{ $d->getChildrenByTagName($_)->[0]->to_literal } |
|
8 | 605 |
qw[title catag utitle date]; |
7 | 606 |
for ($d->getChildrenByTagName("links")) { |
607 |
my @ll = map [$_->{catag}, $_->to_literal], |
|
608 |
($_->getChildrenByTagName('link')); |
|
609 |
$dome{links} = \@ll; |
|
610 |
} |
|
5 | 611 |
$catags{$dome{catag}}++; |
612 |
$dome{date} = PDate->new(split /-/, $date); |
|
613 |
return \%dome; |
|
614 |
} |
|
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
615 |
return 0; |
3 | 616 |
} |
617 |
||
0 | 618 |
sub html_fixup ($filename) { |
8 | 619 |
if ($cache && !grep /^$filename$/, @modified_files) { |
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
620 |
for (getcache($filename)) { |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
621 |
return $_ if $_ |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
622 |
} |
3 | 623 |
} |
0 | 624 |
my $dom = |
8 | 625 |
XML::LibXML->load_html(location => $filename); |
0 | 626 |
my %data = ('file', $filename); |
627 |
||
628 |
# We don't need style or table of contents heading (if exists) |
|
629 |
for my $xpath ('/html/head/style', '/html/body/div/div[@id="table-of-contents"]/h2') { |
|
630 |
$_->parentNode->removeChild($_) for $dom->findnodes($xpath) |
|
631 |
} |
|
632 |
||
633 |
# Info we need |
|
634 |
||
635 |
# Date |
|
636 |
for ($dom->findnodes('/html/body/div[@id="postamble"]/p[@class="date"]')) { |
|
637 |
my $text = $_->to_literal; |
|
638 |
if ($text =~ /^Date: (\d+)-(\d+)-(\d+)/) { |
|
639 |
my $date = PDate->new($1, $2, $3); |
|
640 |
$data{date} = $date; |
|
641 |
my $p = $_->parentNode; |
|
642 |
$p->parentNode->removeChild($p); |
|
643 |
} |
|
644 |
} |
|
8 | 645 |
# Title |
0 | 646 |
for ($dom->findnodes('/html/head/title')) { |
8 | 647 |
$data{utitle} = $_->to_literal; |
0 | 648 |
} |
649 |
# keywords/catogry |
|
650 |
for my $node ($dom->findnodes('/html/head/meta')) { |
|
651 |
(my $cont = $node->getAttribute('content')) || next; |
|
652 |
for ($node->getAttribute('name')) { |
|
5 | 653 |
if (/keywords/) { |
0 | 654 |
my ($key, $rest) = parse_keywords($cont); |
655 |
@data{qw[catag title]} = @{$key}; |
|
656 |
$catags{$data{catag}}++; |
|
657 |
$rest =~ s/\s+\|\s+//; |
|
658 |
while ($rest) { |
|
659 |
(my $t,$rest) = parse_keywords($rest); |
|
660 |
push @{$data{related}}, $t; |
|
661 |
} |
|
662 |
} else { |
|
663 |
next; |
|
664 |
} |
|
665 |
$node->parentNode->removeChild($node); |
|
666 |
} |
|
667 |
} |
|
3 | 668 |
$data{dom} = $dom; |
0 | 669 |
\%data; |
670 |
} |
|
671 |
||
672 |
sub parse_keywords ($str) { |
|
673 |
if ($str =~ s/\s*(?:"(.+?)"|(\w+))\s*->(?:\s*(?:"(.+?)"|(\w+)))//) { |
|
674 |
([$1 // $2, $3 // $4], $str); |
|
675 |
} else { |
|
676 |
die "Keywords not arranged properly\n" |
|
677 |
} |
|
678 |
} |
|
679 |
||
680 |
# I wonder if sean combs has made a similar class |
|
681 |
{ |
|
682 |
package PDate; |
|
683 |
||
684 |
sub new { |
|
685 |
my $class = shift; |
|
686 |
my $self = { year => 0 + shift, |
|
687 |
month => 0 + shift, |
|
688 |
day => 0 + shift, |
|
689 |
}; |
|
690 |
bless $self, $class; |
|
691 |
return $self; |
|
692 |
} |
|
693 |
||
694 |
# $d1 is greater than $d2 |
|
695 |
sub cmp { |
|
696 |
my ($d1, $d2) = @_; |
|
697 |
for ($d1->{year} <=> $d2->{year}, |
|
698 |
$d1->{month} <=> $d2->{month}, |
|
699 |
$d1->{day} <=> $d2->{day}) { |
|
700 |
return $_ unless $_ == 0 |
|
701 |
} |
|
702 |
0 |
|
703 |
} |
|
704 |
use overload '<=>' => \&cmp; |
|
705 |
||
706 |
sub fmt { |
|
707 |
my $self = shift; |
|
708 |
my @months = |
|
709 |
qw(January Febuary March April May June July August September November October December); |
|
710 |
my $n = $self->{day}; |
|
711 |
if ($n == 1) { $n = '1st' } |
|
712 |
elsif (($n - 2) % 10 == 0) { $n = "${n}nd" } |
|
713 |
elsif (($n - 3) % 10 == 0) { $n = "${n}rd" } |
|
5 | 714 |
else { $n = "${n}th" } |
0 | 715 |
$months[$self->{month} - 1] . " $n, " . $self->{year} |
716 |
} |
|
717 |
||
718 |
sub short_fmt { |
|
719 |
my $self = shift; |
|
720 |
join "-", ($self->{year}, $self->{month}, $self->{day}); |
|
721 |
} |
|
4
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
722 |
sub text_easy { |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
723 |
my $self = shift; |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
724 |
join "-", ($self->{year}, $self->{month}, $self->{day}); |
c98c7c32ab46
Cache output, found the best soltuion
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
3
diff
changeset
|
725 |
} |
0 | 726 |
} |
727 |
||
6
c576e88fef13
It's starting to feel messy now
Pranshu Sharma <pranshu@bauherren.ovh>
parents:
5
diff
changeset
|
728 |