URI: 
       UserFuncs.pm - lsg - Lumidify Site Generator
  HTML git clone git://lumidify.org/lsg.git (fast, but not encrypted)
  HTML git clone https://lumidify.org/lsg.git (encrypted, but very slow)
  HTML git clone git://4kcetb7mo7hj6grozzybxtotsub5bempzo4lirzc3437amof2c2impyd.onion/lsg.git (over tor)
   DIR Log
   DIR Files
   DIR Refs
   DIR README
   DIR LICENSE
       ---
       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;