Commit | Line | Data |
---|---|---|
14d630dd JL |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | # $Id$ | |
4 | ||
90bd1770 | 5 | use strict; |
16c93300 | 6 | use DBI(); |
90bd1770 JL |
7 | |
8 | my $dsn = "DBI:mysql:database=deptrack;host=localhost"; | |
9 | my $dbh = DBI->connect($dsn,"deptrack","phptrax"); | |
10 | ||
a6c2c2fb | 11 | my @incpath = split /:/, "./:../"; |
381ef085 | 12 | |
16c93300 JL |
13 | my $mask_inc = "\\.inc(\\.php)?\$"; |
14 | my $mask_php = "(?<!\\.inc)\\.php\$"; | |
15 | my $mask_img = "\\.(png|gif|jpg)\$"; | |
0a7f073d | 16 | |
381ef085 JL |
17 | my $rootdir = $ARGV[0]; |
18 | ||
69392ab9 JL |
19 | my $debug = 0; |
20 | ||
14d630dd JL |
21 | # return program syntax |
22 | sub syntax { | |
a6c2c2fb | 23 | print "Syntax:\n\tdeptrack root_directory\n\n"; |
096a8c17 | 24 | exit 0; |
14d630dd JL |
25 | } |
26 | ||
69392ab9 JL |
27 | sub dprint { |
28 | my($text) = @_; | |
29 | print($text) if ($debug); | |
30 | } | |
16c93300 JL |
31 | |
32 | ############################################################################### | |
33 | # # | |
34 | # text operations # | |
35 | # # | |
36 | ############################################################################### | |
37 | ||
14d630dd JL |
38 | # worker function called by tagextract and tagstrip |
39 | sub tagcrunch { | |
40 | my($tag1,$tag2,$intag,@lines) = @_; | |
90bd1770 | 41 | my($line,$pos,@out,$add); |
14d630dd JL |
42 | |
43 | while ($line = shift(@lines)) { | |
44 | if ($intag) { | |
45 | # we are inside the block | |
46 | if (($pos=index($line, $tag2)) > -1) { | |
47 | $add = substr($line,0,$pos); | |
48 | $line = substr($line,$pos+length($tag2)); | |
49 | $intag = 0; | |
50 | } else { | |
51 | $add = $line; | |
52 | $line = ""; | |
53 | } | |
54 | $add =~ s/^\s*//; | |
55 | $add =~ s/\s*$//; | |
096a8c17 | 56 | push @out, "$add\n" if (length($add)>0); |
14d630dd JL |
57 | } |
58 | ||
59 | if (!$intag) { | |
60 | # we are outside the block | |
61 | while(($pos = index($line, $tag1)) > -1) { | |
62 | $line = substr($line,$pos+length($tag1)); | |
63 | if (($pos=index($line, $tag2)) > -1) { | |
64 | $add = substr($line,0,$pos); | |
65 | $line = substr($line,$pos+length($tag2)); | |
66 | } else { | |
67 | $add = $line; | |
68 | $line=""; | |
69 | $intag=1; | |
70 | } | |
71 | $add =~ s/^\s*//; | |
72 | $add =~ s/\s*$//; | |
096a8c17 | 73 | push @out, "$add\n" if (length($add)>0); |
14d630dd JL |
74 | } |
75 | } | |
76 | } | |
0a7f073d | 77 | return @out; |
14d630dd JL |
78 | } |
79 | ||
80 | # return only blocks of @lines between tag1 and tag2 | |
81 | sub tagextract { | |
82 | my($tag1,$tag2,@lines) = @_; | |
096a8c17 | 83 | return &tagcrunch($tag1,$tag2,0,@lines); |
14d630dd JL |
84 | } |
85 | ||
86 | # return @lines minus blocks between tag1 and tag2 | |
87 | sub tagstrip { | |
88 | my($tag1,$tag2,@lines) = @_; | |
096a8c17 | 89 | return &tagcrunch($tag2,$tag1,1,@lines); |
14d630dd JL |
90 | } |
91 | ||
0a7f073d JL |
92 | # for each line, remove whatever is after the comment marker |
93 | sub commentstrip { | |
94 | my($tag,@lines) = @_; | |
95 | my @out; | |
96 | ||
97 | foreach my $line (@lines) { | |
98 | $line =~ s/$tag.*//; | |
99 | $line =~ s/\s*$//; | |
096a8c17 | 100 | push @out, "$line\n" if (length($line)>0); |
0a7f073d JL |
101 | } |
102 | return @out; | |
103 | } | |
104 | ||
16c93300 JL |
105 | |
106 | ############################################################################### | |
107 | # # | |
108 | # DB access # | |
109 | # # | |
110 | ############################################################################### | |
111 | ||
a6c2c2fb | 112 | # clear a database table |
16c93300 JL |
113 | sub cleartable { |
114 | my($table) = @_; | |
115 | my $sth = $dbh->do("delete from $table"); | |
116 | } | |
117 | ||
a6c2c2fb | 118 | # add a dependency into DB |
381ef085 JL |
119 | sub putdep { |
120 | my($pageid,$depid,$did,$type) = @_; | |
121 | my($sth); | |
122 | ||
123 | $sth = $dbh->prepare("select id from dep where page=$pageid and dep=$depid and dir=$did and type='$type'"); | |
124 | $sth->execute(); | |
125 | if (!$sth->rows) { | |
126 | $dbh->do("insert into dep set page=$pageid,dep=$depid,dir=$did,type='$type'"); | |
127 | } | |
128 | } | |
129 | ||
a6c2c2fb | 130 | # put a directory into DB |
381ef085 JL |
131 | sub putdir { |
132 | my($dir) = @_; | |
133 | ||
69392ab9 | 134 | &dprint("putdir($dir)\n"); |
381ef085 JL |
135 | my $did=&getdirid($dir); |
136 | if (!$did) { | |
137 | $dbh->do("insert into dir set path='$dir'"); | |
138 | $did=&getdirid($dir); | |
139 | } | |
140 | return $did; | |
141 | } | |
142 | ||
a6c2c2fb | 143 | # put a file into DB |
16c93300 JL |
144 | sub putfile { |
145 | my($file,$exists) = @_; | |
146 | my($fid,$type); | |
a6c2c2fb JL |
147 | |
148 | $exists=0 if (!$exists); | |
69392ab9 | 149 | &dprint("putfile($file,$exists)\n"); |
16c93300 JL |
150 | if ($exists) { |
151 | $type = "page" if ($file =~ /$mask_php/); | |
152 | $type = "include" if ($file =~ /$mask_inc/); | |
153 | $type = "image" if ($file =~ /$mask_img/); | |
16c93300 | 154 | } else { |
381ef085 JL |
155 | $type = "dead"; |
156 | } | |
157 | ||
158 | $fid=&getfileid($file); | |
159 | if ($fid) { | |
160 | $dbh->do("update file set type='$type' where id=$fid") if ($exists); | |
161 | } else { | |
162 | $dbh->do("insert into file set path='$file',type='$type'"); | |
16c93300 JL |
163 | $fid=&getfileid($file); |
164 | } | |
165 | return $fid; | |
166 | } | |
167 | ||
a6c2c2fb | 168 | # return the ID corresponding to a directory name |
381ef085 JL |
169 | sub getdirid { |
170 | my($dir) = @_; | |
171 | my($sth); | |
172 | ||
173 | $sth = $dbh->prepare("select id from dir where path='$dir'"); | |
174 | $sth->execute(); | |
175 | if (my $ref = $sth->fetchrow_hashref()) { | |
176 | return $ref->{"id"}; | |
177 | } else { | |
178 | return 0; | |
179 | } | |
180 | } | |
181 | ||
a6c2c2fb | 182 | # return the ID corresponding to a file name |
16c93300 JL |
183 | sub getfileid { |
184 | my($file) = @_; | |
185 | my($sth); | |
186 | ||
187 | $sth = $dbh->prepare("select id from file where path='$file'"); | |
188 | $sth->execute(); | |
189 | if (my $ref = $sth->fetchrow_hashref()) { | |
190 | return $ref->{"id"}; | |
191 | } else { | |
192 | return 0; | |
193 | } | |
194 | } | |
195 | ||
196 | ||
197 | ############################################################################### | |
198 | # # | |
199 | # file processing # | |
200 | # # | |
201 | ############################################################################### | |
202 | ||
a6c2c2fb | 203 | # from a path in the server tree, return the path in the filesystem |
381ef085 JL |
204 | sub realpath { |
205 | my($vpath) = @_; | |
206 | ||
207 | return $rootdir.$vpath; | |
208 | } | |
209 | ||
a6c2c2fb JL |
210 | # given a working directory and a relative path, return full path |
211 | # ( in the server tree ) | |
381ef085 JL |
212 | sub abspath { |
213 | my($curdir,$relpath) = @_; | |
214 | my(@path,@comps,$ret); | |
215 | ||
216 | # current directory not absolute | |
217 | if ($curdir !~ /^\//) { | |
218 | print "abspath($curdir,$relpath) : $curdir is not an absolute path!\n"; | |
219 | die; | |
220 | } | |
221 | ||
222 | # relpath is already absolute | |
223 | return $relpath if ($relpath =~ /^\//); | |
224 | ||
225 | # is there a final slash? | |
226 | my $finalslash=""; | |
227 | $finalslash="/" if ($relpath =~ /\/$/); | |
228 | ||
229 | @path = split /\//,substr($curdir,1); | |
230 | @comps = split /\//,$relpath; | |
231 | foreach my $comp (@comps) { | |
232 | SWITCH: { | |
233 | if ($comp =~ /^\.$/) { last SWITCH; } | |
234 | if ($comp =~ /^\.\.$/) { pop @path; last SWITCH; } | |
235 | push @path, $comp; | |
236 | } | |
237 | } | |
238 | $ret = "/". join("/",@path) .$finalslash; | |
239 | $ret =~ s/\/\//\//; | |
240 | return $ret; | |
241 | } | |
242 | ||
14d630dd JL |
243 | # parse a directory |
244 | sub parsedir { | |
381ef085 JL |
245 | my($vdir) = @_; |
246 | my($fid,$did); | |
0a7f073d JL |
247 | |
248 | # build virtual path | |
381ef085 | 249 | $did=&putdir($vdir); |
0a7f073d | 250 | |
381ef085 | 251 | opendir(DIRHANDLE, &realpath($vdir)); |
90bd1770 JL |
252 | my @list = grep /^[^\.]/, readdir(DIRHANDLE); |
253 | closedir(DIRHANDLE); | |
0a7f073d | 254 | |
16c93300 JL |
255 | my @incfiles=grep /$mask_inc/,@list; |
256 | map (&putfile("${vdir}$_", 1), @incfiles); | |
0a7f073d | 257 | |
16c93300 JL |
258 | my @imgfiles=grep /$mask_img/,@list; |
259 | map (&putfile("${vdir}$_", 1), @imgfiles); | |
260 | ||
261 | my @phpfiles=grep /$mask_php/,@list; | |
381ef085 JL |
262 | foreach my $phpfile (@phpfiles) { |
263 | if (-f realpath("${vdir}${phpfile}")) { | |
264 | $fid=&putfile("${vdir}${phpfile}", 1); | |
265 | &parsefile($fid, $did, "${vdir}${phpfile}", $vdir); | |
266 | } else { | |
267 | &putfile("${vdir}$phpfile", 0) | |
268 | } | |
269 | } | |
270 | ||
0a7f073d | 271 | foreach my $entry (@list) { |
381ef085 JL |
272 | if ((-d realpath("${vdir}${entry}")) && ($entry !~ /^CVS$/)) { |
273 | &parsedir("${vdir}${entry}/"); | |
0a7f073d | 274 | } |
14d630dd JL |
275 | } |
276 | } | |
277 | ||
278 | # parse a file | |
279 | sub parsefile { | |
381ef085 | 280 | my($fid,$did,$vfile,$vdir) = @_; |
a5d444f3 | 281 | my(@lines,@phplines,@includes,$depid,$sth,$ifile,$iexists); |
381ef085 | 282 | |
69392ab9 | 283 | &dprint("parsefile($fid,$did,$vfile,$vdir)\n"); |
a6c2c2fb JL |
284 | |
285 | # we return if we already have dependecies in the same scope | |
381ef085 JL |
286 | $sth = $dbh->prepare("select id from dep where page=$fid and dir=$did"); |
287 | $sth->execute(); | |
288 | return if (my $ref = $sth->fetchrow_hashref()); | |
289 | ||
290 | open(FHANDLE,realpath($vfile)); | |
90bd1770 JL |
291 | @lines = <FHANDLE>; |
292 | close(FHANDLE); | |
0a7f073d | 293 | |
90bd1770 | 294 | # strip out commented code |
096a8c17 | 295 | @lines = &tagstrip("<!--","-->",@lines); |
90bd1770 JL |
296 | |
297 | # deal with PHP lines | |
096a8c17 PH |
298 | @phplines = &tagextract("<?php","?>",@lines); |
299 | @phplines = &tagstrip("/*","*/",@phplines); | |
300 | @phplines = &commentstrip("\/\/",@phplines); | |
301 | @phplines = &commentstrip("#",@phplines); | |
381ef085 | 302 | @includes = grep s/.*(require|include)\s*\(\"(.*)\"\).*\n$/$2/, @phplines; |
90bd1770 | 303 | foreach my $include (@includes) { |
69392ab9 | 304 | &dprint("REQ:$include\n"); |
381ef085 | 305 | if ($include =~ /$mask_php/) { |
69392ab9 | 306 | print "Warning : $include gets included by $vfile!\n"; |
381ef085 | 307 | } |
69392ab9 JL |
308 | $iexists=0; |
309 | if ($include =~ /^[\.\/]/) { | |
310 | # the directory is specified | |
311 | $ifile = &abspath($vdir,$include); | |
312 | $iexists=1 if (-f &realpath($ifile)); | |
313 | } else { | |
314 | # directory not specified, go through the include path | |
315 | foreach my $incp (@incpath) { | |
316 | $ifile = &abspath(&abspath($vdir,$incp),$include); | |
317 | &dprint("trying $ifile\n"); | |
318 | if (-f &realpath($ifile)) { | |
319 | $iexists=1; | |
320 | last; | |
a6c2c2fb | 321 | } |
a6c2c2fb | 322 | } |
69392ab9 JL |
323 | # did not find file to be included, treat it as if it were |
324 | # in the first segment of include path | |
325 | $ifile = &abspath(&abspath($vdir,$incpath[0]),$include) if (!$iexists); | |
90bd1770 | 326 | } |
69392ab9 JL |
327 | $depid=&putfile($ifile,$iexists); |
328 | &putdep($fid,$depid,$did,"include"); | |
329 | &parsefile($depid,$did,$ifile,$vdir) if ($iexists); | |
90bd1770 | 330 | } |
14d630dd JL |
331 | } |
332 | ||
0a7f073d | 333 | ## do the work |
14d630dd | 334 | my $nargs = @ARGV; |
096a8c17 | 335 | $nargs || &syntax(); |
14d630dd | 336 | |
381ef085 JL |
337 | $rootdir =~ s/\/$//; |
338 | ||
339 | if (!-d $rootdir) { | |
340 | print "root directory $rootdir not found!\n"; | |
341 | die; | |
342 | } | |
343 | ||
344 | &cleartable("dir"); | |
345 | &cleartable("file"); | |
346 | &cleartable("dep"); | |
347 | &parsedir("/"); |