URI: 
       Generate.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
       ---
       Generate.pm (4397B)
       ---
            1 #!/usr/bin/env perl
            2 
            3 # LSG::Generate - main generation function for the LSG
            4 # Written by lumidify <nobody@lumidify.org>
            5 #
            6 # To the extent possible under law, the author has dedicated
            7 # all copyright and related and neighboring rights to this
            8 # software to the public domain worldwide. This software is
            9 # distributed without any warranty.
           10 #
           11 # You should have received a copy of the CC0 Public Domain
           12 # Dedication along with this software. If not, see
           13 # <http://creativecommons.org/publicdomain/zero/1.0/>.
           14 
           15 package LSG::Generate;
           16 use strict;
           17 use warnings;
           18 use utf8;
           19 use open qw< :encoding(UTF-8) >;
           20 binmode STDIN, ":encoding(UTF-8)";
           21 binmode STDOUT, ":encoding(UTF-8)";
           22 binmode STDERR, ":encoding(UTF-8)";
           23 use Cwd;
           24 use File::Spec::Functions qw(catfile);
           25 use File::Path qw(make_path);
           26 use LSG::Markdown;
           27 use LSG::Config qw($config);
           28 
           29 sub gen_page {
           30         my ($pageid, $html_pages) = @_;
           31         my @ret_pages;
           32         foreach my $lang (keys %{$config->{"langs"}}) {
           33                 my $template = $config->{"metadata"}->{$pageid}->{"template"} . ".$lang.html";
           34                 # FIXME: also check if the html file actually exists
           35                 # -> maybe compare with modified date of html instead of markdown
           36                 if (
           37                         exists($config->{"modified_dates"}->{"pages"}->{"$pageid.$lang"}) &&
           38                         exists($config->{"modified_dates"}->{"templates"}->{$template}) &&
           39                         $config->{"modified_dates"}->{"pages"}->{"$pageid.$lang"} eq $config->{"metadata"}->{$pageid}->{"modified"}->{$lang} &&
           40                         $config->{"modified_dates"}->{"templates"}->{$template} eq $config->{"templates"}->{$template}->{"modified"} &&
           41                         (!exists $config->{"metadata"}->{$pageid}->{$lang}->{"always_update"} ||
           42                          $config->{"metadata"}->{$pageid}->{$lang}->{"always_update"} ne "true")
           43                 ) {
           44                         next;
           45                 }
           46                 #print("Processing $pageid.$lang\n");
           47                 my $html_dir = catfile("site", $lang, $config->{"metadata"}->{$pageid}->{"dirname"});
           48                 make_path($html_dir);
           49                 my $html;
           50                 if (defined($html_pages)) {
           51                         if (!exists($html_pages->{$lang})) {
           52                                 die "Page $pageid does not exist for language $lang\n";
           53                         }
           54                         $html = $html_pages->{$lang};
           55                 } else {
           56                         my $fullname = catfile("pages", "$pageid.$lang");
           57                         my @tmp_pages;
           58                         ($html, @tmp_pages) = LSG::Markdown::parse_md($lang, $pageid, $fullname);
           59                         push(@ret_pages, @tmp_pages);
           60                 }
           61                 my $final_html = LSG::Template::render_template($html, $lang, $pageid);
           62                 my $html_file = catfile("site", $lang, $pageid) . ".html";
           63                 open(my $in, ">", $html_file) or die "ERROR: can't open $html_file for writing\n";
           64                 print $in $final_html;
           65                 close($in);
           66         }
           67         return @ret_pages;
           68 }
           69 
           70 sub gen_files {
           71         my %extra_pages;
           72         for my $pageid (keys %{$config->{"metadata"}}) {
           73                 for my $page (gen_page($pageid)) {
           74                         if (exists $extra_pages{$page->[0]}->{$page->[1]}) {
           75                                 die "Duplicate page $page->[0] for language $page->[1]\n";
           76                         }
           77                         $extra_pages{$page->[0]}->{$page->[1]} = $page->[2];
           78                 }
           79         }
           80         for my $pageid (keys %extra_pages) {
           81                 gen_page($pageid, $extra_pages{$pageid});
           82         }
           83 }
           84 
           85 sub delete_obsolete_recurse {
           86         my $dir = shift;
           87         opendir(my $dh, $dir) or die "Unable to open directory \"" . getcwd() . "/$dir\": $!\n";
           88         my $filename;
           89         my @dirs;
           90         while ($filename = readdir($dh)) {
           91                 next if $filename =~ /\A\.\.?\z/;
           92                 my $path = $dir eq "." ? $filename : catfile($dir, $filename);
           93                 if (-d $path) {
           94                         push(@dirs, $path);
           95                         next;
           96                 }
           97                 my $pageid = $path;
           98                 $pageid =~ s/\.html\z//;
           99                 if (!exists($config->{"metadata"}->{$pageid})) {
          100                         print("Deleting old file \"" . getcwd() . "/$path\".\n");
          101                         unlink($path);
          102                 }
          103         }
          104         closedir($dh);
          105         opendir($dh, $dir) or die "Unable to open directory \"" . getcwd() . "/$dir\": $!\n";
          106         if (scalar(grep { $_ ne "." && $_ ne ".." } readdir($dh)) == 0) {
          107                 print("Deleting old directory \"" . getcwd() . "/$dir\".\n");
          108                 rmdir($dir);
          109         }
          110         closedir($dh);
          111         # FIXME: remove empty dirs
          112         foreach (@dirs) {
          113                 delete_obsolete_recurse($_);
          114         }
          115 }
          116 
          117 sub delete_obsolete {
          118         my $cur = getcwd();
          119         foreach my $lang (keys %{$config->{"langs"}}) {
          120                 chdir(catfile("site", $lang)) or die "Unable to access directory \"site/$lang\": $!\n";
          121                 delete_obsolete_recurse(".");
          122                 chdir($cur);
          123         }
          124 }
          125 
          126 1;