UserFuncs.pm (10187B)
1 #!/usr/bin/env perl 2 3 #TODO: template - func processed once and func processed for each page 4 5 # LSG::UserFuncs - user functions for the LSG (called from templates and markdown files) 6 # Written by lumidify <nobody@lumidify.org> 7 # 8 # To the extent possible under law, the author has dedicated 9 # all copyright and related and neighboring rights to this 10 # software to the public domain worldwide. This software is 11 # distributed without any warranty. 12 # 13 # You should have received a copy of the CC0 Public Domain 14 # Dedication along with this software. If not, see 15 # <http://creativecommons.org/publicdomain/zero/1.0/>. 16 17 package LSG::UserFuncs; 18 use strict; 19 use warnings; 20 use utf8; 21 use open qw< :encoding(UTF-8) >; 22 binmode STDIN, ":encoding(UTF-8)"; 23 binmode STDOUT, ":encoding(UTF-8)"; 24 binmode STDERR, ":encoding(UTF-8)"; 25 use LSG::Config qw($config); 26 use LSG::Misc; 27 28 # FIXME: maybe also pass line for better error messages 29 # Module arguments: 30 # 1: page id in %fm 31 # 2: page language 32 # 3-: other args (e.g. for func call) 33 34 # Return value: 35 # Usually just the html text. 36 # Optionally, a list of array references of the form [$pageid, $lang, $html] 37 # defining further pages, together with the complete body html text of the 38 # page. The returned text is always taken verbatim as the html code of the 39 # page body, there is no option to interpret it as markdown. 40 # When called from templates, the extra pages are ignored. 41 42 # Yeah, this is extremely inefficient, but it's 43 # not like we're comparing billions of books. 44 sub sort_numeric { 45 my ($a, $b) = @_; 46 my @s1 = split(/(\d+)/, $a); 47 my @s2 = split(/(\d+)/, $b); 48 for my $i (0..$#s1) { 49 if ($i > $#s2) { 50 return 1; 51 } 52 # 01 and 1 should compare the same, so numbers 53 # need '!=' instead of 'ne' like the strings 54 if ($s1[$i] =~ /\d+/ && $s2[$i] =~ /\d+/) { 55 if ($s1[$i] != $s2[$i]) { 56 return $s1[$i] <=> $s2[$i]; 57 } 58 } elsif ($s1[$i] ne $s2[$i]) { 59 return $s1[$i] cmp $s2[$i]; 60 } 61 } 62 if ($#s2 > $#s1) { 63 return -1; 64 } 65 return 0; 66 } 67 68 sub sort_books { 69 # FIXME: 'list' currently doesn't make much sense - the 70 # sorting should be changed to just be alphabetical by 71 # title when 'list' is used 72 73 # $mode == list: just list books 74 # $mode == combined: create subheadings for @sort_by 75 # $mode == separate: create separate pages for @sort_by 76 # $dir: directory to search for pages to sort 77 # (new pages are also created in this directory) 78 # @sort_by: list of metadata attributes to sort by 79 # (this is a hierarchical sorting, i.e. if the second 80 # category in @sort_by is the same for two pages, 81 # the first category must also be the same, and so 82 # on, otherwise there will probably be an error at 83 # some point, or the result will just be weird) 84 my ($pageid, $lang, $dir, $mode, @sort_by) = @_; 85 if (!defined($dir) || !defined($mode)) { 86 die "ERROR: Too few arguments to sort_by.\n"; 87 } 88 if ($mode eq "list") { 89 $mode = 0; 90 } elsif ($mode eq "combined") { 91 $mode = 1; 92 } elsif ($mode eq "separate") { 93 $mode = 2; 94 } else { 95 die "ERROR: Invalid mode $mode for sort_books.\n"; 96 } 97 my %tmp_md; 98 foreach my $id (keys %{$config->{"metadata"}}) { 99 # pages generated by sort_books need to be skipped so when this 100 # function is called again for other languages, it doesn't try 101 # to sort all the generated pages (yes, this is really ugly) 102 103 # prevent autovivification of $config->{"metadata"}->{$id}->{$lang} 104 next if (exists($config->{"metadata"}->{$id}->{$lang}) && 105 $config->{"metadata"}->{$id}->{$lang}->{"generated:sort_books"}); 106 if ($config->{"metadata"}->{$id}->{"dirname"} eq $dir) { 107 $tmp_md{$id} = $config->{"metadata"}->{$id}; 108 my $found = 0; 109 for my $sb (@sort_by) { 110 if (!exists($config->{"metadata"}->{$id}->{$lang}) || 111 !exists($config->{"metadata"}->{$id}->{$lang}->{$sb})) { 112 $found = 1; 113 } else { 114 if ($found) { 115 # there can't be any "undef gaps" - as soon as one sort key 116 # is undef, all the ones afterwards are ignored (in the 117 # final output, the page is located on the same "level" as 118 # the category of the first undef sort key) 119 die "ERROR: $pageid: metadata $sb defined but previous " . 120 "sort key already undef.\n"; 121 } 122 my $val = $config->{"metadata"}->{$id}->{$lang}->{$sb}; 123 if (!exists($config->{"$sb:$lang"}->{$val})) { 124 die "No display value configured for sort key $sb=$val (language $lang).\n"; 125 } 126 } 127 } 128 } 129 } 130 # I could do a Schwartzian transform here, but I won't because I'm too lazy. 131 my @sorted = sort { 132 for my $sb (@sort_by) { 133 # if a sort_by value is undef, use the title of the page instead 134 # so entries on the same level are sorted properly even if some 135 # are actual pages and other are categories 136 my $sort_a = exists($tmp_md{$a}->{$lang}->{$sb}) ? 137 $config->{"$sb:$lang"}->{$tmp_md{$a}->{$lang}->{$sb}} : 138 $tmp_md{$a}->{$lang}->{"title"}; 139 my $sort_b = exists($tmp_md{$b}->{$lang}->{$sb}) ? 140 $config->{"$sb:$lang"}->{$tmp_md{$b}->{$lang}->{$sb}} : 141 $tmp_md{$b}->{$lang}->{"title"}; 142 if ((my $ret = sort_numeric($sort_a, $sort_b))) { 143 return $ret; 144 } 145 } 146 return sort_numeric($tmp_md{$a}->{$lang}->{"title"}, $tmp_md{$b}->{$lang}->{"title"}); 147 } (keys %tmp_md); 148 my $output = ""; 149 my %current; 150 my @extra_pages; 151 my @page_stack = ([$pageid, $lang, ""]); 152 my $margin_dir = $config->{"lang_dirs"}->{$lang} eq "rtl" ? "right" : "left"; 153 foreach my $id (@sorted) { 154 my $rel_lnk = LSG::Misc::gen_relative_link("$lang/$pageid", "$lang/$id.html"); 155 if ($mode == 1 || $mode == 2) { 156 my $indent = 0; 157 my $found_unequal = 0; 158 for my $i (0..$#sort_by) { 159 my $sb = $sort_by[$i]; 160 # Note: it would be possible to uses exists instead of 161 # defined here, but using defined makes the code a bit simpler 162 if (defined($current{$sb}) != defined($tmp_md{$id}->{$lang}->{$sb}) || 163 (defined($current{$sb}) && $current{$sb} ne $tmp_md{$id}->{$lang}->{$sb})) { 164 $found_unequal = 1; 165 $current{$sb} = $tmp_md{$id}->{$lang}->{$sb}; 166 for my $j ($indent+1..$#page_stack) { 167 push(@extra_pages, pop(@page_stack)); 168 } 169 if (defined($current{$sb})) { 170 my $name = $config->{"$sb:$lang"}->{$current{$sb}}; 171 # This is currently hard-coded. Up to four heading sizes are 172 # used (starting at <h3>), then they just stay the same 173 if ($mode == 1) { 174 my $h_sz = $indent + 3 > 6 ? 6 : $indent + 3; 175 $output .= "<h$h_sz style=\"margin-$margin_dir: " . 176 ($indent * 15). "pt;\">$name</h$h_sz>\n"; 177 } else { 178 my $new_id = "$dir/$sb/$current{$sb}"; 179 if (exists $config->{"metadata"}->{$new_id}->{$lang}) { 180 die "ERROR: Duplicate page $new_id (lang $lang).\n"; 181 } 182 my $cat_lnk = LSG::Misc::gen_relative_link( 183 "$lang/$page_stack[-1]->[0]", "$lang/$new_id.html" 184 ); 185 $page_stack[-1]->[2] .= "<p><a href=\"$cat_lnk\">$name</a></p>\n"; 186 push(@page_stack, [ 187 $new_id, 188 $lang, 189 "<h3>$name</h3>\n" 190 ]); 191 $config->{"metadata"}->{$new_id}->{$lang} = { 192 title => $name, 193 "generated:sort_books" => 1 194 }; 195 # FIXME: maybe check if these overwrite a different value 196 $config->{"metadata"}->{$new_id}->{"template"} = $config->{"metadata"}->{$pageid}->{"template"}; 197 $config->{"metadata"}->{$new_id}->{"dirname"} = "$dir/$sb"; 198 $config->{"metadata"}->{$new_id}->{"basename"} = $current{$sb}; 199 } 200 } 201 } elsif ($found_unequal && defined($current{$sb})) { 202 die "ERROR: $sb same as previous page in list for page $id, but higher-level category different (lang $lang).\n"; 203 } 204 if (!defined($current{$sb})) { 205 # as soon as one sort key is undef, the other ones should 206 # also be undef for it to make sense 207 for my $j ($i+1..$#sort_by) { 208 if (defined($tmp_md{$id}->{$lang}->{$sort_by[$j]})) { 209 die "ERROR: $sort_by[$j] set for page $id, but $sb unset (lang $lang).\n"; 210 } 211 $current{$sort_by[$j]} = undef; 212 } 213 last; 214 } 215 $indent++; 216 } 217 if ($mode == 1) { 218 $output .= "<p style=\"margin-$margin_dir: " . ($indent * 15) . "pt;\">" . 219 "<a href=\"$rel_lnk\">" . $tmp_md{$id}->{$lang}->{"title"} . "</a></p>\n"; 220 } else { 221 $rel_lnk = LSG::Misc::gen_relative_link("$lang/$page_stack[-1]->[0]", "$lang/$id.html"); 222 $page_stack[-1]->[2] .= "<p><a href=\"$rel_lnk\">" . $tmp_md{$id}->{$lang}->{"title"} . "</a></p>\n"; 223 } 224 } else { 225 $output .= "<p><a href=\"$rel_lnk\">" . $tmp_md{$id}->{$lang}->{"title"} . "</a></p>\n"; 226 } 227 } 228 229 if ($mode == 2) { 230 for my $i (1..$#page_stack) { 231 push(@extra_pages, pop(@page_stack)); 232 } 233 $output = $page_stack[0]->[2]; 234 shift @page_stack; 235 return ($output, @extra_pages); 236 } else { 237 return $output; 238 } 239 } 240 241 sub gen_lang_selector { 242 my $pageid = shift; 243 my $lang = shift; 244 my $output = "<ul>\n"; 245 foreach my $nav_lang (sort(keys(%{$config->{"langs"}}))) { 246 if ($nav_lang ne $lang) { 247 my $url = LSG::Misc::gen_relative_link("$lang/$pageid", "$nav_lang/$pageid.html"); 248 $output .= "<li><a href=\"$url\">" . $config->{"langs"}->{$nav_lang} . "</a></li>\n"; 249 } 250 } 251 $output .= "</ul>"; 252 253 return $output; 254 } 255 256 sub gen_nav { 257 my $pageid = shift; 258 my $lang = shift; 259 # Don't print <ul>'s so extra content can be added in template 260 #my $output = "<ul>\n"; 261 my $output = ""; 262 my @nav = @{$config->{"nav"}}; 263 # Not necessary because of direction: rtl in style 264 #if ($lang_dirs{$lang} eq "rtl") { 265 # @nav = reverse(@nav); 266 #} 267 foreach my $nav_page (@nav) { 268 my $title = $config->{"metadata"}->{$nav_page}->{$lang}->{"title"}; 269 if (!defined($title)) { 270 die "Unable to find title for navigation page \"$nav_page\"\n"; 271 } 272 my $url = LSG::Misc::gen_relative_link("$lang/$pageid", "$lang/$nav_page.html"); 273 $output .= "<li><a href=\"$url\">$title</a></li>\n"; 274 } 275 #$output .= "</ul>"; 276 277 return $output; 278 } 279 280 sub gen_relative_link { 281 my ($pageid, $lang, $link) = @_; 282 return LSG::Misc::gen_relative_link("$lang/$pageid", $link); 283 } 284 285 sub init_userfuncs { 286 $config->{"funcs"}->{"gen_lang_selector"} = \&gen_lang_selector; 287 $config->{"funcs"}->{"sort_books"} = \&sort_books; 288 $config->{"funcs"}->{"gen_nav"} = \&gen_nav; 289 $config->{"funcs"}->{"gen_relative_link"} = \&gen_relative_link; 290 } 291 292 1;