csslist.pl to HTML.

index -|- end

Generated: Mon Aug 16 14:14:10 2010 from csslist.pl 2010/07/11 10.3 KB.

#!/usr/bin/perl -w
# NAME: csslist.pl
# AIM: Given an input folder, search for ALL file *.css, recursively,
# and build and show a hash list of the results...
# 11/07/2010 - checkout run only - looks ok
# 17/03/2010 geoff mclane http://geoffair.net/mperl
use strict;
use warnings;
use File::Basename; # split path into ($nm,$dr)=fileparse($ff); or ($nm,$dir,$ext)=fileparse($fil,qr/\.[^.]*/);
unshift(@INC, 'C:/GTools/perl');
require 'logfile.pl' or die "Unable to load logfile.pl ...\n";
# log file stuff
my ($LF);
my $pgmname = $0;
if ($pgmname =~ /\w{1}:\\.*/) {
   my @tmpsp = split(/\\/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $perl_base = 'C:/GTools/perl';
my $outfile = $perl_base."\\temp.$pgmname.txt";
open_log($outfile);

my $in_folder = 'C:\HOMEPAGE\GA';
my $load_log = 1;
my $max_tag = '-moz-border-radius-topright-plus';
my $max_len = length($max_tag);
my $max_out = '[transparent url(../images/back.png) no-repeat scroll right top] [transparent url(../images/back-white.png) no-repeat scroll right top]';
my $max_width = length($max_out);
my $g_max_bytes = 0;
my $g_file_cnt = 0;

my %fpfolders = (
   '_vti_cnf' => 1,
   '_vti_pvt' => 2,
   '_private' => 3,
   '_derived' => 4
);

my @warnings = ();
my @g_css_list = ();

# DEBUG
my $dbg_01 = 0; # prt("[dbg_01] $lctag = $val ln $lnn in [$file]\n") if ($dbg_01);

# forward references
sub process_folder($);

# FUNCTIONS
sub show_warnings($) {
   my ($val) = shift;
   if (@warnings) {
      prt("Got ".scalar @warnings." warnings...\n");
      foreach my $w (@warnings) {
         prt("$w\n");
      }
   }
}

sub pgm_exit($$) {
   my ($val,$msg) = @_;
   if (length($msg)) {
      $msg .= "\n" if !($msg =~ /\n$/);
      prt($msg);
   }
   show_warnings($val);
   close_log($outfile,$load_log);
   exit($val);
}

sub prtw($) {
    my ($tx) = shift;
    $tx =~ s/\n$//;
    prt("$tx\n");
    push(@warnings,$tx);
}

sub is_fp_folder($) {
   my ($fld) = shift;
   return 1 if (defined $fpfolders{$fld});
   return 0;
}

sub is_css_file($) {
   my ($fil) = shift;
   my ($n,$d,$e) = fileparse($fil,qr/\.[^.]*/);
   return 1 if ($e =~ /^\.css$/i);
   return 0;
}

sub process_folder($) {
   my ($inf) = shift;
   if ( !opendir( DIR, $inf ) ) {
      prtw("WARNING: Unable to open directory [$inf]!\n");
      return;
   }
   my (@dir,@files,$fcnt,$file,$ff);
   @files = readdir(DIR);
   closedir DIR;
   $fcnt = scalar @files;
   @dir = ();
   foreach $file (@files) {
      next if (($file eq '.')||($file eq '..'));
      $ff = $inf."\\".$file;
      if (-d $ff) {
         next if (is_fp_folder($file));
         push(@dir,$ff);
      } else {
         push(@g_css_list,$ff) if (is_css_file($file));
      }
   }
   foreach $file (@dir) {
      process_folder($file);
   }
}

sub value_not_in_ra($$) {
   my ($val,$rv) = @_;
   foreach my $v (@{$rv}) {
      return 0 if ($v eq $val);
   }
   return 1;
}

sub check_css_list($) {
   my ($ra) = @_; # \@g_css_list
   $g_file_cnt = scalar @{$ra};
   prt("Got $g_file_cnt CSS files to process...\n");
   my %hash = ();
   my ($file,@lines,$lncnt,$indr);
   my ($line,$len,$i,$ch);
   my ($tag,$val,$inval,$inbr);
   my ($rv,$inquot,$qc,$lctag,$pc,$ppc,$incom);
   my ($lnn);
   foreach $file (@{$ra}) {
      if (open INF, "<$file") {
         @lines = <INF>;
         close INF;
         $lncnt = scalar @lines;
         $inbr = 0;
         $inquot = 0;
         $qc = '';
         $pc = '';
         $ppc = '';
         $ch = '';
         $incom = 0;
         $lnn = 0;
         foreach $line (@lines) {
            $g_max_bytes += length($line);
            $line = trim_all($line);
            $len = length($line);
            $lnn++;
            for ($i = 0; $i < $len; $i++) {
               $ppc = $pc;
               $pc = $ch;
               $ch = substr($line,$i,1);
               # exclude comment '/* ... */
               if ($incom) {
                  $incom = 0 if (($pc eq '*')&&($ch eq '/'));
                  next;
               } elsif (($ch eq '*')&&($pc eq '/')) {
                  $incom = 1;
                  $tag = '';
                  $val = '';
                  next;
               }
               if ($inbr) {
                  if ($ch eq '}') {
                     $inbr = 0;  # end of brace
                  } else {
                     if ($ch eq '{') {
                        # another open - clear and restart...
                        $tag = '';
                        $val = '';
                        $inval = 0;
                        next;
                     }
                     if ($inval) {
                        if ($ch =~ /\s/) {
                           $val .= $ch;
                        } else {
                           if (($ch eq ';')&&(!$inquot)) {
                              # end tag = val
                              $inval = 0;
                           } else {
                              $val .= $ch;
                              if ($inquot) {
                                 if ($ch eq $qc) {
                                    $inquot-- if ($inquot);
                                 }
                              } else {
                                 if ($ch =~ /("|')/) {
                                    $qc = $ch if ($inquot == 0);
                                    $inquot++;
                                 }
                              }
                           }
                        }
                        if (!$inval) {
                           if (length($tag) && length($val)) {
                              $lctag = lc($tag);
                              $val = trim_all($val);
                              if (!defined $hash{$lctag}) {
                                 $hash{$lctag} = [ ];
                                 prt("[dbg_01] $lctag = $val ln $lnn in [$file]\n") if ($dbg_01);
                              }
                              $rv = $hash{$lctag};
                              if (value_not_in_ra($val,$rv)) {
                                 push(@{$rv},$val);
                                 $hash{$lctag} = $rv;
                              }
                           }
                           $tag = '';
                           $val = '';
                        }
                     } else {
                        if ($ch =~ /\s/) {
                           # ignore
                        } else {
                           if ($ch eq ':') {
                              $inval = 1;
                           } else {
                              $tag .= $ch;
                           }
                        }
                     }
                  }
               } else {
                  if ($ch eq '{') {
                     # begin brace
                     $inbr = 1;
                     $tag = '';
                     $inval = 0;
                     $val = '';
                  }
               }
            }
         }
         # end of line
         if (length($tag) && length($val)) {
            $lctag = lc($tag);
            if (!defined $hash{$lctag}) {
               $hash{$lctag} = [ ];
               prt("[dbg_01] $lctag = $val ln $lnn in [$file]\n") if ($dbg_01);
            }
            $rv = $hash{$lctag};
            if (value_not_in_ra($val,$rv)) {
               push(@{$rv},$val);
               $hash{$lctag} = $rv;
            }
         }
         $tag = '';
         $val = '';
      }
   }
   return \%hash;
}

sub show_background($$$) {
   my ($key,$min,$ra) = @_;
   $key .= ' ' while (length($key) < $min);
   prt("$key : ");
   my ($val,$dnurl,$dncolr,$dnrgb,$msg,$dnturl);
   $dnurl = 0;
   $dncolr = 0;
   $dnrgb = 0;
   $dnturl = 0;
   my %h = ();
   $msg = '';
   foreach $val (@{$ra}) {
      if (!defined $h{$val}) {
         if ($val =~ /^url/) {
             if ($dnurl == 0) {
               $msg .= "[$val] ";
             }
            $dnurl++;
         } elsif ($val =~ /^transparent/) {
             if ($dnturl == 0) {
                $msg .= "[$val] "
             }
            $dnturl++;
         } elsif ($val =~ /^#/) {
             if ($dncolr == 0) {
               $msg .= "[$val] ";
             }
             $dncolr++;
         } elsif ($val =~ /^rgb/) {
            $msg .= "[$val] " if ($dnrgb == 0);
            $dnrgb++;
         } else {
            $msg .= "[$val] ";
         }
         $h{$val} = 1;
         if (length($msg) > $max_width) {
            prt("$msg\n");
            $msg = ' ';
         }
      } else {
         $h{$val}++;
      }
   }
   prt("$msg\n") if (length($msg) > 1);
}


sub show_ref_hash($) {
   my ($rh) = @_;
   my $cnt = scalar keys(%{$rh});
   prt( "\nShow of $cnt CSS keys...\n" );
   my ($key,$ra,$val,$min,$len,$wrap);
   $min = 0;
   foreach $key (keys %{$rh}) {
      $len = length($key);
      $min = $len if ($len > $min);
      if ($min > $max_len) {
         $min = $max_len;
         last;
      }
   }

   foreach $key (sort keys %{$rh}) {
      $ra = ${$rh}{$key};
      my ($msg);
      if ($key =~ /background/) {
         show_background($key,$min,$ra);
      } else {
         $key .= ' ' while (length($key) < $min);
         prt("$key : ");
         my %h = ();
         my $dncolr = 0;
         my $dnrgb = 0;
         $msg = '';
         foreach $val (@{$ra}) {
            if ($val =~ /^#/) {
               $msg .= "[$val] " if ($dncolr == 0);
               $dncolr++;
            } elsif ($val =~ /^rgb/) {
               $msg .= "[$val] " if ($dnrgb == 0);
               $dnrgb++;
            } elsif (!defined $h{$val}) {
               $h{$val} = 1;
               $msg = "[$val] ";
            } else {
               $h{$val}++;
            }
            if (length($msg) > $max_width) {
               prt("$msg\n");
               $msg = ' ';
            }
         }
         prt("$msg\n") if (length($msg) > 1);
      }
   }
   prt( "Done $cnt CSS keys...\n" );
}

# ### MAIN ###
prt("Collecting CSS file from [$in_folder], recursively...\n");
process_folder($in_folder);
my $ref_hash = check_css_list(\@g_css_list);
show_ref_hash($ref_hash);
pgm_exit(0,"Processed $g_file_cnt CSS files, approx $g_max_bytes bytes... Normal exit(0)");
# ============

# eof - csslist.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional