gen_recipes.pl (7544B)
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 11 my $GPH_SITE = "gopher://lumidify.org"; 12 my $GPH_ROOT = "recipes"; 13 # $IMG_ROOT is relative to the top-level recipes directory. 14 my $IMG_ROOT = "images"; 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> <image dir>\n" if ($#ARGV != 3); 19 my ($indir, $html_outdir, $gph_outdir, $img_dir) = @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 my @lines = <$fh>; 65 close($fh); 66 # validity of title format should have been checked by process_dir already 67 # if something changed between then and now, I don't care 68 my $title = $lines[0]; 69 chomp $title; 70 $title =~ s/^#### //; 71 72 my $dots = "../" x @$cur_dirs; 73 my $html = ""; 74 my $gph = ""; 75 my $gph2 = ""; 76 my $gph_fullprefix = "$GPH_SITE/I/$GPH_ROOT/$IMG_ROOT/"; 77 foreach my $line (@lines) { 78 my $found = 0; 79 while ($line =~ m/\[([^]]*)\]\(#([^)]*)\)/g) { 80 if ($found) { 81 warn "WARNING: More than one link on one line in " . catfile($root_dir, @$cur_dirs, $file) . ":\n$line"; 82 last; 83 } 84 my $linktitle = $1; 85 my $linkurl = $2; 86 my $before = substr($line, 0, $-[0]); 87 my $after = substr($line, $+[0]); 88 $found = 1; 89 if (!-f catfile($img_dir, $linkurl)) { 90 warn "WARNING: Image $linkurl does not exist.\n"; 91 } 92 chomp $after; 93 $html .= "${before}[$linktitle](${dots}$IMG_ROOT/$linkurl)$after\n"; 94 # FIXME: check that $before and $after don't contain [, |, or ] ? 95 $gph .= $before . ($before eq "" || $before =~ /\s$/ ? "" : " "); 96 $gph .= "$gph_fullprefix$linkurl"; 97 $gph .= ($after eq "" || $after =~ /^\s/ ? "" : " ") . "$after\n"; 98 $gph2 .= "[I|$before$linktitle$after|/$GPH_ROOT/$IMG_ROOT/$linkurl|server|port]\n"; 99 100 } 101 # FIXME: add escaping for lines beginning with [ ? 102 if (!$found) { 103 $html .= $line; 104 $gph .= $line; 105 $gph2 .= $line; 106 } 107 } 108 109 # FIXME: possibly generate "back" links for individual recipes as well 110 my $tmp = catfile($html_outdir, @$cur_outdirs, substr($outfile, 0, -2) . "html"); 111 if (-e $tmp) { 112 die "ERROR: File exists already: $tmp\n"; 113 } 114 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 115 print($fh gen_html($title, markdown($html))); 116 close($fh); 117 $tmp = catfile($gph_outdir, @$cur_outdirs, $outfile); 118 if (-e $tmp) { 119 die "ERROR: File exists already: $tmp\n"; 120 } 121 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 122 print($fh $gph); 123 close($fh); 124 $tmp = catfile($gph_outdir, @$cur_outdirs, substr($outfile, 0, -2) . "gph"); 125 if (-e $tmp) { 126 die "ERROR: File exists already: $tmp\n"; 127 } 128 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 129 print($fh $gph2); 130 close($fh); 131 } 132 133 sub process_dir { 134 my ($root_dir, $cur_dirs, $cur_outdirs) = @_; 135 136 my $path = catdir($root_dir, @$cur_dirs); 137 opendir(my $dh, $path) or die "ERROR: Unable to open directory $path\n"; 138 my @files = sort(grep({!/\A(\.\.?|title)\z/} readdir($dh))); 139 closedir($dh); 140 my $title = get_dirtitle($path); 141 my $html = "<h3>$title</h3>\n<ul>\n"; 142 my $gph = ""; 143 my $gph2 = ""; 144 my $found_number = 0; 145 my $found_nonumber = 0; 146 foreach my $file (@files) { 147 my $newpath = "$path/$file"; 148 my $outfile = $file; 149 if ($outfile =~ /^\d+/) { 150 $found_number = 1; 151 $outfile =~ s/^\d+//; 152 } else { 153 # add empty line between specially sorted files 154 # and regular recipes 155 if ($found_number && !$found_nonumber) { 156 $html .= "<br>\n"; 157 $gph .= "\n"; 158 $gph2 .= "\n"; 159 } 160 $found_nonumber = 1; 161 } 162 if (-d $newpath) { 163 my $t = get_dirtitle($newpath); 164 $html .= "<li><a href=\"$outfile/index.html\">$t</a></li>\n"; 165 $gph .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile, "index.nomenu.gph") . "|server|port]\n"; 166 $gph2 .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile, "index.gph") . "|server|port]\n"; 167 my $final_html_outdir = catfile($html_outdir, @$cur_outdirs, $outfile); 168 my $final_gph_outdir = catfile($gph_outdir, @$cur_outdirs, $outfile); 169 if (-e $final_html_outdir) { 170 die "ERROR: Directory exists already: $final_html_outdir\n"; 171 } 172 mkdir($final_html_outdir) or die "ERROR: Unable to create directory $final_html_outdir.\n"; 173 if (-e $final_gph_outdir) { 174 die "ERROR: Directory exists already: $final_gph_outdir\n"; 175 } 176 mkdir($final_gph_outdir) or die "ERROR: Unable to create directory $final_gph_outdir.\n"; 177 process_dir($root_dir, [@$cur_dirs, $file], [@$cur_outdirs, $outfile]); 178 } elsif (-f $newpath) { 179 if ($newpath !~ /\.md$/) { 180 die "ERROR: File $newpath does not end in .md.\n"; 181 } 182 my $t = get_filetitle($newpath); 183 $html .= "<li><a href=\"" . substr($outfile, 0, -2) . "html\">$t</a></li>\n"; 184 $gph .= "[0|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, $outfile) . "|server|port]\n"; 185 $gph2 .= "[1|$t|/" . join("/", $GPH_ROOT, @$cur_outdirs, substr($outfile, 0, -2) . "gph") . "|server|port]\n"; 186 process_file($root_dir, $cur_dirs, $cur_outdirs, $file, $outfile); 187 } else { 188 die "ERROR: Invalid filetype for $newpath.\n"; 189 } 190 } 191 $html .= "</ul>\n"; 192 $gph .= "\n[1|Switch to menu version|/" . join("/", $GPH_ROOT, @$cur_outdirs, "index.gph") . "|server|port]\n"; 193 $gph2 .= "\n[1|Switch to non-menu version|/" . join("/", $GPH_ROOT, @$cur_outdirs, "index.nomenu.gph") . "|server|port]\n"; 194 if ($#$cur_outdirs >= 0) { 195 my @tmpcopy = @$cur_outdirs; 196 splice(@tmpcopy, -1); 197 $gph .= "[1|Back|/" . join("/", $GPH_ROOT, @tmpcopy, "index.nomenu.gph") . "|server|port]\n"; 198 $gph2 .= "[1|Back|/" . join("/", $GPH_ROOT, @tmpcopy, "index.gph") . "|server|port]\n"; 199 } else { 200 my $back = "[1|Back|/$GPH_TOPBACK|server|port]\n"; 201 $gph .= $back; 202 $gph2 .= $back; 203 } 204 my $tmp = catfile($html_outdir, @$cur_outdirs, "index.html"); 205 open(my $fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 206 print($fh gen_html($title, $html)); 207 close($fh); 208 $tmp = catfile($gph_outdir, @$cur_outdirs, "index.nomenu.gph"); 209 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 210 print($fh "$title\n\n$gph"); 211 close($fh); 212 $tmp = catfile($gph_outdir, @$cur_outdirs, "index.gph"); 213 open($fh, ">", $tmp) or die "ERROR: Unable to open file $tmp.\n"; 214 print($fh "$title\n\n$gph2"); 215 close($fh); 216 }