bin/devel/xhtml.classes.pl

   1 #! /usr/bin/perl -w
   2 #***************************************************************************
   3 #*  Copyright (C) 2003-2010 Polytechnique.org                              *
   4 #*  http://opensource.polytechnique.org/                                   *
   5 #*                                                                         *
   6 #*  This program is free software; you can redistribute it and/or modify   *
   7 #*  it under the terms of the GNU General Public License as published by   *
   8 #*  the Free Software Foundation; either version 2 of the License, or      *
   9 #*  (at your option) any later version.                                    *
  10 #*                                                                         *
  11 #*  This program is distributed in the hope that it will be useful,        *
  12 #*  but WITHOUT ANY WARRANTY; without even the implied warranty of         *
  13 #*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          *
  14 #*  GNU General Public License for more details.                           *
  15 #*                                                                         *
  16 #*  You should have received a copy of the GNU General Public License      *
  17 #*  along with this program; if not, write to the Free Software            *
  18 #*  Foundation, Inc.,                                                      *
  19 #*  59 Temple Place, Suite 330, Boston, MA  02111-1307  USA                *
  20 #***************************************************************************
  21
  22
  23 use strict;
  24 my %classes;
  25 my %styles;
  26
  27 my $red="\e[1;37;31m";
  28 my $yel="\e[1;37;33m";
  29 my $blu="\e[1;37;34m";
  30 my $whi="\e[1;37;16m";
  31 my $gra="\e[0m";
  32
  33
  34 sub parse_dir($) {
  35     my $dir = shift;
  36     my @dirs;
  37     opendir DIR,$dir;
  38     while(my $a = readdir DIR) {
  39         if( -d $dir."/".$a ) {
  40             push @dirs,$dir."/".$a unless($a eq '.' or $a eq '..' or $a eq 'CVS');
  41         } else {
  42             &parse_file($dir."/".$a) if($a =~ /\.(php|tpl|htm[l]?)$/i);
  43         }
  44     }
  45     closedir DIR;
  46     foreach $dir (@dirs) { &parse_dir($dir); }
  47 }
  48
  49 sub parse_file($) {
  50     my $file = shift;
  51     open FILE,"<$file";
  52     my $text = join '',(<FILE>);
  53     $text =~ s/[\s\t\n]+/ /g;
  54     &get_classes($file,$text);
  55     close FILE;
  56 }
  57
  58 sub get_classes($$) {
  59     my $file = shift;
  60     my $text = shift;
  61     while ($text =~ /<( *[^\/](?:->|[^>])*) *>(.*)$/) {
  62         &parse_tag($file,$1);
  63         $text = $2;
  64     }
  65 }
  66
  67 sub class_add($$) {
  68     my $file = shift;
  69     my $tag = shift;
  70     my $class = shift;
  71     if (defined($classes{"$tag.$class"})) {
  72         $classes{"$tag.$class"} .= " $file";
  73     } else {
  74         $classes{"$tag.$class"} = $file;
  75     }
  76 }
  77
  78 sub parse_tag($$) {
  79     my $file = shift;
  80     my $tag = shift;
  81
  82     # tag interdits en xhtml
  83     print STDERR "${red}XHTML error: ${yel}<$1> (majuscules) ${blu}($file)${gra}\n"
  84         if($tag =~ /^((?:[A-Z]+[a-z]*)+)( |$)/);
  85     print STDERR "${red}XHTML error: ${yel}<$1> ${blu}($file)${gra}\n"
  86         if($tag =~ /^(b|i|u|big|small|font|center)( |$)/);
  87     print STDERR "${red}XHTML error: ${yel}<$1> sans '/' ${blu}($file)${gra}\n"
  88         if($tag =~ /^(br|hr|img|link|input)( [^\/]*)?$/);
  89
  90     print STDERR "${red}XHTML error: ${yel}attribut $1 sans = ${blu}($file)${gra}\n"
  91         if($tag =~ / (checked|disabled|multiple|readonly)( |$)/);
  92     print STDERR "${red}XHTML error: ${yel}attribut $1 ${blu}($file)${gra}\n"
  93         if($tag =~ / (align|width|border|color|valign)=/);
  94
  95     # récupération des classes utilisées ...
  96     if($tag =~ /^(\w+).* class=('{[^}]*}'|"{[^}]*}"|'[^{}']*'|"[^{}"]*")/) {
  97         my $t = lc($1);
  98         $2 =~ /^['"](.*)['"]$/;
  99         my $c = lc($1);
 100         if($c =~ /^{ ?cycle.* values=('[^']*'|"[^"]*")/) {
 101             my @cycle = split /['",]/,$1;
 102             foreach my $cl (@cycle) {
 103                     &class_add($file,$t,$cl) if($cl);
 104             }
 105         } else {
 106             &class_add($file,$t,$c);
 107         }
 108     }
 109
 110     #récupération des styles utilisés ...
 111     if($tag =~ /^(\w+).* style=('{[^}]*}'|"{[^}]*}"|'[^{}']*'|"[^{}"]*")/) {
 112         my $t = lc($1);
 113         $2 =~ /^['"](.*)['"]$/;
 114         my $s = lc($1);
 115         if (defined($styles{"$t => $s"})) {
 116             $styles{"$t => $s"} .= " $file";
 117         } else {
 118             $styles{"$t => $s"} = $file;
 119         }
 120     }
 121 }
 122
 123 foreach my $dir (@ARGV) {
 124     &parse_dir($dir);
 125 }
 126
 127 print "\n$blu..:: Classes ::..$gra\n\n";
 128 foreach my $key (sort(keys(%classes))) {
 129     print $key,"\n";
 130 }
 131
 132 print "\n$blu..:: Styles ::..$gra\n\n";
 133 foreach my $key (sort(keys(%styles))) {
 134     print $key,"\t",$whi,$styles{$key},$gra,"\n";
 135 }
 136
 137 print "\n";
 138
 139 # vim:set et ts=4 sts=4 sw=4: