]>
Commit | Line | Data |
---|---|---|
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" |