Commit | Line | Data |
---|---|---|
14d630dd JL |
1 | #!/usr/bin/perl -w |
2 | # | |
3 | # $Id$ | |
4 | ||
90bd1770 | 5 | use strict; |
23862e30 JL |
6 | use Config::General; |
7 | use DBI; | |
8 | use Getopt::Std; | |
90bd1770 | 9 | |
23862e30 JL |
10 | ############################################################################### |
11 | # # | |
12 | # Global variables # | |
13 | # # | |
14 | ############################################################################### | |
90bd1770 | 15 | |
23862e30 | 16 | my $rootdir; |
381ef085 | 17 | |
23862e30 JL |
18 | my %conf; |
19 | my $config; | |
20 | my $confile; | |
21 | my $debug; | |
22 | my %opts; | |
23 | my @incpath; | |
0a7f073d | 24 | |
23862e30 JL |
25 | # file masks |
26 | my($mask_inc,$mask_php,$mask_img); | |
381ef085 | 27 | |
23862e30 JL |
28 | # db connection |
29 | my($db_db,$db_host,$db_user,$db_pwd); | |
30 | my($dsn,$dbh); | |
69392ab9 | 31 | |
14d630dd | 32 | |
69392ab9 | 33 | sub dprint { |
23862e30 | 34 | my $text = shift; |
ddfd0276 | 35 | print $text if ($debug); |
69392ab9 | 36 | } |
16c93300 JL |
37 | |
38 | ############################################################################### | |
39 | # # | |
40 | # text operations # | |
41 | # # | |
42 | ############################################################################### | |
43 | ||
14d630dd JL |
44 | # worker function called by tagextract and tagstrip |
45 | sub tagcrunch { | |
46 | my($tag1,$tag2,$intag,@lines) = @_; | |
90bd1770 | 47 | my($line,$pos,@out,$add); |
14d630dd JL |
48 | |
49 | while ($line = shift(@lines)) { | |
50 | if ($intag) { | |
51 | # we are inside the block | |
52 | if (($pos=index($line, $tag2)) > -1) { | |
53 | $add = substr($line,0,$pos); | |
54 | $line = substr($line,$pos+length($tag2)); | |
55 | $intag = 0; | |
56 | } else { | |
57 | $add = $line; | |
58 | $line = ""; | |
59 | } | |
60 | $add =~ s/^\s*//; | |
61 | $add =~ s/\s*$//; | |
096a8c17 | 62 | push @out, "$add\n" if (length($add)>0); |
14d630dd JL |
63 | } |
64 | ||
65 | if (!$intag) { | |
66 | # we are outside the block | |
67 | while(($pos = index($line, $tag1)) > -1) { | |
68 | $line = substr($line,$pos+length($tag1)); | |
69 | if (($pos=index($line, $tag2)) > -1) { | |
70 | $add = substr($line,0,$pos); | |
71 | $line = substr($line,$pos+length($tag2)); | |
72 | } else { | |
73 | $add = $line; | |
74 | $line=""; | |
75 | $intag=1; | |
76 | } | |
77 | $add =~ s/^\s*//; | |
78 | $add =~ s/\s*$//; | |
096a8c17 | 79 | push @out, "$add\n" if (length($add)>0); |
14d630dd JL |
80 | } |
81 | } | |
82 | } | |
0a7f073d | 83 | return @out; |
14d630dd JL |
84 | } |
85 | ||
86 | # return only blocks of @lines between tag1 and tag2 | |
87 | sub tagextract { | |
88 | my($tag1,$tag2,@lines) = @_; | |
096a8c17 | 89 | return &tagcrunch($tag1,$tag2,0,@lines); |
14d630dd JL |
90 | } |
91 | ||
92 | # return @lines minus blocks between tag1 and tag2 | |
93 | sub tagstrip { | |
94 | my($tag1,$tag2,@lines) = @_; | |
096a8c17 | 95 | return &tagcrunch($tag2,$tag1,1,@lines); |
14d630dd JL |
96 | } |
97 | ||
0a7f073d JL |
98 | # for each line, remove whatever is after the comment marker |
99 | sub commentstrip { | |
100 | my($tag,@lines) = @_; | |
101 | my @out; | |
102 | ||
103 | foreach my $line (@lines) { | |
104 | $line =~ s/$tag.*//; | |
105 | $line =~ s/\s*$//; | |
096a8c17 | 106 | push @out, "$line\n" if (length($line)>0); |
0a7f073d JL |
107 | } |
108 | return @out; | |
109 | } | |
110 | ||
16c93300 JL |
111 | |
112 | ############################################################################### | |
113 | # # | |
114 | # DB access # | |
115 | # # | |
116 | ############################################################################### | |
117 | ||
23862e30 JL |
118 | sub dbconnect { |
119 | $dsn = "DBI:mysql:database=$db_db;host=$db_host"; | |
120 | $dbh = DBI->connect($dsn,$db_user,$db_pwd); | |
121 | } | |
122 | ||
a6c2c2fb | 123 | # clear a database table |
16c93300 JL |
124 | sub cleartable { |
125 | my($table) = @_; | |
126 | my $sth = $dbh->do("delete from $table"); | |
127 | } | |
128 | ||
a6c2c2fb | 129 | # add a dependency into DB |
381ef085 JL |
130 | sub putdep { |
131 | my($pageid,$depid,$did,$type) = @_; | |
132 | my($sth); | |
133 | ||
134 | $sth = $dbh->prepare("select id from dep where page=$pageid and dep=$depid and dir=$did and type='$type'"); | |
135 | $sth->execute(); | |
136 | if (!$sth->rows) { | |
137 | $dbh->do("insert into dep set page=$pageid,dep=$depid,dir=$did,type='$type'"); | |
138 | } | |
139 | } | |
140 | ||
a6c2c2fb | 141 | # put a directory into DB |
381ef085 JL |
142 | sub putdir { |
143 | my($dir) = @_; | |
144 | ||
69392ab9 | 145 | &dprint("putdir($dir)\n"); |
381ef085 JL |
146 | my $did=&getdirid($dir); |
147 | if (!$did) { | |
148 | $dbh->do("insert into dir set path='$dir'"); | |
149 | $did=&getdirid($dir); | |
150 | } | |
151 | return $did; | |
152 | } | |
153 | ||
a6c2c2fb | 154 | # put a file into DB |
16c93300 | 155 | sub putfile { |
329627dd | 156 | my($file,$exists,$did) = @_; |
16c93300 | 157 | my($fid,$type); |
a6c2c2fb JL |
158 | |
159 | $exists=0 if (!$exists); | |
329627dd | 160 | &dprint("putfile($file,$exists,$did)\n"); |
16c93300 JL |
161 | if ($exists) { |
162 | $type = "page" if ($file =~ /$mask_php/); | |
163 | $type = "include" if ($file =~ /$mask_inc/); | |
164 | $type = "image" if ($file =~ /$mask_img/); | |
16c93300 | 165 | } else { |
381ef085 JL |
166 | $type = "dead"; |
167 | } | |
168 | ||
169 | $fid=&getfileid($file); | |
170 | if ($fid) { | |
171 | $dbh->do("update file set type='$type' where id=$fid") if ($exists); | |
172 | } else { | |
173 | $dbh->do("insert into file set path='$file',type='$type'"); | |
16c93300 JL |
174 | $fid=&getfileid($file); |
175 | } | |
329627dd | 176 | $dbh->do("update file set dir='$did' where id=$fid") if ($did); |
16c93300 JL |
177 | return $fid; |
178 | } | |
179 | ||
a6c2c2fb | 180 | # return the ID corresponding to a directory name |
381ef085 JL |
181 | sub getdirid { |
182 | my($dir) = @_; | |
183 | my($sth); | |
184 | ||
185 | $sth = $dbh->prepare("select id from dir where path='$dir'"); | |
186 | $sth->execute(); | |
187 | if (my $ref = $sth->fetchrow_hashref()) { | |
188 | return $ref->{"id"}; | |
189 | } else { | |
190 | return 0; | |
191 | } | |
192 | } | |
193 | ||
a6c2c2fb | 194 | # return the ID corresponding to a file name |
16c93300 JL |
195 | sub getfileid { |
196 | my($file) = @_; | |
197 | my($sth); | |
198 | ||
199 | $sth = $dbh->prepare("select id from file where path='$file'"); | |
200 | $sth->execute(); | |
201 | if (my $ref = $sth->fetchrow_hashref()) { | |
202 | return $ref->{"id"}; | |
203 | } else { | |
204 | return 0; | |
205 | } | |
206 | } | |
207 | ||
208 | ||
209 | ############################################################################### | |
210 | # # | |
211 | # file processing # | |
212 | # # | |
213 | ############################################################################### | |
214 | ||
a6c2c2fb | 215 | # from a path in the server tree, return the path in the filesystem |
381ef085 JL |
216 | sub realpath { |
217 | my($vpath) = @_; | |
218 | ||
219 | return $rootdir.$vpath; | |
220 | } | |
221 | ||
a6c2c2fb JL |
222 | # given a working directory and a relative path, return full path |
223 | # ( in the server tree ) | |
381ef085 JL |
224 | sub abspath { |
225 | my($curdir,$relpath) = @_; | |
226 | my(@path,@comps,$ret); | |
227 | ||
228 | # current directory not absolute | |
229 | if ($curdir !~ /^\//) { | |
230 | print "abspath($curdir,$relpath) : $curdir is not an absolute path!\n"; | |
231 | die; | |
232 | } | |
233 | ||
234 | # relpath is already absolute | |
235 | return $relpath if ($relpath =~ /^\//); | |
236 | ||
237 | # is there a final slash? | |
238 | my $finalslash=""; | |
239 | $finalslash="/" if ($relpath =~ /\/$/); | |
240 | ||
241 | @path = split /\//,substr($curdir,1); | |
242 | @comps = split /\//,$relpath; | |
243 | foreach my $comp (@comps) { | |
244 | SWITCH: { | |
245 | if ($comp =~ /^\.$/) { last SWITCH; } | |
246 | if ($comp =~ /^\.\.$/) { pop @path; last SWITCH; } | |
247 | push @path, $comp; | |
248 | } | |
249 | } | |
250 | $ret = "/". join("/",@path) .$finalslash; | |
251 | $ret =~ s/\/\//\//; | |
252 | return $ret; | |
253 | } | |
254 | ||
14d630dd JL |
255 | # parse a directory |
256 | sub parsedir { | |
381ef085 JL |
257 | my($vdir) = @_; |
258 | my($fid,$did); | |
0a7f073d JL |
259 | |
260 | # build virtual path | |
381ef085 | 261 | $did=&putdir($vdir); |
0a7f073d | 262 | |
381ef085 | 263 | opendir(DIRHANDLE, &realpath($vdir)); |
90bd1770 JL |
264 | my @list = grep /^[^\.]/, readdir(DIRHANDLE); |
265 | closedir(DIRHANDLE); | |
0a7f073d | 266 | |
16c93300 | 267 | my @incfiles=grep /$mask_inc/,@list; |
329627dd | 268 | map (&putfile("${vdir}$_", 1, $did), @incfiles); |
0a7f073d | 269 | |
16c93300 | 270 | my @imgfiles=grep /$mask_img/,@list; |
329627dd | 271 | map (&putfile("${vdir}$_", 1, $did), @imgfiles); |
16c93300 JL |
272 | |
273 | my @phpfiles=grep /$mask_php/,@list; | |
381ef085 JL |
274 | foreach my $phpfile (@phpfiles) { |
275 | if (-f realpath("${vdir}${phpfile}")) { | |
329627dd | 276 | $fid=&putfile("${vdir}${phpfile}", 1, $did); |
381ef085 JL |
277 | &parsefile($fid, $did, "${vdir}${phpfile}", $vdir); |
278 | } else { | |
329627dd | 279 | &putfile("${vdir}$phpfile", 0, $did) |
381ef085 JL |
280 | } |
281 | } | |
282 | ||
0a7f073d | 283 | foreach my $entry (@list) { |
381ef085 JL |
284 | if ((-d realpath("${vdir}${entry}")) && ($entry !~ /^CVS$/)) { |
285 | &parsedir("${vdir}${entry}/"); | |
0a7f073d | 286 | } |
14d630dd JL |
287 | } |
288 | } | |
289 | ||
290 | # parse a file | |
291 | sub parsefile { | |
381ef085 | 292 | my($fid,$did,$vfile,$vdir) = @_; |
a5d444f3 | 293 | my(@lines,@phplines,@includes,$depid,$sth,$ifile,$iexists); |
381ef085 | 294 | |
69392ab9 | 295 | &dprint("parsefile($fid,$did,$vfile,$vdir)\n"); |
a6c2c2fb JL |
296 | |
297 | # we return if we already have dependecies in the same scope | |
381ef085 JL |
298 | $sth = $dbh->prepare("select id from dep where page=$fid and dir=$did"); |
299 | $sth->execute(); | |
300 | return if (my $ref = $sth->fetchrow_hashref()); | |
301 | ||
302 | open(FHANDLE,realpath($vfile)); | |
90bd1770 JL |
303 | @lines = <FHANDLE>; |
304 | close(FHANDLE); | |
0a7f073d | 305 | |
90bd1770 | 306 | # strip out commented code |
096a8c17 | 307 | @lines = &tagstrip("<!--","-->",@lines); |
90bd1770 JL |
308 | |
309 | # deal with PHP lines | |
096a8c17 PH |
310 | @phplines = &tagextract("<?php","?>",@lines); |
311 | @phplines = &tagstrip("/*","*/",@phplines); | |
312 | @phplines = &commentstrip("\/\/",@phplines); | |
313 | @phplines = &commentstrip("#",@phplines); | |
4a2ed173 | 314 | @includes = grep s/.*(require|require_once|include|include_once)\s*\({0,1}[\"\'](.*)[\"\']\){0,1}.*\n$/$2/, @phplines; |
90bd1770 | 315 | foreach my $include (@includes) { |
69392ab9 | 316 | &dprint("REQ:$include\n"); |
381ef085 | 317 | if ($include =~ /$mask_php/) { |
69392ab9 | 318 | print "Warning : $include gets included by $vfile!\n"; |
381ef085 | 319 | } |
69392ab9 JL |
320 | $iexists=0; |
321 | if ($include =~ /^[\.\/]/) { | |
322 | # the directory is specified | |
323 | $ifile = &abspath($vdir,$include); | |
324 | $iexists=1 if (-f &realpath($ifile)); | |
325 | } else { | |
326 | # directory not specified, go through the include path | |
327 | foreach my $incp (@incpath) { | |
328 | $ifile = &abspath(&abspath($vdir,$incp),$include); | |
329 | &dprint("trying $ifile\n"); | |
330 | if (-f &realpath($ifile)) { | |
331 | $iexists=1; | |
332 | last; | |
a6c2c2fb | 333 | } |
a6c2c2fb | 334 | } |
69392ab9 JL |
335 | # did not find file to be included, treat it as if it were |
336 | # in the first segment of include path | |
337 | $ifile = &abspath(&abspath($vdir,$incpath[0]),$include) if (!$iexists); | |
90bd1770 | 338 | } |
329627dd | 339 | $depid=&putfile($ifile,$iexists,0); |
69392ab9 JL |
340 | &putdep($fid,$depid,$did,"include"); |
341 | &parsefile($depid,$did,$ifile,$vdir) if ($iexists); | |
90bd1770 | 342 | } |
14d630dd JL |
343 | } |
344 | ||
14d630dd | 345 | |
23862e30 JL |
346 | ############################################################################### |
347 | # # | |
348 | # init and conf file # | |
349 | # # | |
350 | ############################################################################### | |
351 | ||
352 | sub init { | |
353 | my $path = `pwd`; | |
daf1feea | 354 | $confile="$ENV{'HOME'}/.deptrackrc"; |
23862e30 JL |
355 | |
356 | if ( not getopts('dhf:', \%opts) or $opts{'h'}) { | |
357 | &syntax(); | |
358 | } | |
359 | ||
360 | # check for root directory | |
361 | my $nargs = @ARGV; | |
362 | $nargs || &syntax(); | |
363 | $rootdir = $ARGV[0]; | |
364 | $rootdir =~ s/\/$//; | |
365 | ||
366 | if (!-d $rootdir) { | |
367 | print "root directory $rootdir not found!\n"; | |
368 | die; | |
369 | } else { | |
370 | print "Using $rootdir as web root directory\n"; | |
371 | } | |
372 | ||
373 | # process options | |
374 | if ($opts{'d'}){ | |
ddfd0276 | 375 | print "Running in debug mode ...\n"; |
23862e30 JL |
376 | $debug = 1; |
377 | }else{ | |
378 | $debug = 0; | |
379 | } | |
380 | ||
381 | if ($opts{'f'}){ | |
382 | if (-r "$opts{'f'}") { | |
ddfd0276 | 383 | print "Using $opts{'f'} as config file\n"; |
23862e30 JL |
384 | &read_conf("$opts{'f'}"); |
385 | } else { | |
ddfd0276 | 386 | print "$opts{'f'} : not a valid config file\n"; |
23862e30 JL |
387 | exit(1); |
388 | } | |
389 | } else { | |
ddfd0276 | 390 | print "Using $confile as config file\n"; |
23862e30 JL |
391 | if (-r "$confile") { |
392 | &read_conf("$confile"); | |
393 | } else { | |
ddfd0276 | 394 | print "No valid configuration file found, aborting\n"; |
23862e30 JL |
395 | exit(1); |
396 | } | |
397 | } | |
398 | &dbconnect(); | |
399 | } | |
400 | ||
401 | ||
402 | #Read Configuration and init global vars | |
403 | sub read_val { | |
404 | my($default,$value) = @_; | |
405 | if ($value) { return $value; } | |
406 | else { return $default; } | |
407 | } | |
408 | ||
409 | sub read_conf { | |
410 | my $file = shift; | |
411 | $config = new Config::General( -file =>"$file", | |
412 | -AllowMultiOptions =>"yes", | |
413 | -LowerCaseNames =>"yes",); | |
414 | %conf = $config->getall; | |
415 | ||
23862e30 JL |
416 | $db_db = &read_val("deptrack", $conf{'db_db'}); |
417 | $db_host = &read_val("localhost", $conf{'db_host'}); | |
418 | $db_pwd = &read_val("", $conf{'db_pwd'}); | |
419 | $db_user = &read_val("deptrack", $conf{'db_user'}); | |
ddfd0276 JL |
420 | |
421 | @incpath = split /:/, &read_val(".", $conf{'include_path'}); | |
23862e30 JL |
422 | $mask_img = &read_val("\\.(png|gif|jpg)\$", $conf{'mask_img'}); |
423 | $mask_inc = &read_val("\\.inc(\\.php)?\$", $conf{'mask_inc'}); | |
424 | $mask_php = &read_val("(?<!\\.inc)\\.php\$", $conf{'mask_php'}); | |
425 | } | |
426 | ||
381ef085 | 427 | |
daf1feea JL |
428 | # show program info |
429 | sub about { | |
430 | print "deptrack @VERSION@ Copyright (C) Jeremy Lainé and Pierre Habouzit\n\n", | |
431 | " This program comes with ABSOLUTELY NO WARRANTY. This is free software,\n", | |
432 | " you are welcome to distribute it under the terms of the GNU Public\n", | |
433 | " License (GPL) version 2.\n\n"; | |
434 | } | |
435 | ||
23862e30 JL |
436 | # return program syntax |
437 | sub syntax { | |
daf1feea | 438 | print "Syntax:\n", |
02c21174 | 439 | " deptrack [options] root_directory\n\n", |
23862e30 JL |
440 | " Options:\n", |
441 | " -h - this help message\n", | |
442 | " -f <file> - use <file> as config file\n", | |
443 | " -d - debug mode\n"; | |
444 | exit(1); | |
381ef085 JL |
445 | } |
446 | ||
23862e30 JL |
447 | |
448 | ############################################################################### | |
449 | # # | |
450 | # main # | |
451 | # # | |
452 | ############################################################################### | |
453 | ||
daf1feea | 454 | &about(); |
23862e30 | 455 | &init(); |
381ef085 JL |
456 | &cleartable("dir"); |
457 | &cleartable("file"); | |
458 | &cleartable("dep"); | |
459 | &parsedir("/"); |