gen_html_documents

   1 #!/usr/bin/env perl
   2 # The MIT License (MIT)
   3 #
   4 # Copyright (c) 2011-2015 Ismaël Bouya http://www.normalesup.org/~bouya/
   5 #
   6 # Permission is hereby granted, free of charge, to any person obtaining a copy
   7 # of this software and associated documentation files (the "Software"), to deal
   8 # in the Software without restriction, including without limitation the rights
   9 # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
  10 # copies of the Software, and to permit persons to whom the Software is
  11 # furnished to do so, subject to the following conditions:
  12 #
  13 # The above copyright notice and this permission notice shall be included in
  14 # all copies or substantial portions of the Software.
  15 #
  16 # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
  17 # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
  18 # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
  19 # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
  20 # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
  21 # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
  22 # THE SOFTWARE.
  23
  24
  25 # Feel like tipping/donating? https://www.immae.eu/licenses_and_tipping
  26
  27 use strict;
  28 use File::Basename;
  29
  30 sub parse_config_file {
  31     my ($config_line, $Name, $Value, $Config);
  32     (my $File, $Config) = @_;
  33     if (!open (CONFIG, "$File")) {
  34         print "ERROR: Config file not found : $File";
  35         exit(0);
  36     }
  37     my $multiline = 0;
  38
  39     while (<CONFIG>) {
  40         $config_line=$_;
  41         chop ($config_line);
  42         $config_line =~ s/^\s*//;
  43         $config_line =~ s/\s*$//;
  44         if ( ($config_line !~ /^#/) && ($config_line ne "") ){
  45             if ($multiline) {
  46               $$Config{$Name} =~ s/\\$//;
  47               $$Config{$Name} .= $config_line;
  48             } else {
  49               ($Name, $Value) = split (/\s*=\s*/, $config_line);
  50               $Value =~ s/^~/$ENV{"HOME"}/;
  51               $$Config{$Name} = $Value;
  52             }
  53             $multiline = ($$Config{$Name} =~ /\\$/);
  54         }
  55     }
  56     close(CONFIG);
  57 }
  58
  59 my %Config;
  60 &parse_config_file ($ENV{"HOME"}."/.gen_html_documents.rc", \%Config);
  61
  62 my $entete = $Config{"entete"};
  63 my $avant  = $Config{"avant"};
  64 my $milieu = $Config{"milieu"};
  65 my $apres  = $Config{"apres"};
  66 my $html   = $Config{"html"};
  67
  68 my @ignore = split (/\s*,\s*/, $Config{"ignore"});
  69 my @ext    = split (/\s*,\s*/, $Config{"ext"});
  70
  71 my $documents = $Config{"documents"};
  72 my $droot = $Config{"dossier_web"};
  73
  74 $Config{"dossiers"} =~ s/^"//;
  75 $Config{"dossiers"} =~ s/"$//;
  76 my %dossiers = split (/"?\s*,\s*"?/, $Config{"dossiers"});
  77
  78 my ($dossier,$description);
  79
  80 open F, ">".$milieu;
  81
  82 while(($dossier,$description) = each(%dossiers)) {
  83         opendir(DIR, $documents.$dossier) || warn $documents.$dossier." coulnd't be opened\n";
  84         my @content = grep {$_ !~ /^\.\.?$/} readdir(DIR);
  85         my @sorted = sort { lc($a) cmp lc($b) } @content;
  86         closedir(DIR);
  87
  88         print F "<h3>".$description."</h3>\n";
  89         print F "<ul>\n";
  90         foreach my $subpath (grep { -d $documents.$dossier.'/'.$_} @sorted) {
  91                 subparse($dossier,$subpath,4);
  92                 }
  93         foreach my $file (grep { -f $documents.$dossier.'/'.$_} @sorted) {
  94                 my($filename, $directories, $suffix) = fileparse($file,qr/\.[^\.]*/);
  95                 next if(!in_array(\@ext,lc($suffix)));
  96                 $filename =~ tr/_/ /;
  97                 print F "<li><a href='".$droot.$dossier.'/'.$file."'>".$filename."</a></li>\n";
  98                 }
  99         print F "</ul>\n";
 100         }
 101
 102 sub subparse {
 103         my $path = shift;
 104         my $dossier = shift;
 105         my $rang = shift;
 106
 107         opendir(DIR, $documents.$path."/".$dossier);
 108         my @content = grep {$_ !~ /^\.\.?$/} readdir(DIR);
 109         my @sorted = sort { lc($a) cmp lc($b) } @content;
 110         closedir(DIR);
 111
 112         return if(in_array(\@ignore,$dossier));
 113         my $dossierspace = $dossier;
 114         $dossierspace =~ tr/_/ /;
 115         print F "<li>".$dossierspace."\n";
 116         print F "<ul>\n";
 117         foreach my $subpath (grep { -d $documents.$path."/".$dossier.'/'.$_} @sorted) {
 118                 subparse($path."/".$dossier,$subpath,$rang+1);
 119                 }
 120         foreach my $file (grep { -f $documents.$path."/".$dossier.'/'.$_} @sorted) {
 121                 my($filename, $directories, $suffix) = fileparse($file,qr/\.[^\.]*/);
 122                 next if(!in_array(\@ext,lc($suffix)));
 123                 $filename =~ tr/_/ /;
 124                 print F "<li><a href='".$droot.$path.'/'.$dossier.'/'.$file."'>".$filename."</a></li>\n";
 125                 }
 126         print F "</ul></li>\n";
 127         }
 128
 129 sub in_array {
 130         my ($arr,$search_for) = @_;
 131         my %items = map {$_ => 1} @$arr; # create a hash out of the array values
 132         return (exists($items{$search_for}))?1:0;
 133         }
 134
 135 close F;
 136
 137 exec "cat $entete $avant $milieu $apres 1> $html" or die "$!\n";
 138 exec "chmod -R go=rX,u=rwX $documents"