gen_recipes.pl (9471B)
1 #!/usr/bin/env perl 2 3 # WARNING: THERE ARE LOTS OF SPECIAL CASES IN THE LINKS, ETC. THAT ARE NOT HANDLED! 4 # NOTHING IS PROPERLY ESCAPED, BUT THAT'S FINE BECAUSE MY RECIPE FILES AREN'T EVIL! 5 6 use strict; 7 use warnings; 8 use Text::Markdown qw(markdown); 9 use File::Spec::Functions qw(catfile catdir); 10 use File::Copy qw(copy); 11 12 my $GPH_SITE = "gopher://lumidify.org"; 13 # FIXME: if $GPH_ROOT is empty, the output links will include a double slash 14 my $GPH_ROOT = "recipes"; 15 my $GPH_TOPBACK = ""; 16 17 # <image dir> is only used to check if the linked images exist 18 die "USAGE: generate_recipes.pl <input dir> <html output dir> <gph output dir>\n" if ($#ARGV != 2); 19 my ($indir, $html_outdir, $gph_outdir) = @ARGV; 20 process_dir($indir, [], []); 21 22 sub gen_html { 23 my ($title, $body) = @_; 24 return 25 "<!DOCTYPE html>\n" . 26 "<html>\n" . 27 "<head>\n" . 28 "<meta charset=\"utf-8\" />\n" . 29 "<meta name=\"viewport\" content=\"width=device-width,initial-scale=1\" />\n" . 30 "<title>$title</title>\n" . 31 "</head>\n" . 32 "<body>\n" . 33 $body . 34 "</body>\n" . 35 "</html>\n"; 36 } 37 38 sub get_dirtitle { 39 my $path = shift; 40 open(my $fh, "<", catfile($path, "title")) or die "ERROR: Unable to open title file in directory $path.\n"; 41 my $title = <$fh>; 42 close($fh); 43 chomp $title; 44 return $title; 45 } 46 sub get_filetitle { 47 my $path = shift; 48 open(my $fh, "<", $path) or die "ERROR: Unable to open file $path.\n"; 49 my $title = <$fh>; 50 close($fh); 51 chomp $title; 52 if ($title !~ /^#### /) { 53 die "ERROR: Malformed title line in $path.\n"; 54 } 55 $title =~ s/^#### //; 56 return $title; 57 } 58 59 # FIXME: support links to other pages (maybe prefix link with $) 60 sub process_file { 61 my ($root_dir, $cur_dirs, $cur_outdirs, $file, $outfile) = @_; 62 my $infile = catfile($root_dir, @$cur_dirs, $file); 63 open(my $fh, "<", $infile) or die "ERROR: Unable to open file $infile.\n"; 64 if (substr($outfile, -3) ne ".md") { 65 # this is already checked before calling process_file but it doesn't hurt to check again... 66 die "ERROR: File $file does not end in .md.\n"; 67 } 68 my $base = substr($outfile, 0, -3); 69 my @lines = <$fh>; 70 close($fh); 71 # validity of title format should have been checked by process_dir already 72 # if something changed between then and now, I don't care 73 my $title = $lines[0]; 74 chomp $title; 75 $title =~ s/^#### //; 76 77 my $html = ""; 78 my $gph = ""; 79 my $gph2 = ""; 80 my $gph_fullprefix = join("/", $GPH_SITE, "I", $GPH_ROOT, @$cur_outdirs); 81 my $gph2_fullprefix = join("/", "", $GPH_ROOT, @$cur_outdirs); 82 my $indir = catfile($root_dir, @$cur_dirs); 83 my %imgs_used; 84 foreach my $line (@lines) { 85 my $found = 0; 86 while ($line =~ m/\[([^]]*)\]\(#([^)]*)\)/g) { 87 if ($found) { 88 warn "WARNING: More than one link on one line in " . catfile($root_dir, @$cur_dirs, $file) . ":\n$line"; 89 last; 90 } 91 my $linktitle = $1; 92 my $linkurl = "$base/$2"; 93 $imgs_used{$2} = 1; 94 my $before = substr($line, 0, $-[0]); 95 my $after = substr($line, $+[0]); 96 $found = 1; 97 my $imgfile = catfile($indir, $linkurl); 98 if (!-f $imgfile) { 99 warn "WARNING: Image $imgfile does not exist.\n"; 100 } 101 chomp $after; 102 $html .= "${before}[$linktitle]($linkurl)$after\n"; 103 # FIXME: check that $before and $after don't contain [, |, or ] ? 104 $gph .= $before . ($before eq "" || $before =~ /\s$/ ? "" : " "); 105 $gph .= "$gph_fullprefix/$linkurl"; 106 $gph .= ($after eq "" || $after =~ /^\s/ ? "" : " ") . "$after\n"; 107 $gph2 .= "[I|$before$linktitle$after|$gph2_fullprefix/$linkurl|server|port]\n"; 108 109 } 110 # FIXME: add escaping for lines beginning with [ ? 111 if (!$found) { 112 $html .= $line; 113 $gph .= $line; 114 $gph2 .= $line; 115 } 116 } 117 # verify that all image files were used 118 my $imgdir = catfile($indir, $base); 119 if (-d $imgdir) { 120 opendir(my $dh, $imgdir) or die "ERROR: Unable to read directory $imgdir"; 121 my @imgs = grep({!/\A\.\.?\z/} readdir($dh)); 122 closedir($dh); 123 foreach my $img (@imgs) { 124 if (!$imgs_used{$img}) { 125 warn "WARNING: Image " . catfile($indir, $base, $img) . " not used\n"; 126 } 127 } 128 } 129 130 # FIXME: possibly generate "back" links for individual recipes as well 131 my $tmp = catfile($html_outdir, @$cur_outdirs, substr($outfile, 0, -2) . "html"); 132 if (-e $tmp) { 133 die "ERROR: File exists already: $tmp\n"; 134 } 135 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 136 print($fh gen_html($title, markdown($html))); 137 close($fh); 138 $tmp = catfile($gph_outdir, @$cur_outdirs, $outfile); 139 if (-e $tmp) { 140 die "ERROR: File exists already: $tmp\n"; 141 } 142 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 143 print($fh $gph); 144 close($fh); 145 $tmp = catfile($gph_outdir, @$cur_outdirs, substr($outfile, 0, -2) . "gph"); 146 if (-e $tmp) { 147 die "ERROR: File exists already: $tmp\n"; 148 } 149 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 150 print($fh $gph2); 151 close($fh); 152 } 153 154 sub copy_time { 155 my ($srcpath, $dstpath) = @_; 156 my @st = stat($srcpath); 157 if (!@st) { 158 die "ERROR: Unable to stat $srcpath\n"; 159 } 160 my $atime = $st[8]; 161 my $mtime = $st[9]; 162 copy($srcpath, $dstpath) or die "ERROR: Unable to copy $srcpath to $dstpath\n"; 163 utime($atime, $mtime, $dstpath) or die "ERROR: Unable to set atime and mtime of $dstpath"; 164 } 165 166 sub process_dir { 167 my ($root_dir, $cur_dirs, $cur_outdirs) = @_; 168 169 my $path = catdir($root_dir, @$cur_dirs); 170 opendir(my $dh, $path) or die "ERROR: Unable to open directory $path\n"; 171 my @files = sort(grep({!/\A(\.\.?|title)\z/} readdir($dh))); 172 closedir($dh); 173 my $title = get_dirtitle($path); 174 my $html = "<h3>$title</h3>\n<ul>\n"; 175 my $gph = ""; 176 my $gph2 = ""; 177 my $found_number = 0; 178 my $found_nonumber = 0; 179 foreach my $file (@files) { 180 my $newpath = "$path/$file"; 181 my $outfile = $file; 182 if ($outfile =~ /^\d+/) { 183 if (-f "$newpath.md") { 184 # This wouldn't be too difficult to implement (some things would need to be changed 185 # in process_file), but I don't see any use for it anyways. 186 die "ERROR: Recipe file/directory not allowed to start with number: $newpath\n"; 187 } 188 $found_number = 1; 189 $outfile =~ s/^\d+//; 190 } else { 191 # add empty line between specially sorted files 192 # and regular recipes 193 if ($found_number && !$found_nonumber) { 194 $html .= "<br>\n"; 195 $gph .= "\n"; 196 $gph2 .= "\n"; 197 } 198 $found_nonumber = 1; 199 } 200 if (-d $newpath) { 201 my $final_html_outdir = catfile($html_outdir, @$cur_outdirs, $outfile); 202 my $final_gph_outdir = catfile($gph_outdir, @$cur_outdirs, $outfile); 203 if (-e $final_html_outdir) { 204 die "ERROR: Directory exists already: $final_html_outdir\n"; 205 } 206 mkdir($final_html_outdir) or die "ERROR: Unable to create directory $final_html_outdir.\n"; 207 if (-e $final_gph_outdir) { 208 die "ERROR: Directory exists already: $final_gph_outdir\n"; 209 } 210 mkdir($final_gph_outdir) or die "ERROR: Unable to create directory $final_gph_outdir.\n"; 211 if (-f "$newpath.md") { 212 # this is the image directory for a recipe file 213 # copy entire directory into output dir 214 opendir(my $imgdh, $newpath) or die "ERROR: Unable to open directory $newpath\n"; 215 my @images = grep({!/\A\.\.?\z/} readdir($imgdh)); 216 closedir($imgdh); 217 foreach my $img (@images) { 218 my $srcpath = "$newpath/$img"; 219 my $html_dstpath = "$final_html_outdir/$img"; 220 my $gph_dstpath = "$final_gph_outdir/$img"; 221 copy_time($srcpath, $html_dstpath); 222 copy_time($srcpath, $gph_dstpath); 223 } 224 } else { 225 my $t = get_dirtitle($newpath); 226 $html .= "<li><a href=\"$outfile/index.html\">$t</a></li>\n"; 227 $gph .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile, "index.nomenu.gph") . "|server|port]\n"; 228 $gph2 .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile, "index.gph") . "|server|port]\n"; 229 process_dir($root_dir, [@$cur_dirs, $file], [@$cur_outdirs, $outfile]); 230 } 231 } elsif (-f $newpath) { 232 if ($newpath !~ /\.md$/) { 233 die "ERROR: File $newpath does not end in .md.\n"; 234 } 235 my $t = get_filetitle($newpath); 236 $html .= "<li><a href=\"" . substr($outfile, 0, -2) . "html\">$t</a></li>\n"; 237 $gph .= "[0|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile) . "|server|port]\n"; 238 $gph2 .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, substr($outfile, 0, -2) . "gph") . "|server|port]\n"; 239 process_file($root_dir, $cur_dirs, $cur_outdirs, $file, $outfile); 240 } else { 241 die "ERROR: Invalid filetype for $newpath.\n"; 242 } 243 } 244 $html .= "</ul>\n"; 245 $gph .= "\n[1|Switch to menu version|/" . join("/", $GPH_ROOT, @$cur_outdirs, "index.gph") . "|server|port]\n"; 246 $gph2 .= "\n[1|Switch to non-menu version|/" . join("/", $GPH_ROOT, @$cur_outdirs, "index.nomenu.gph") . "|server|port]\n"; 247 if ($#$cur_outdirs >= 0) { 248 my @tmpcopy = @$cur_outdirs; 249 splice(@tmpcopy, -1); 250 $gph .= "[1|Back|/" . join("/", $GPH_ROOT, @tmpcopy, "index.nomenu.gph") . "|server|port]\n"; 251 $gph2 .= "[1|Back|/" . join("/", $GPH_ROOT, @tmpcopy, "index.gph") . "|server|port]\n"; 252 } else { 253 my $back = "[1|Back|/$GPH_TOPBACK|server|port]\n"; 254 $gph .= $back; 255 $gph2 .= $back; 256 } 257 my $tmp = catfile($html_outdir, @$cur_outdirs, "index.html"); 258 open(my $fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 259 print($fh gen_html($title, $html)); 260 close($fh); 261 $tmp = catfile($gph_outdir, @$cur_outdirs, "index.nomenu.gph"); 262 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 263 print($fh "$title\n\n$gph"); 264 close($fh); 265 $tmp = catfile($gph_outdir, @$cur_outdirs, "index.gph"); 266 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 267 print($fh "$title\n\n$gph2"); 268 close($fh); 269 }