[LON-CAPA-cvs] cvs: modules /raeburn check_css_calls.pl
raeburn
raeburn@source.lon-capa.org
Mon, 01 Feb 2010 14:55:13 -0000
This is a MIME encoded message
--raeburn1265036113
Content-Type: text/plain
raeburn Mon Feb 1 14:55:13 2010 EDT
Added files:
/modules/raeburn check_css_calls.pl
Log:
- Script to check if LON-CAPA CSS styles (LC_*) used in tags in:
(a) perl modules in /home/httpd/lib/perl/Apache
(b) perl scripts in /home/httpd/cgi-bin
are included in:
(i) loncommon::standard_css() or
(ii) /home/httpd/html/res/adm/includes/task.css
--raeburn1265036113
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20100201145513.txt"
Index: modules/raeburn/check_css_calls.pl
+++ modules/raeburn/check_css_calls.pl
#! /usr/bin/perl
# $Id: check_css_calls.pl,v 1.1 2010/02/01 14:55:12 raeburn Exp $
#########################################################
# check_css_calls.pl
#
# Stuart Raeburn, January 31, 2010
#
#########################################################
#
# Script to check for existence of LON-CAPA CSS styles (LC_*)
# called within LON-CAPA perl scripts and modules in
# /home/httpd/lib/perl/Apache and /home/httpd/cgi-bin
#
use strict;
my $dir;
my $apachepath = "/home/httpd/lib/perl/Apache";
my $cgipath = "/home/httpd/cgi-bin";
my $cssfile = $apachepath.'/loncommon.pm';
my $bt_cssfile = '/home/httpd/html/res/adm/includes/task.css';
my $css_sub = 'standard_css';
my (%for_classes,%for_ids,%for_any,%apachecss,%cgicss,%missing);
if (&get_standard_css($cssfile,\%for_classes,\%for_ids,\%for_any) ne 'ok') {
exit;
}
&get_bt_css($bt_cssfile,\%for_classes,\%for_ids,\%for_any);
&extract_css('pm',$apachepath,\%apachecss);
&extract_css('pl',$cgipath,\%cgicss);
&check_tags('apache',\%apachecss,\%for_any,\%for_classes,\%for_ids,\%missing);
&check_tags('cgi',\%cgicss,\%for_any,\%for_classes,\%for_ids,\%missing);
foreach my $context ('apache','cgi') {
if (ref($missing{$context}) eq 'HASH') {
foreach my $key (sort(keys(%{$missing{$context}}))) {
if (ref($missing{$context}{$key}) eq 'ARRAY') {
print "$key is missing from ".join(', ',@{$missing{$context}{$key}})."\n";
}
}
}
}
exit;
sub get_standard_css {
my ($cssfile,$for_classes,$for_ids,$for_any) = @_;
unless((ref($for_classes) eq 'HASH') && (ref($for_ids) eq 'HASH') &&
(ref($for_any) eq 'HASH')) {
print "Need to provide reference to hash for Classes, Ids and Any\n";
return;
}
if (open(my $fh,"<$cssfile")) {
my $insub = '';
my $incss = '';
while (<$fh>) {
if (/sub\s*standard_css\s+\{/) {
$insub = 1;
}
if ($insub) {
if (/return <<END;/) {
$incss = 1;
}
}
if ($incss) {
chomp;
if (/^END$/) {
$incss = '';
} elsif (/^(\w*)([\#.])LC_(\w*)\s*,?\s*(.+)$/) {
my $str = $_;
&recurse_descriptor($str,$for_classes,$for_ids,$for_any);
}
} elsif ($insub) {
if (/^\s*\}\s*/) {
$insub = '';
}
}
}
} else {
print "Could not open $cssfile\n";
return;
}
return 'ok';
}
sub get_bt_css {
my ($cssfile,$for_classes,$for_ids,$for_any) = @_;
unless((ref($for_classes) eq 'HASH') && (ref($for_ids) eq 'HASH') &&
(ref($for_any) eq 'HASH')) {
print "Need to provide reference to hash for Classes, Ids and Any\n";
return;
}
if (open(my $fh,"<$cssfile")) {
while (<$fh>) {
if (/^(\w*)([\#.])LC_(\w*)\s*,?\s*(.+)$/) {
my $str = $_;
&recurse_descriptor($str,$for_classes,$for_ids,$for_any);
}
}
} else {
print "Could not open $cssfile\n";
return;
}
}
sub recurse_descriptor {
my ($str,$for_classes,$for_ids,$for_any) = @_;
return unless((ref($for_classes) eq 'HASH') && (ref($for_ids) eq 'HASH'));
my ($parent,$identifier,$child,$rest);
if ($str =~ /(\w*)([\*\#.])LC_(\w+)(\s+|,)(\S*)(\s*)(.*)$/) {
$parent = $1;
$identifier = $3;
if ($2 eq '.') {
if ($parent) {
$for_classes->{'LC_'.$identifier}{$parent} = 1;
} else {
$for_classes->{'LC_'.$identifier}{'any'} = 1;
}
} elsif ($2 eq '#') {
if ($parent) {
$for_ids->{'LC_'.$identifier}{$parent} = 1;
} else {
$for_ids->{'LC_'.$identifier}{'any'} = 1;
}
} else {
if ($parent) {
$for_any->{'LC_'.$identifier}{$parent} = 1;
} else {
$for_any->{'LC_'.$identifier}{'any'} = 1;
}
}
$child = $5;
$rest = $6.$7;
if ($child =~ /[\#.]LC_/) {
&recurse_descriptor($child.$5.$rest,$for_classes,$for_ids,$for_any);
} else {
if ($rest =~ /[\#.]LC_/) {
&recurse_descriptor($rest,$for_classes,$for_ids,$for_any);
}
}
}
return;
}
sub extract_css {
my ($ext,$dirpath,$csshashref)=@_;
my $dir;
return unless(ref($csshashref) eq 'HASH');
if (opendir($dir,$dirpath)) {
my @modules;
if ($ext eq 'pm') {
@modules = grep(/\.\Q$ext\E$/,readdir($dir));
} elsif ($ext eq 'pl') {
@modules = grep(/\.\Q$ext\E$/,readdir($dir));
}
foreach my $item (@modules) {
if (-f "$dirpath/$item") {
if (open(my $fh, "<$dirpath/$item")) {
my $package;
if ($ext eq 'pm') {
($package) = ($item =~ /^(.+)\.\Q$ext\E$/);
} else {
$package = $item;
}
my %localsub;
my $inpod = '';
my $inprint = '';
while (<$fh>) {
next if (/^\s*#/);
if (/^=pod/) {
$inpod = 1;
}
unless ($inpod) {
if (/\<([^\s\>]+)\s+(id|class)=("|')LC_([^"']+)("|')([^>]*)\>/s) {
my $tag = $1;
my $type = $2;
my $css = 'LC_'.$4;
unless ($4 =~ /\$/) {
$csshashref->{$package}{$type}{$css}{$tag} = 1;
}
}
}
if (/^=cut/) {
$inpod = '';
}
}
close($fh);
}
}
}
}
return;
}
sub check_tags {
my ($context,$csshash,$for_any,$for_classes,$for_ids,$missing) = @_;
return unless((ref($csshash) eq 'HASH') && (ref($for_any) eq 'HASH') && (ref($for_classes) eq 'HASH') && (ref($for_ids) eq 'HASH') && (ref($missing) eq 'HASH'));
%{$missing->{$context}} = ();
foreach my $package (sort(keys(%{$csshash}))) {
if (ref($csshash->{$package}) eq 'HASH') {
foreach my $type (sort(keys(%{$csshash->{$package}}))) {
if (ref($csshash->{$package}{$type}) eq 'HASH') {
foreach my $item (sort(keys(%{$csshash->{$package}{$type}}))) {
my $match = 0;
if (ref($for_any->{$item}) eq 'HASH') {
if ($for_any->{$item}{'any'}) {
$match = 1;
}
}
unless ($match) {
foreach my $tag (sort(keys(%{$csshash->{$package}{$type}{$item}}))) {
my $tagmatch = 0;
if (ref($for_any->{$item}) eq 'HASH') {
if ($for_any->{$item}{$tag}) {
$tagmatch = 1;
}
}
unless($tagmatch) {
if ($type eq 'class') {
if (ref($for_classes->{$item}) eq 'HASH') {
if ($for_classes->{$item}{'any'}) {
$tagmatch = 1;
}
unless ($tagmatch) {
if ($for_classes->{$item}{$tag}) {
$tagmatch = 1;
}
}
}
} elsif ($type eq 'id') {
if (ref($for_ids->{$item}) eq 'HASH') {
if ($for_ids->{$item}{'any'}) {
$tagmatch = 1;
}
unless ($tagmatch) {
if ($for_ids->{$item}{$tag}) {
$tagmatch = 1;
}
}
}
}
}
unless ($tagmatch) {
if (ref($missing->{$context}) eq 'HASH') {
if (ref($missing->{$context}{$item}) eq 'ARRAY') {
unless(grep(/^\Q$type\E:\Q$tag\E$/,@{$missing->{$context}{$item}})) {
push(@{$missing->{$context}{$item}},$type.':'.$tag);
}
} else {
push(@{$missing->{$context}{$item}},$type.':'.$tag)
}
}
}
}
}
}
}
}
}
}
return;
}
--raeburn1265036113--