#!/usr/bin/perl -w # NAME: geniframe.pl # AIM: Based on genindex04.pl - Given an input folder, generate a tempimap.htm of # a complete directory scan # 12/09/2014 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use File::stat; use Cwd; my $os = $^O; my $perl_dir = '/home/geoff/bin'; my $PATH_SEP = '/'; my $temp_dir = '/tmp'; if ($os =~ /win/i) { $perl_dir = 'C:\GTools\perl'; $temp_dir = $perl_dir; $PATH_SEP = "\\"; } unshift(@INC, $perl_dir); require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n"; require 'lib_html.pl' or die "Unable to load 'lib_html.pl' Check paths in \@INC...\n"; # log file stuff our ($LF); my $pgmname = $0; if ($pgmname =~ /(\\|\/)/) { my @tmpsp = split(/(\\|\/)/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $temp_dir.$PATH_SEP."temp.$pgmname.txt"; open_log($outfile); # user variables my $VERS = "0.0.1 2014-09-12"; my $load_log = 0; my $in_dir = ''; my $verbosity = 0; my $out_xml = 'tempimap.htm'; my $xclude_repo_dirs = 1; my @repo_dirs = qw( CVS .svn .git .hg ); my $recursive = 0; my $html_only = 1; my $blank = 0; my $colcount = 2; my $desccol = 0; # from file, this could be the title of the html is there is one my %descriptions = (); my $add_sorted = 0; my @excluded = (); my @descriptions = (); my $add_href = 0; # this does not work out as expected!!! # debug my $debug_on = 0; my $def_file = 'C:\GTools\perl'; ### program variables my @warnings = (); my $cwd = cwd(); # forward sub scan_directory($$); sub VERB1() { return $verbosity >= 1; } sub VERB2() { return $verbosity >= 2; } sub VERB5() { return $verbosity >= 5; } sub VERB9() { return $verbosity >= 9; } sub is_repo_directory($) { my $dir = shift; my ($test); foreach $test (@repo_dirs) { return 1 if ($dir eq $test); } return 0; } sub show_warnings($) { my ($val) = @_; if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ) if (VERB9()); } } 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 process_in_file($) { my ($inf) = @_; if (! open INF, "<$inf") { pgm_exit(1,"ERROR: Unable to open file [$inf]\n"); } my @lines = ; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines, from [$inf]...\n"); my ($line,$inc,$lnn); $lnn = 0; foreach $line (@lines) { chomp $line; $lnn++; if ($line =~ /\s*#\s*include\s+(.+)$/) { $inc = $1; prt("$lnn: $inc\n"); } } } sub is_html_like($) { my $fil = shift; return 1 if ($fil =~ /\.html$/i); return 1 if ($fil =~ /\.htm$/i); return 1 if ($fil =~ /\.php$/i); return 1 if ($fil =~ /\.shtml$/i); return 1 if ($fil =~ /\.phtml$/i); return 0; } my $dbg_mww = 0; sub match_with_wild($$) { my ($fil1,$fil2) = @_; my $len1 = length($fil1); my $len2 = length($fil2); prt("match_with_wild: [$fil1] [$fil2] ") if ($dbg_mww); my ($i,$j,$c1,$c2); $i = 0; $j = 0; if (($len1 > 0) && ($len2 > 0)) { while (($i < $len1)&&($j < $len2)) { $c1 = substr($fil1,$i,1); $c2 = substr($fil2,$j,1); if (($c1 eq $c2)||($c1 eq '?')||($c2 eq '?')) { $i++; $j++; prt("$c1= ") if ($dbg_mww); } elsif ($c2 eq '*') { $i++; # any $c1 matches asterick if (($j + 1) < $len2) { # but if more, maybe time to step past '*' $c2 = substr($fil2,($j+1),1); if ($c1 eq $c2) { $j += 2; } } prt("$c1* ") if ($dbg_mww); } elsif ($c1 eq '*') { $j++; # any $c2 matches asterick if (($i + 1) < $len1) { # but if more, maybe time to step past '*' $c1 = substr($fil1,($i+1),1); if ($c1 eq $c2) { $i += 2; } } prt("$c2* ") if ($dbg_mww); } else { prt(" = 0 - [$c1] ne [$c2]\n") if ($dbg_mww); return 0; } } if (($i == $len1)&&($j == $len2)) { prt(" = 1 - both ran out of chars\n") if ($dbg_mww); return 1; # both ran out of chars } elsif (($i == $len1)&&($c2 eq '*')&&(($j + 1) == $len2)){ prt(" = 1 - first ran out and last is second $c2\n") if ($dbg_mww); return 1; # first ran out, and second is last '*' } elsif (($j == $len2)&&($c1 eq '*')&&(($i + 1) == $len1)){ prt(" = 1 - second ran out and last of first is $c1\n") if ($dbg_mww); return 1; # second ran out, and second is last '*' } prt(" = 0 - failed - no case\n") if ($dbg_mww); } elsif ($len1 > 0) { # 2nd is nul if ($fil1 eq '*') { prt(" = 1 - asterix matches nul\n") if ($dbg_mww); return 1; # nul matches asterix } prt(" = 0 - len1 > 0, but [$fil1]\n") if ($dbg_mww); } elsif ($len2 > 0) { # 1st is nul if ($fil2 eq '*') { prt(" = 1 - nul match asterix\n") if ($dbg_mww); return 1; # nul matches asterix } prt(" = 0 - len2 > 0, but [$fil1]\n") if ($dbg_mww); } else { prt(" = 0 - no case\n") if ($dbg_mww); } return 0; } # 20140911 - fix for wild like 'temp*' = 'temp*.*'; sub matches_wild($$) { # 20140911 - fix for wild like 'temp*' = 'temp*.*'; my ($fil,$wild) = @_; my ($n1,$d1,$e1) = fileparse( $fil, qr/\.[^.]*/ ); my ($n2,$d2,$e2) = fileparse( $wild, qr/\.[^.]*/ ); my $lcn1 = lc($n1); my $lcn2 = lc($n2); # strip . from extension $e1 =~ s/^\.//; $e2 =~ s/^\.//; my $lce1 = lc($e1); my $lce2 = lc($e2); # add * if no extent $lce1 = '*' if (length($lce1) == 0); $lce2 = '*' if (length($lce2) == 0); prt("matches_wild: [$n1] [$n2] and [$e1] [$e2]\n") if (VERB9()); return 1 if (($lcn1 eq $lcn2)&&($lce1 eq $lce2)); return 2 if (($lcn1 eq $lcn2)&&($lce2 eq '*')); return 3 if (($lcn2 eq '*')&&($lce1 eq $lce2)); return 4 if (match_with_wild($lcn1,$lcn2) && match_with_wild($lce1,$lce2)); return 0; } sub has_wild($) { my $txt = shift; my $len = length($txt); my ($i,$c); for ($i = 0; $i < $len; $i++) { $c = substr($txt,$i,1); return 1 if (($c eq '?')||($c eq '*')); } return 0; } sub is_in_excluded($) { my $file = shift; my ($xcl); foreach $xcl (@excluded) { return 1 if ($xcl eq $file); return 1 if (lc($xcl) eq lc($file)); if (has_wild($xcl)) { return 1 if (matches_wild($file,$xcl)); } } return 0; } sub get_html_title($) { my $ff = shift; my $title = ''; if (open FIL,"<$ff") { my @lines = ; close FIL; my ($line); $line = join(" ",@lines); my $ra = get_html_refarray($line); # my $content = shift; my $ta = get_whole_tag_array($ra,'title',0); # show_html_refarray($ta); my $tta = get_title_text($ta,0); $title = join(" ",@{$tta}); prt("File $ff has title: $title\n") if (VERB9()); } return $title; } sub scan_directory($$) { my ($dir,$rlist) = @_; if (!opendir(DIR,$dir)) { prtw("WARNING: Failed to open directory [$dir]\n"); } my @files = readdir(DIR); closedir(DIR); my ($item,$ff,$ishtml,$sb,$ft,$desc,$title); $dir .= $PATH_SEP if (!($dir =~ /(\\|\/)$/)); my @dirs = (); $desc = 'nbsp;'; foreach $item (@files) { next if (($item eq '.')||($item eq '..')); $ff = $dir.$item; if (-f $ff) { # next if ($item eq $out_xml); # skip self next if ($item =~ /\.bak$/i); # skip .bak $ishtml = is_html_like($item); next if ($html_only && !$ishtml); if (is_in_excluded($item)) { prt("User excluded [$ff]\n") if (VERB1()); next; } my ($n,$d,$e) = fileparse($item, qr/\.[^.]*/); $sb = stat($ff); $ft = $sb->mtime; $desc = ' '; if ($desccol) { if (defined $descriptions{$item}) { $desc = $descriptions{$item}; } else { $title = get_html_title($ff); prtw("WARNING: No desc for $item,$title\n"); if (length($title)) { push(@descriptions,"$item,$title"); $desc = $title; } else { $desc = ' '; } } } # 0 1 2 3 push(@{$rlist},[$ff,$e,$ft,$desc]); # got a FILE } elsif (-d $ff) { push(@dirs,$ff) if (!is_repo_directory($item)); # got a directory } else { prtw("WARNING: item [$ff] skipped!\n"); } } foreach $dir (@dirs) { scan_directory($dir,$rlist); } } sub mycmp_nc_n1 { my $nm1 = lc(${$a}[1]); my $nm2 = lc(${$b}[2]); return 1 if ($nm1 gt $nm2); return -1 if ($nm1 lt $nm2); return 0; } sub write_html($$) { my ($dir,$rlist) = @_; my $len = length($dir); my ($file,$cnt,$i,$html,$wrap,$cols,$rows,$mrow,$flen,$maxlen,$ind,$href,$tmp,$desc); my ($line,$name,$ncnt); my $added_cnt = 0; $cnt = scalar @{$rlist}; if ($cnt == 0) { prt("No files to write, thus no html generated!\n"); return; } my $wh = " width=\"400\" height=\"400\""; $ncnt = 0; $html = "\n"; $html .= "\n"; $html .= " \n"; $html .= " IFrame Map\n"; $html .= " \n"; $html .= " \n"; $html .= "

IFrame Map - $cnt Files

\n"; $html .= "

index\n"; $html .= " end

\n"; if ($add_sorted) { $html .= "

Alpha sorted jump list

\n"; } $line = ''; $wrap = $colcount; $mrow = 24; $maxlen = 50; $rows = 0; $cols = 0; my %dupes = (); my @backups = (); my @links = (); for ($i = 0; $i < $cnt; $i++) { ## 0 1 2 3 #push(@{$rlist},[$ff,$e,$ft,$desc]); # got a FILE $file = path_d2u(substr(${$rlist}[$i][0],$len)); # strip base directory next if (defined $dupes{$file}); $dupes{$file} = 1; $desc = ${$rlist}[$i][3]; next if ($desc eq 'EXCLUDE'); $href = $file; my ($nm,$dr) = fileparse($file); $flen = length($file); $ind = index($file,'/'); if (($len > $maxlen)&&($ind > 0)) { $dr = substr($file,0,$ind); $file = "$dr...$nm"; } push(@links,[$href,$nm,$file]); if ($desc eq 'Previous backup copy') { push(@backups,[$file,$href,$desc]); next; } $added_cnt++; $line = ''; $line .= "