Generated: Tue Feb 2 17:54:53 2010 from php2htm02.pl 2007/07/31 62.2 KB.
#!C:/Perl # php2htm02.pl # AIM: Convert PHP file sources to colour coded HTML # geoffmclane.com - 2006.09.13 # 31/07/2007 - add some more WARNINGS to output use strict; use warnings; use File::stat; # to get the file date use File::Copy; # to copy from an existing background file - see $jpg_file require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $outfile = 'temp.'.$0.'.txt'; open_log($outfile); prt( "$0 ... Hello, World ...\n" ); my $in_folder = 'C:\GTools\php'; my $out_folder = 'temp2'; my $indexhtm = 'index.htm'; # other USER variables my $skipexisting = 1; # skip writing file, if it EXISTS already, and source OLDER my $debug_on = 0; # set to do only 1 my $tab_space = ' '; # note tabs to 3 spaces - change if desired my @dirfiles = (); # set of directory files and folders my @php_list = (); # just the PHP files offset 0=name 1=date 2=size my @ind_files = (); # push(@ind_files, [$nf, $in_date, $in_size, $in_file]); my $wrap = 5; # table wrap ####################################################### # Load of HTM tags and PHP reserved words and built-in my $html_stx = 'C:/Program Files/EditPlus 2/html.stx'; my $php_stx = 'C:/Program Files/EditPlus 2/php.stx'; # if in HTML (default) #if ($kw == 1) { my @stxHTM = (); #} elsif ($kw == 2) { my @stxATT = (); #} elsif ($kw == 3) { my @stxSPL = (); #else in PHP #if ($kw == 1) { my @stxRW = (); #} elsif ($kw == 2) { my @stxBI = (); # like @BuiltIns; #} elsif ($kw == 3) { my @stxVA = (); my %HFuncsFnd = (); # set of FOUND builtin functions my %HResWdFnd = (); # reserved words used my @AFileNames = (); # for each output file, with hash of functions my @AFileHashs = (); # for each output file, with hash of functions my %HOldbifs = (); # old BIF, from previous index, if any ######################################################### my $m_doctype = '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'."\n". '"http://www.w3.org/TR/html4/loose.dtd">'; my @existing = (); my $tot_files = 0; my $tot_dirs = 0; my $out_total = 0; my $doc_total = 0; # a back ground file my $jpg_file = 'cldsphp.jpg'; # background SOURCE and DESTINATION of background file my $jpg_src = "c:/HOMEPAGE/P26/php/$jpg_file"; my $jpg_des = "$out_folder/$jpg_file"; # validation file my $v401_file = 'valid-html401.gif'; # validation SOURCE and DESTINATION of validation file my $v401_src = "c:/HOMEPAGE/P26/mperl/$v401_file"; my $v401_des = "$out_folder/$v401_file"; ######################################################### my $latest = 0; my $earliest = time(); my $in_index = "$out_folder/$indexhtm"; # = something line 'index.htm'; my $skipped = 0; # older or same my $newercnt = 0; # source is NEWER - re-write file my $newcnt = 0; # does NOT previously exist # debug output only my $dbg1 = 0; my $dbg2 = 0; my $dbg3 = 0; my $dbg4 = 0; my $dbg5 = 0; # show line bits my $dbg6 = 0; # convert to HTML my $dbg7 = 0; # convert spaces my $dbg8 = 0; # parse PHP quote my $dbg9 = 0; # get_following my $dbg10 = 0; # out each line my $dbg11 = 0; # out each new line my $dbg12 = 0; # out PHP enter/exit nline my $dbg13 = 0; # out COM enter/exit line my $dbg14 = 0; # out full PHP lines my $dbg15 = 0; # add metas to handle my $dbg16 = 1; # get outfile line count, by re-reading what was WRITTEN already my $verb3 = 0; # debug the compare my $verb4 = 0; # debug the dateindex table # these are really just DEBUG counters my ($a_cnt, $b_cnt, $c_cnt, $d_cnt, $e_cnt, $f_cnt, $o_cnt, $v_cnt, $q_cnt); my $add_table = 0; my $add_chart = 0; my $add_pre = 1; my $conv_space = 0; my $in_size = 0; my $in_date = 0; my $in_file = ''; my $in_php = 0; my $in_com = 0; my $got_gt = 0; my $php = ''; my $com = ''; my $htm = ''; my $bit = ''; my $ist = 0; my @lnbits = (); my $len = 0; my $alen = 0; my $blen = 0; my @nlines = (); my $ii = 0; my $ch = ''; my $nline = ''; my $g_lc = 0; my $g_olc = 0; my $g_line = ''; my $htmtag = ''; # set the CLASS and COLOUR strings my $a_class = 'a'; # built-in function (red) my $b_class = 'b'; # comments (#006666) my $c_class = 'c'; # reserved words (blue) my $d_class = 'd'; # inside qw(...) my $e_class = 'e'; # $scalar (#9400d3) my $f_class = 'f'; # in <<EOF...EOF block (#666666) my $o_class = 'o'; # @array (#008b8b - was #FFA500) my $v_class = 'v'; # %hash (#a52a2a - was #808000) my $t_class = 't'; # quoted - single and double (#006600) my $a_color = 'red'; my $b_color = '#006666'; my $c_color = 'blue'; my $d_color = '#a52a2a'; my $e_color = '#9400d3'; my $f_color = '#666666'; my $o_color = '#008b8b'; my $v_color = '#a52a2a'; my $t_color = '#006600'; ######################################################### ######## keep the OLD index ### this is needed IF files have been DELETED ... ### VARIABLES my $oi_tblcnt = 0; my $tbl_num = 1; my $tbl_num3 = 3; my @tbl_arr = (); my @tbl_arr3 = (); my @tbl_set = (); my @tbl_set3 = (); my $no_index = 0; my $dbg20 = 0; # get_table_array() my $dbg21 = 0; my $dbg22 = 0; # href found in old index.htm my $dbg23 = 0; my $dbg24 = 0; my $oi_tacnt = 0; my $oi_tacnt3 = 0; my @oi_larr = (); my @oi_larr2 = (); my @oi_hrefs = (); ### FUNCTIONS # search the @stxBI array for an entry sub is_built_in($) { my ($t) = shift; foreach my $rw (@stxBI) { if ($t eq $rw) { return 1; } } return 0; } sub transfer_old_table3() { $oi_tacnt3 = scalar @tbl_set3; if ($oi_tacnt3 > 0) { prt( "Collected $oi_tacnt3 in \@tbl_set3 ... need to intialise built-in hash ...\n" ); ## load into my %HOldbifs = (); my $elimcnt = 0; my $elimcnt2 = 0; for (my $i = 0; $i < $oi_tacnt3; $i++) { my $bif = $tbl_set3[$i][0]; my $fss = $tbl_set3[$i][1]; if (is_built_in($bif)) { # each new htm file written is kept in - # push(@AFileNames, $ind_file ); # and for each of these a new hash of built ins has been kept # push(@AFileHashs, \%th); # store the functions used ... # so these files can be (safely) eliminated, since they will be added later foreach my $nhf (@AFileNames) { if ($fss =~ /$nhf/i) { $fss =~ s/$nhf//; $elimcnt++; } } $fss = trim_line($fss); if (length($fss)) { if (exists $HOldbifs{$bif}) { prt("\nWARNING: [$bif] appears DUPLICATED ...\n had=[".$HOldbifs{$bif}."\nadding [$fss]\n\n"); $HOldbifs{$bif} .= $fss; } else { $HOldbifs{$bif} = $fss; } } else { $elimcnt2++; } } else { prt("WARNING: DISCARDING [$bif] - NOT BUILT-IN!\n"); } } my $nwcnt = scalar keys %HOldbifs; if ($elimcnt > 0) { prt( "Elimated old files $elimcnt times, avoiding $elimcnt2 bifs being added...\n" ); } prt( "Done $oi_tacnt3 in \@tbl_set3 ... now $nwcnt in \%HOldbifs ...\n" ); } } sub mark_old_index($) { my ($f) = shift; my $tsc = scalar @tbl_set; for (my $i = 0; $i < $tsc; $i++ ) { if ($tbl_set[$i][0] eq $f) { $tbl_set[$i][7] = 1; last; } } } sub get_table_array { my $fnd = 0; my $lncnt = scalar @oi_larr2; for (my $i = 0; $i < $lncnt ; $i++) { my $ln = $oi_larr2[$i]; # extract a line chomp $ln; # remove LF (\n) $ln =~ s/\r$//; # and remove CR, if present if ($ln =~ /<table.*>/i) { prt( "FOUND TABLE: [$ln] ...\n" ) if ($dbg20); $oi_tblcnt++; # bump table counter if ($oi_tblcnt == $tbl_num) { prt( "Is my TABLE [$oi_tblcnt] ...\n" ) if ($dbg20); push(@tbl_arr,$ln); if ( !($ln =~ /<\/table>/i) ) { $i++; # move to next line for ( ; $i < $lncnt; $i++) { $ln = $oi_larr2[$i]; # extract a line chomp $ln; # remove LF (\n) $ln =~ s/\r$//; # and remove CR, if present if ( $ln =~ /<\/table>/i ) { prt( "END TABLE $tbl_num: [$ln] ...\n" ) if ($dbg20); push(@tbl_arr,$ln); $fnd++; last; } push(@tbl_arr,$ln); } } } elsif ($oi_tblcnt == $tbl_num3) { prt( "Is my TABLE [$oi_tblcnt] ...\n" ) if ($dbg20); push(@tbl_arr3,$ln); if ( !($ln =~ /<\/table>/i) ) { $i++; # move to next line for ( ; $i < $lncnt; $i++) { $ln = $oi_larr2[$i]; # extract a line chomp $ln; # remove LF (\n) $ln =~ s/\r$//; # and remove CR, if present if ( $ln =~ /<\/table>/i ) { prt( "END TABLE $tbl_num3: [$ln] ...\n" ) if ($dbg20); push(@tbl_arr3,$ln); $fnd++; last; } push(@tbl_arr3,$ln); } } } } } return $fnd; } sub process_tbl_arr() { my $cc = 0; for (my $i = 0; $i < $oi_tacnt ; $i++) { my $ln = $tbl_arr[$i]; # extract a line if ($ln =~ /<td.*>/i) { while ( !($ln =~ /<\/td>/i) ) { $i++; if ($i < $oi_tacnt) { $ln .= ' '.$tbl_arr[$i]; # extract a line } else { last; } } # got begin and end of <td>...</td> block if ($ln =~ /(<td.*?>)(.*)(<\/td>)/i) { my $tds = $1; my $inb = $2; my $tde = $3; # like Line [<td><a href="adjrt01.htm">adjrt01.htm</a> <br>2006/05/23 <br>10,213</td>] = # [<td>][<a href="adjrt01.htm">adjrt01.htm</a> <br>2006/05/23 <br>10,213][</td>] ... prt( "Line [$ln] = \nBlocks [$tds][$inb][$tde] ...\n" ) if ($dbg21); ###if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>/) { ##if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>/i) { #if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>(\d{1}\S*)/i) { if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>(\d{1}\S*)\s*/i) { my $hrf = $1; my $fil = $2; my $dt = $3; my $sz = $4; my ($yr, $mt, $dy) = split(/\//,$dt); ###$sz =~ s/,//g; # 0 1 2 3 4 5 6 7 push(@tbl_set, [$hrf, $fil, $dt, $sz, $yr, $mt, $dy, 0]); prt("href=[$hrf], file=[$fil], date=[$dt][$yr][$mt][$dy], size=[$sz]...\n") if ($dbg22); } else { prt("HREF not found - CHECK!\n") if ($dbg22); } } } } } sub process_tbl_arr3() { my $cc = 0; my $ff = 0; # since just two columns - flip flop my $bif = ''; my $fil = ''; for (my $i = 0; $i < $oi_tacnt3 ; $i++) { my $ln = $tbl_arr3[$i]; # extract a line if ($ln =~ /<td.*>/i) { $cc = length($ln); prt( "$i - Line [$ln] $cc...\n" ) if ($dbg24); while ( !($ln =~ /<\/td>/i) ) { $i++; if ($i < $oi_tacnt3) { $ln .= ' '.$tbl_arr3[$i]; # extract a line } else { last; } } if ($cc != length($ln)) { $cc = length($ln); prt( "$i - Line [$ln] $cc...\n" ) if ($dbg24); } # got begin and end of <td>...</td> block # 2006.09.11 '?' added to STOP greedy parsing if ($ln =~ /(<td.*?>)(.*)(<\/td>)/i) { my $tds = $1; my $inb = $2; my $tde = $3; prt( "$i - td[$tds] in[$inb] te[$tde]...\n" ) if ($dbg24); if ($ff > 0) { $fil = collectoi_hrefs($inb, 1); # remove HREF $fil = trim_line($fil); if (is_built_in($bif)) { push(@tbl_set3, [$bif, $fil, 0]); prt( " push(\@tbl_set3, [$bif, $fil, 0]); ...\n" ) if ($dbg23); } else { if (($bif =~ /unused/i)||($bif =~ /missed/i)) { prt( " Advice: Skipping [$bif] ...\n" ) if ($dbg23); } else { prt( " Advice: Skipping [$bif] - NOT BUILT IN FUNCTION!\n" ); } } $ff = 0; } else { $bif = $inb; $bif =~ s/\[//; $bif =~ s/\]//; $bif = trim_line($bif); if ($bif =~ /<.*?>(.*?)<\/.*?>/) { $bif = trim_line($1); } $ff = 1; } } else { prt( "CHECK ME: Missed <td> ... </td> \n"); } } } } sub get_old_index($) { my ($ind) = shift; $oi_tacnt = 0; $oi_tacnt3 = 0; my $ln = ''; my $lncnt = 0; if (open IF, "<$ind") { @oi_larr = <IF>; # slurp it all in ... close(IF); $lncnt = scalar @oi_larr; prt( "Got $lncnt lines to process ... from [$ind]\n" ); ###write2file( join('',@oi_larr), 'tempout.txt'); $ln = tag2newline( join('',@oi_larr), 'td' ); ###$ln = tag2newline( $ln, 'br' ); @oi_larr2 = split(/\n/, $ln); ###write2file( join("\n",@oi_larr2), 'tempout3.txt'); if (get_table_array()) { $oi_tacnt = scalar @tbl_arr; $oi_tacnt3 = scalar @tbl_arr3; prt( "Got $oi_tacnt and $oi_tacnt3 lines to process ... from [$ind]...\n" ); } else { prt( "Failed to find table $tbl_num or $tbl_num3 ... in [$ind]...\n" ); } } else { prt( "Warning: Failed to open $ind ...\n" ); $no_index = 1; } if ($oi_tacnt > 0) { process_tbl_arr(); } else { prt( "Warning: Failed to load table $tbl_num ...\n" ); } if ($oi_tacnt3 > 0) { process_tbl_arr3(); } else { prt( "Warning: Failed to load table $tbl_num3 ...\n" ); } transfer_old_table3(); } ################################################################### # COPIED OUT OF htmltools.pl, since I do NOT want to include it, just now ... sub tag2newline { # ($txt2,'td'); my ($txt, $tag) = @_; my $len = length($txt); my $ntxt = ''; my $i; my $ch = ''; my $ft = ''; my $lcnt = 0; for ($i = 0; $i < $len; $i++ ) { $ch = substr($txt,$i,1); if ($lcnt && ($ch eq '<')) { $ft = $ch; $i++; for ( ; $i < $len; $i++ ) { $ch = substr($txt,$i,1); $ft .= $ch; if ($ch eq '>') { if ($ft =~ /^<$tag/i) { $ft = "\n".$ft; } last; } } $ntxt .= $ft; } else { $ntxt .= $ch; if ($ch eq "\n") { $lcnt = 0; } else { $lcnt++; } } } return $ntxt; } sub collectoi_hrefs { my ($txt,$del) = @_; my $ntxt = ''; my $len = length($txt); my $ch = ''; my $hrf = ''; my $i; for ($i = 0; $i < $len; $i++) { $ch = substr($txt,$i,1); if ($ch eq '<') { $hrf = $ch; $i++; for ( ; $i < $len; $i++) { $ch = substr($txt,$i,1); $hrf .= $ch; if ($ch eq '>') { last; } } if ($hrf =~ /^<a\s/i) { if ($del == 0) { $ntxt .= $hrf; } ### prt("Got [$hrf] ...\n"); if ($hrf =~ /href=["'](\S+)["']./i) { $hrf = $1; push(@oi_hrefs,$hrf); ### prt("Got [$hrf] ...\n"); } } elsif ($hrf =~ /^<\/a>$/i) { if ($del == 0) { $ntxt .= $hrf; } } else { $ntxt .= $hrf; } } else { $ntxt .= $ch; } } return $ntxt; } ################################################################### ######################################### ### subs # built-in functions # my $a_class = 'a'; # built-in function (red) sub add_red { my ($t) = shift; $a_cnt++; return ('<span class="'.$a_class.'">'.$t.'</span>'); } # comments #my $b_class = 'b'; # comments (#006666) sub add_class_b { my ($t) = shift; $b_cnt++; return ('<span class="'.$b_class.'">'.$t.'</span>'); } # reserved words #my $c_class = 'c'; # reserved words (blue) sub add_blue { my ($t) = shift; $c_cnt++; return ('<span class="'.$c_class.'">'.$t.'</span>'); } # perl qw set #my $d_class = 'd'; # inside qw(...) sub add_class_d { my ($t) = shift; $d_cnt++; return ('<span class="'.$d_class.'">'.$t.'</span>'); } #my $e_class = 'e'; # $scalar (#9400d3) sub add_class_e { my ($t) = shift; $e_cnt++; return ('<span class="'.$e_class.'">'.$t.'</span>'); } #my $f_class = 'f'; # in <<EOF...EOF block (#666666) sub add_class_f { my ($t) = shift; $f_cnt++; return ('<span class="'.$f_class.'">'.$t.'</span>'); } #my $o_class = 'o'; # @array (#008b8b - was #FFA500) sub add_class_o { my ($t) = shift; $o_cnt++; return ('<span class="'.$o_class.'">'.$t.'</span>'); } #my $v_class = 'v'; # %hash (#a52a2a - was #808000) sub add_class_v { my ($t) = shift; $v_cnt++; return ('<span class="'.$v_class.'">'.$t.'</span>'); } #my $t_class = 't'; # quoted - single and double (#006600) sub add_quote { my ($t) = shift; $q_cnt++; return ('<span class="'.$t_class.'">'.$t.'</span>'); } sub reset_count { # done at start of each file # these are really just DEBUG counters $a_cnt = 0; $b_cnt = 0; $c_cnt = 0; $d_cnt = 0; $e_cnt = 0; $f_cnt = 0; $o_cnt = 0; $v_cnt = 0; $q_cnt = 0; %HResWdFnd = (); # clear reserve words found %HFuncsFnd = (); # clear builtin functions found } my $phpcss = <<"PEOF"; /* Style Definitions - updated 2007.07.31, 2006.08.28, 2006.07.13 */ body { background-image:url('cldsphp.jpg'); margin: 0cm 1cm 0cm 1cm; text-align : justify; } hr { margin: 0px 0px 0px 0px; border-style: none; padding: 0px 0px 0px 0px; } h1 { background:#efefef; border-style: solid solid solid solid; border-color:#d9e2e2; border-width:1px; padding:2px 2px 2px 2px; font-size:200%; text-align:center; } p.top { margin: 0; border-style: none; padding: 0; text-align: center; } p.nom { margin:0cm; margin-bottom:.0001pt; color: red; } p.code { margin: 0cm 0.5cm 0cm 0.5cm; font-size:10.0pt; font-family:"Courier New"; } .bld { font-weight: bold; } .cn { font-family:"Courier New"; } .ctr { text-align: center; } .bldcn { font-family : "Courier New"; font-weight : bold; } .just { text-align : justify; } .nob { margin : 0 0 0 0; border-style : none; padding : 0 0 0 0; } .sz4redb { font-size: 18pt; color: #FF0000; font-family: Arial; font-weight: bold } .redb { color: #FF0000; font-family: Arial; font-weight: bold } hr.mini { margin : 0; border-style : none; padding : 0; width : 20%; text-align : center; } .a { color:red; } .b { color:#006666; } .c { color:blue; } .d { color:#a52a2a; } .e { color:#9400d3; } .f { color:#666666; } .o { color:#008b8b; } .v { color:#a52a2a; } .t { color:#006600; } .cd { /* top, right, bottom, left */ padding: 0px 10px 0px 10px; margin: 1px 10px 1px 10px; background: #f0f8ff; border-width: 1px; border-style: solid solid solid solid; border-color: #cccccc; width: 90%; font-family:"Courier New"; } .out, .dos { /* top, right, bottom, left */ padding: 0px 10px 0px 10px; margin: 1px 10px 1px 10px; background: #2f2f2f; color: #ffffff; border-width: 1px; border-style: solid solid solid solid; border-color: #cccccc; width: 90%; font-family:"Courier New"; } /* eof - php.css */ PEOF sub in_existing($) { my ($cf) = shift; my $ef = ''; foreach $ef (@existing) { if ($ef eq $cf) { return 1; } } return 0; } sub get_existing_files($) { my ($dir) = shift; my $df = ''; prt( "Getting list of EXISTING files in out folder [$dir] ...\n" ); opendir( THEDIR, $dir ) or mydie( "ERROR: Unable to open folder [$dir] ...\n" ); my @dfiles = readdir(THEDIR); # slurp in ALL directories, and files, (and . & ..!) closedir(THEDIR); my $fndcss = 0; my $fndjpg = 0; my $fndval = 0; my $fcnt = scalar @dfiles; foreach my $dfile (@dfiles) { $df = $dir . '/' . $dfile; # get full name if ($dir eq '.') { $df = $dfile; } if ( -d $df ) { # is directory? # if ($dfile eq '.' || $dfile eq '..') or if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') { # do nothing with DOT and DOUBLE DOT } else { ####push(@dir_list, $df); # save local DIRECTORY LIST $tot_dirs++; } } else { # it is a FILE $tot_files++; push(@existing, $dfile); if ($dfile =~ /^php\.css$/i) { prt( "NOTE: [$df] already exists ...\n" ); $fndcss = 1; } elsif ($dfile =~ /^$jpg_file$/i) { prt( "NOTE: [$df] already exists ...\n" ); $fndjpg = 1; } elsif ($dfile =~ /^$v401_file$/i) { prt( "NOTE: [$df] already exists ...\n" ); $fndval = 1; } } } if (!$fndcss) { $df = $dir.'/php.css'; prt( "NOTE: Creating [$df] ...\n" ); write2file( $phpcss, $df ); } if (!$fndjpg) { prt( "NOTE: Copying [$jpg_src] to [$jpg_des] ...\n" ); copy( $jpg_src, $jpg_des ) or mydie("ERROR: Failed to COPY [$jpg_src]!\n"); } if (!$fndval) { prt( "NOTE: Copying [$v401_src] to [$v401_des] ...\n" ); copy( $v401_src, $v401_des ) or mydie("ERROR: Failed to COPY [$v401_src]!\n"); } } sub write_chart($) { my ($oh) = shift; # mainly only for DEBUG print $oh <<"EOF"; Chart of Colours Used<br> <table border="1" summary="Table of colours, and count of times used"> <tr> <th>Class</th><th>Colour</th><th>Use</th><th>Count</th> </tr> <tr> <td><span class="$a_class">class='$a_class'</span></td> <td><span class="$a_class">$a_color RED</span></td> <td><span class="$a_class">Built-in Functions</span></td> <td><span class="$a_class">$a_cnt</span></td> </tr> <tr> <td><span class="$b_class">class='$b_class'</span></td> <td><span class="$b_class">$b_color BLUEGREEN</span></td> <td><span class="$a_class">Comments (following #)</span></td> <td><span class="$b_class">$b_cnt</span></td> </tr> <tr> <td><span class="$c_class">class='$c_class'</span></td> <td><span class="$c_class">$c_color BLUE</span></td> <td><span class="$a_class">Reserved Words</span></td> <td><span class="$c_class">$c_cnt</span></td> </tr> <tr> <td><span class="$d_class">class='$d_class'</span></td> <td><span class="$d_class">$d_color BROWN</span></td> <td><span class="$a_class">Inside qw(...)</span></td> <td><span class="$d_class">$d_cnt</span></td> </tr> <tr> <td><span class="$e_class">class='$e_class'</span></td> <td><span class="$e_class">$e_color DARKBLUE</span></td> <td><span class="$a_class">Scalar Variables</span></td> <td><span class="$e_class">$e_cnt</span></td> </tr> <tr> <td><span class="$f_class">class='$f_class'</span></td> <td><span class="$f_class">$f_color GREY</span></td> <td><span class="$a_class">Inside <<EOF thingy</span></td> <td><span class="$f_class">$f_cnt</span></td> </tr> <tr> <td><span class="$o_class">class='$o_class'</span></td> <td><span class="$o_class">$o_color ORANGE</span></td> <td><span class="$a_class">Array Variables</span></td> <td><span class="$o_class">$o_cnt</span></td> </tr> <tr> <td><span class="$v_class">class='$v_class'</span></td> <td><span class="$v_class">$v_color OLIVE</span></td> <td><span class="$a_class">Hash Variables</span></td> <td><span class="$v_class">$v_cnt</span></td> </tr> <tr> <td><span class="$t_class">class='$t_class'</span></td> <td><span class="$t_class">$t_color GREEN</span></td> <td><span class="$a_class">Single and Double Quotes</span></td> <td><span class="$t_class">$q_cnt</span></td> </tr> </table> <br>End of chart<br> EOF my $tot = ($a_cnt+$b_cnt+$c_cnt+$d_cnt+$e_cnt+$f_cnt+$o_cnt+$v_cnt+$q_cnt); my $diff = $out_total - $doc_total; print $oh "This use of $tot colour span sequences added $diff bytes. In=$doc_total Out=$out_total<br>\n"; } sub add_metas($$) { my ($oh, $ad) = @_; my $m = ''; my $m2 = ''; prt( "Add metas to handle ...\n" ) if ($dbg15); $m = '<meta name="author" content="geoff mclane">'."\n"; $m .= '<meta name="keywords" content="geoff, mclane, geoffmclane, computer, consultant, programmer,'."\n"; $m2 = 'php, scripts, samples, examples'; if ($ad) { foreach my $k (keys %HFuncsFnd) { if (length($m2) > 76) { $m2 .= ",\n"; $m .= $m2; $m2 = $k; } else { $m2 .= ', '.$k; } } } else { my $bcnt = scalar @AFileHashs; # collection of HASHES from each file my $nkys = ' '; my $ky = ''; my @kys = (); for (my $ih = 0; $ih < $bcnt; $ih++) { # for each HASH @kys = keys %{$AFileHashs[$ih]}; # get built-ins used for this file foreach $ky (@kys) { # go through the keys if ( !($nkys =~ / $ky /) ) { # if NOT already in the list $nkys .= $ky.' '; # add it } } } @kys = split(/ /, $nkys); # split the list into an array foreach $ky (@kys) { # and add each from the array if (length($ky)) { if (length($m2) > 76) { $m2 .= ",\n"; $m .= $m2; $m2 = $ky; } else { $m2 .= ', '.$ky; } } } } $m .= $m2; $m .= ', free">'."\n"; $m .= '<meta name="description" content="page of a computer programmer, with sample php scripts">'."\n"; print $oh $m; prt("$m") if ($dbg15); } ########################################################################## # The main file OUTPUT - that is the HTML file. # It establishes the HTML header, which includes the CSS style # information. then outputs each of the 'converted' lines ... # this is what it is all about - to generate a HTML document ########################################################################## sub write_out_file { my ($outf) = shift; my ($OTF); open $OTF, ">$outf" or mydie( "ERROR: Unable to create $outf ... aborting ...\n" ); print $OTF "$m_doctype\n"; print $OTF <<"EOF"; <html> <head> <title>$in_file to HTML</title> <meta http-equiv="Content-Language" content="en-gb"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> EOF add_metas($OTF, 1); print $OTF <<"EOF"; <link rel=stylesheet href="php.css" type="text/css"> </head> <body> EOF print $OTF "<h1>$in_file to HTML</h1>\n"; print $OTF '<p class="top"><a href="'.$indexhtm.'">index</a></p>'."\n"; print $OTF '<p align="center" class="sz4redb">USE AT OWN RISK</p>'."\n"; print $OTF '<p>Generated: ' . localtime(time()) . " from $in_file "; print $OTF YYYYMMDD($in_date).' '.b2KMG($in_size)." bytes.</p>\n"; if ($add_table) { print $OTF '<table width="100%" border="1" summary="Simple HTML of $in_file"><tr><td>'."\n"; } elsif ($add_pre) { print $OTF '<pre class="cd">'."\n"; } # actual output of generated lines foreach my $line (@nlines) { $out_total += length($line); print $OTF $line; } if ($add_table) { print $OTF '</td></tr></table>'."\n"; } elsif ($add_pre) { print $OTF '</pre>'."\n"; } if ($add_chart) { write_chart($OTF); } print $OTF '<p class="top"><a href="'.$indexhtm.'">index</a></p>'."\n"; # add 4.01 validation ... print $OTF <<"EOF"; <p> <a href="http://validator.w3.org/check?uri=referer"> <img src="valid-html401.gif" alt="Valid HTML 4.01 Transitional" width="88" height="31"> </a> </p> EOF print $OTF "</body>\n"; print $OTF "</html>\n"; close($OTF); if ($dbg16) { # show the WRITTEN line count ... if (open TTF, "<$outf") { my @tmparr = <TTF>; close(TTF); prt( "Written ".(scalar @tmparr)." lines to [$outf]...\n" ); } } } ######################################################### ###################################################### # Converting SPACES to ' ' # Of course this could be done just using perl's # powerful search and replace, but this handles # any number of spaces, only converting the number # minus 1 to ... not sure how to have # this level of control with regex replacement ###################################################### sub conv_spaces { my $t = shift; my ($c, $i, $nt, $ln, $sc, $sp); $nt = ''; # accumulate new line here $ln = length($t); for ($i = 0; $i < $ln; $i++) { $c = substr($t,$i,1); if ($c eq ' ') { $i++; # bump to next $sc = 0; $sp = ''; for ( ; $i < $ln; $i++) { $c = substr($t,$i,1); if ($c ne ' ') { last; # exit } $sc++; $sp .= $c; } if ($sc) { $sp =~ s/ / /g; $nt .= $sp; } $i--; # back up one $c = ' '; # add back the 1 space } $nt .= $c; } prt( "conv_space: from [$t] to [$nt] ...\n" ) if $dbg7; return $nt; } ########################################################################### # VERY IMPORTANT SERVICE # This converts the 'text' into HTML text, but only does a partial job! # 1. Convert '&' to '&' to avoid interpreting as replacement # 2. Convert '<' to '<' to avoid interpreting as HTML # 3. Convert '"' to '"' # 4. Convert '\t' to SPACES # 5. Finally, if there are double or more SPACES, convert to ' ' ########################################################################### sub html_line { my $t = shift; my $ot = $t; $t =~ s/&/&/g; # all '&' become '&' $t =~ s/</</g; # make sure all '<' is/are swapped out $t =~ s/\"/"/g; # and all quotes become " $t =~ s/\t/$tab_space/g; # tabs to spaces if (($conv_space > 0) && ($t =~ /\s\s/)) { # if any two consecutive white space return conv_spaces($t); } prt( "html_line: from [$ot] to [$t] ...\n" ) if $dbg6; return $t; } sub remove_html_encode($) { my $t = shift; my $ot = $t; $t =~ s/&/&/gm; # all '&' become '&' $t =~ s/</</gm; # make sure all '<' is/are swapped out $t =~ s/"/\"/gm; # and all quotes become " $t =~ s/ / /gm; prt( "html_line: from [$ot] to [$t] ...\n" ) if $dbg6; return $t; } sub get_dir_files($) { my ($dir) = shift; prt( "Getting list of EXISTING files in out folder [$dir] ...\n" ); opendir( THEDIR, $dir ) or mydie( "ERROR: Unable to open folder [$dir] ...\n" ); @dirfiles = readdir(THEDIR); # slurp in ALL directories, and files, (and . & ..!) closedir(THEDIR); my $dcnt = scalar @dirfiles; prt( "Processing $dcnt items in directory [$in_folder] ...\n" ); foreach my $fil (@dirfiles) { if (($fil =~ /^\.$/)||($fil =~ /^\.\.$/)) { prt("skip dot and double dot - [$fil]\n") if ($dbg1); next; } my $ff = $dir . '/' . $fil; my $sb = stat($ff); my $ext = my_get_ext($ff); if ($fil =~ /^temp.*/i) { prt( "Got TEMP ext=[$ext] [$fil] ... \n" ) if ($dbg2); } elsif ($ext =~ /^php$/i) { push(@php_list, [$fil, $sb->mtime, $sb->size]); prt( "Got PHP ext=[$ext] [$fil] [".YYYYMMDD($sb->mtime)."] [".$sb->size."]... \n" ) if ($dbg3); } else { prt( "Got OTHER ext=[$ext] [$fil] ... \n" ) if ($dbg2); } } } sub get_split_line($) { my ($ln) = shift; my $len = length($ln); my $an = 0; my $sp = 0; my @ra = (); # return this my $bit = ''; for (my $i = 0; $i < $len; $i++) { my $ch = substr($ln,$i,1); # get next char if ($an) { # building alpha numeric if ($ch =~ /\w/) { # still building $bit .= $ch; # accumuate an_ } else { push(@ra, $bit) if (length($bit)); $bit = $ch; # start with this $an = 0; # not an if ($ch =~ /\s/) { # if white space $sp = 1; # begin accumuation of space } else { # not a space if (($ch eq '"')||($ch eq "'")) { # separate push(@ra, $ch); # keep these chars SEPARATE $bit = ''; } $sp = 0; } } } else { # not in an yet if ($ch =~ /\w/) { # enter an push(@ra, $bit) if (length($bit)); $bit = $ch; $an = 1; # is an } else { # not an if ($sp) { if ( !($ch =~ /\s/) ) { # space ended push(@ra, $bit) if (length($bit)); # add any space $sp = 0; if (($ch eq '"')||($ch eq "'")) { # separate push(@ra, $ch); $bit = ''; } else { $bit = $ch; # restart accumulation } } } else { # not in space if ($ch =~ /\s/) { # space started push(@ra, $bit) if (length($bit)); $bit = $ch; $sp = 1; } else { if (($ch eq '"')||($ch eq "'")) { # separate push(@ra, $bit) if (length($bit)); # put in any previous push(@ra, $ch); # and this char alone $bit = ''; } elsif ($ch eq '<') { push(@ra, $bit) if (length($bit)); # put in any previous $bit = $ch; # always start a bit with this } else { $bit .= $ch; # accumulate } } } } } } push(@ra, $bit) if (length($bit)); return @ra; } sub reset_lines() { # set at start of set of lines to process $in_php = 0; $in_com = 0; $got_gt = 0; $php = ''; $com = ''; $htm = ''; $bit = ''; $ist = 0; @nlines = (); $nline = ''; $g_lc = 0; $g_olc = 0; } sub enter_php() { if ($blen >= 2) { if (substr($bit,0,2) eq '<?') { $in_php = 1; $php = $bit; prt( "Enter PHP line $g_lc ... [$php][$g_line]\n" ) if ($dbg12); return 1; } } return 0; } sub enter_com() { if ( !$in_php && ($blen >= 4)) { if (substr($bit,0,4) eq '<!--') { $in_com = 1; $com = $bit; prt( "Enter COM line $g_lc ... [$com][$g_line]\n" ) if ($dbg13); return 1; } } return 0; } sub add_2_BI($) { my ($t) = shift; if (exists $HFuncsFnd{$t}) { ### prt ( "Bumped Funcs [$t] ...\n" ); $HFuncsFnd{$t}++; # another count } else { ### prt ( "Created Funcs [$t] ...\n" ); $HFuncsFnd{$t} = 1; # start count } } sub add_2_RW($) { my ($t) = shift; if (exists $HResWdFnd{$t}) { ### prt ( "Bumped Funcs [$t] ...\n" ); $HResWdFnd{$t}++; # another count } else { ### prt ( "Created Funcs [$t] ...\n" ); $HResWdFnd{$t} = 1; # start count } } #if ($kw == 1) { #my @stxRW = (); # add_red sub in_stx_RW($) { my ($t) = shift; foreach my $rw (@stxRW) { if ($t eq $rw) { add_2_RW($t); return 1; } } return 0; } #} elsif ($kw == 2) { #my @stxBI = (); # add_blue sub in_stx_BI($) { my ($t) = shift; foreach my $rw (@stxBI) { if ($t eq $rw) { add_2_BI($t); return 1; } } return 0; } my @php_la = (); my @php_aol = (); my $php_bi = ''; my $php_ct = 0; my $php_pi = 0; my $php_bl = 0; my $php_c = ''; my $php_d = ''; my $php_p2 = 0; my $php_lc = 0; my $php_i = 0; sub process_php_quote() { my ($tx, $tx2); my $php_qe = 0; $php_d = ''; $tx2 = ''; prt( "$php_pi: Start quote [$php_c] ... [$php_bi] \n" ) if ($dbg8); $tx = $php_c; for ($php_p2 = 1; $php_p2 < $php_bl; $php_p2++) { $php_d = substr($php_bi,$php_p2,1); $tx .= $php_d; if ($php_c eq $php_d) { prt( "$php_pi: End 1 quote [$php_d] ... [$php_bi]tx=[$tx] \n" ) if ($dbg8); $php_qe = 1; last; } } if ($php_c ne $php_d) { $php_pi++; # move to next bit for ( ; $php_pi < $php_ct; $php_pi++) { $php_bi = $php_aol[$php_pi]; $php_bl = length($php_bi); prt( "$php_pi: Finding End quote [$php_c] ... [$php_bi]tx=[$tx] \n" ) if ($dbg8); for ($php_p2 = 0; $php_p2 < $php_bl; $php_p2++) { $php_d = substr($php_bi,$php_p2,1); $tx .= $php_d; if ($php_c eq $php_d) { prt( "$php_pi: End 2 quote [$php_d] ... [$php_bi]tx=[$tx] \n" ) if ($dbg8); $php_p2++; if ($php_p2 < $php_bl) { $tx2 = substr($php_bi,$php_p2); # get balance prt( "Got balance ... [$php_bi]tx2=[$tx2] \n" ) if ($dbg8); } $php_qe = 1; last; } } last if ($php_qe); # exit bit loop } } # assume we got to the end of the quoted text prt( "$php_pi: Assumed end quote [$php_c] ... [$php_bi]tx=[$tx] \n" ) if ($dbg8); $nline .= add_quote(html_line($tx)); $nline .= html_line($tx2) if (length($tx2)); } sub process_php_comment() { # is a // comment to end of line my $txc = ''; for ( ; $php_pi < $php_ct; $php_pi++) { $txc .= $php_aol[$php_pi]; } $nline .= add_class_f(html_line($txc)); } sub parse_php() { @php_la = split("\n",$php); $php_lc = scalar @php_la; for ($php_i = 0; $php_i < $php_lc; $php_i++) { my $pl = $php_la[$php_i]; chomp $pl; $pl =~ s/\r$//; @php_aol = get_split_line($pl); $php_ct = scalar @php_aol; for ($php_pi = 0; $php_pi < $php_ct; $php_pi++) { $php_bi = $php_aol[$php_pi]; $php_bl = length($php_bi); $php_c = substr($php_bi,0,1); if (($php_c eq '"')||($php_c eq "'")) { process_php_quote(); } elsif (($php_bl >= 2)&&(substr($php_bi,0,2) eq '<?')) { $nline .= add_class_e(html_line($php_bi)); } elsif (($php_bl >= 2)&&(substr($php_bi,0,2) eq '?>')) { $nline .= add_class_e(html_line($php_bi)); } elsif (in_stx_RW($php_bi)) { $nline .= add_blue(html_line($php_bi)); } elsif (in_stx_BI($php_bi)) { $nline .= add_red(html_line($php_bi)); } elsif (($php_bl >= 2)&&(substr($php_bi,0,2) eq '//')) { process_php_comment(); } else { $nline .= html_line($php_bi); } } # for each of the line bits if ($php_lc > 1) { $nline .= "\n"; } } # for each line $php = ''; # kill the PHP accumulation } sub process_php() { for ( ; $ii < $alen; $ii++) { $bit = $lnbits[$ii]; $blen = length($bit); $ch = substr($bit,0,1); $php .= $bit; if ($blen >= 2) { if (substr($bit,0,2) eq '?>') { prt( "Exit PHP line $g_lc ... [$php][$g_line]\n" ) if ($dbg14); prt( "Exit PHP line $g_lc ... [$g_line]\n" ) if ($dbg12); parse_php(); $in_php = 0; return 1; # potentially before EOL } } } $php .= "\n"; return 0; # reached EOL } sub parse_com() { my @la = split("\n",$com); prt( "Exit COM new $g_lc: ...\n" ) if ($dbg13); foreach my $cl (@la) { chomp $cl; $cl =~ s/\r$//; $com = add_class_b(html_line($cl)); prt( "[$com]\n" ) if ($dbg13); $nline .= $com."\n"; } } sub process_com() { for ( ; $ii < $alen; $ii++) { $bit = $lnbits[$ii]; $blen = length($bit); $ch = substr($bit,0,1); $com .= $bit; if ($blen >= 3) { if (substr($bit,0,3) eq '-->') { $in_com = 0; prt( "Exit COM line $g_lc ... [$com][$g_line]\n" ) if ($dbg13); ##$nline .= $com; parse_com(); $com = ''; return 1; # potentially before EOL } } } $com .= "\n"; return 0; # reached EOL } sub get_following($) { # substr($h, $hi); my ($tx) = shift; my $rt = ''; my $ln = length($tx); my $il = 0; my $c = ''; my $d = ''; if ($il < $ln) { $d = substr($tx,$il,1); } prt( "Get following from [$tx] ...\n" ) if ($dbg9); if (($d eq '"')||($d eq "'")) { $rt = $d; for ($il = 1; $il < $ln; $il++) { $c = substr($tx,$il,1); $rt .= $c; if ($d eq $c) { last; } } } elsif ($d =~ /\w/) { $rt = $d; for ($il = 1; $il < $ln; $il++) { $c = substr($tx,$il,1); if ( !($c =~ /\w/) ) { last; } $rt .= $c; } } prt( "Get following returning [$rt] ...\n" ) if ($dbg9); return $rt; } sub parse_htm($) { my ($h) = shift; my $retl = ''; my ($c, $hi, $hl, $ht, $ha, $hn, $issp, $isan, $d, $flen); $hl = length($h); $ha = ''; $issp = 0; $h = remove_html_encode($h); prt( "parse_htm on [$h]\n" ) if ($dbg9); $hl = length($h); for ($hi = 0; $hi < $hl; $hi++) { $c = substr($h,$hi,1); if ($c eq '<') { # start of tag $ht = ''; $hn = ''; $hi++; $retl .= html_line($ha) if (length($ha)); $ha = ''; for ( ; $hi < $hl; $hi++) { $c = substr($h,$hi,1); if ($c =~ /\w/) { $ht .= $c; } elsif ($c eq '/') { $hn = $c; } else { last; } } $retl .= html_line('<'); $retl .= $hn; if (is_htm_tag($ht)) { $retl .= add_blue(html_line($ht)); } else { $retl .= html_line($ht); } $retl .= $c; if ($c ne '>') { $hi++; $ht = ''; $hn = ''; # establish next is an_ or not # and space or not $isan = 0; $issp = 0; if ($c =~ /\w/) { $isan = 1; } elsif ($c =~ /\s/) { $issp = 1; } while ($hi < $hl) { $d = ''; for ( ; $hi < $hl; $hi++) { $c = substr($h,$hi,1); if ($c eq '>') { $ht .= $c; last; } # switching in and out of an_ if ($isan) { if ($c =~ /\w/) { $ht .= $c; # cont. an_ accumulation } elsif ($c eq '=') { if (length($ht)) { if( is_htm_att($ht) ) { $retl .= add_red(html_line($ht)); } else { $retl .= html_line($ht); } } $ht = $c; $isan = 0; # now not } else { if (length($ht)) { $retl .= html_line($ht); } $ht = $c; $isan = 0; # now not } } else { # not in an_ if ($c =~ /\w/) { $retl .= html_line($ht) if (length($ht)); if (($d eq '=')&&(($hi + 1) < $hl)) { $hn = get_following(substr($h, $hi)); $flen = length($hn); if ($flen) { $retl .= add_quote(html_line($hn)); $hi += ($flen - 1); $ht = ''; } else { $ht = $c; } } else { $ht = $c; # start an_ } $isan = 1; } else { # here with next char potentially after '=' if (($d eq '=')&&(($hi + 1) < $hl)) { $hn = get_following(substr($h, $hi)); $flen = length($hn); if ($flen) { $retl .= html_line($ht) if (length($ht)); $retl .= add_quote(html_line($hn)); $hi += ($flen - 1); $ht = ''; } else { $ht .= $c; } } else { $ht .= $c; # accumulate nots } } } prt( "Got EQUAL... isan=[$isan] [".substr($h,$hi)."]\n" ) if ($dbg9 && ($c eq '=')); $d = $c; # keep previous } if ($c eq '>') { last; } } $retl .= html_line($ht) if (length($ht)); } } else { if ($c eq "\n") { $retl .= html_line($ha) if (length($ha)); $ha = ''; $retl .= $c; } else { $ha .= $c; } } } return $retl; } sub process_htm() { for ( ; $ii < $alen; $ii++) { $bit = $lnbits[$ii]; $blen = length($bit); $ch = substr($bit,0,1); if ($ch eq '<') { if (enter_php() || enter_com()) { $nline .= parse_htm($htm); $htm = ''; return 1; } } # processing HTML $htm .= $bit; } $htm .= "\n"; # reached EOL return 0; } sub show_line_bits() { prt( " $g_lc:" ); for ($ii = 0; $ii < $alen; $ii++) { $bit = $lnbits[$ii]; $blen = length($bit); $ch = substr($bit,0,1); prt( "$blen" ); prt( "[$bit]" ); } prt("$len $alen p=$in_php c=$in_com\n"); } sub process_line() { ##prt( "LINE $g_lc: [$g_line] p=$in_php c=$in_com...\n" ) if ($dbg4); prt( "LINE $g_lc: [$g_line] p=$in_php c=$in_com...\n" ) if ($dbg10); my $len = length($g_line); @lnbits = get_split_line($g_line); $alen = scalar @lnbits; show_line_bits() if ($dbg5); if ($alen) { for ($ii = 0; $ii < $alen; $ii++) { if ($in_php) { process_php(); } else { # in HTML if ($in_com) { process_com(); } else { process_htm(); } } } # for the array of line bits } else { if ($in_php) { process_php(); } elsif ($in_com) { process_com(); } else { process_htm(); # add a blank } } $nline .= parse_htm($htm); $htm = ''; if ((length($nline) == 0) && !$in_com && !$in_php) { $nline .= "\n"; } push(@nlines, "$nline"); my @nlns = split("\n", $nline); foreach my $nln (@nlns) { $g_olc++; prt( "NEW $g_olc: [$nln]\n" ) if ($dbg11); } $nline = ''; } sub process_file($$) { my ($ff, $fil) = @_; if (open IF, "<$ff") { my @lines = <IF>; close IF; my $sb = stat($ff); my $lc = scalar @lines; prt( "\nProcessing $lc lines in [$fil], ". YYYYMMDD($sb->mtime).", of ".b2KMG($sb->size)." bytes.\n" ); reset_count(); reset_lines(); foreach my $ln (@lines) { $g_line = $ln; chomp $g_line; $g_line =~ s/\r$//; $g_lc++; process_line(); } # for each LINE my $nf = my_get_filetitle($fil).'.htm'; my $nfo = $out_folder."\\".$nf; prt("Done $g_lc lines of [$fil] ... $g_olc (".scalar @nlines.") lines out to [$nfo] ...\n"); my %th = %HFuncsFnd; my @tar = keys %th; prt("Pushing HASH with ".scalar @tar." keys ...\n"); push(@AFileNames, $nf ); push(@AFileHashs, \%th); # store the functions used ... # could check if already exists, and the date written, like p2hall03.pl if ( -f $nfo) { my $sb2 = stat($nfo); if ($sb->mtime < $sb2->mtime) { if ($skipexisting) { prt( "Skipping [$nfo] since it already exists ...\n" ); $nfo = ''; # kill the new output } $skipped++; # older or same } else { $newercnt++; } } else { $newcnt++; } write_out_file($nfo) if length($nfo); # create, and WRITE the HTML out file to this new file name push(@ind_files, [$nf, $in_date, $in_size, $in_file]); return 1; } else { prt( "WARNING: Failed to open [$ff] ...\n" ); } return 0; } sub process_files($) { my ($dir) = shift; my $cnt = scalar @php_list; prt( "Processing $cnt files from folder [$dir] ...\n" ); for (my $i = 0; $i < $cnt; $i++) { my $fil = $php_list[$i][0]; $in_date = $php_list[$i][1]; $in_size = $php_list[$i][2]; $in_file = $fil; my $ff = $dir.'/'.$fil; if ($in_date > $latest) { $latest = $in_date; } if ($in_date < $earliest) { $earliest = $in_date; } process_file($ff, $fil); } # for $i to $cnt } sub my_get_path($) { my ($d) = shift; $d =~ s/\\/\//g; if ($d =~ /\/$/) { # if it ends in a path return $d; # return it ALL } my @arr = split('/',$d); pop @arr; return (join('/',@arr)); } sub my_get_filename($) { my ($p) = shift; my $d = my_get_path($p); my $f = $p; $f = substr($p, length($d) + 1) if (length($d)); return $f; } sub my_get_ext($) { my ($p) = shift; my $f = my_get_filename($p); my @a = split(/\./, $f); my $c = scalar @a; ### prt("IN=[$p] d=[$d] f=[$f] $c ...\n"); if ($c > 1) { return $a[-1]; # get last 'ext' entry } elsif (substr($f,0,1) eq '.') { return $f; } return ''; } sub my_get_filetitle($) { my ($p) = shift; my $f = my_get_filename($p); my @a = split(/\./, $f); my $cnt = scalar @a; if ($cnt > 1) { pop @a; # drop last 'ext' entry return join( '.', @a); } return $f; } ################################################ # My particular time 'translation' sub YYYYMMDD { my ($tm) = shift; # 0 1 2 3 4 5 6 7 8 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm); $year += 1900; $mon += 1; my $ymd = "$year/"; if ($mon < 10) { $ymd .= '0'.$mon.'/'; } else { $ymd .= "$mon/"; } if ($mday < 10) { $ymd .= '0'.$mday; } else { $ymd .= "$mday"; } return $ymd; } ################################################## # My particular bytes to K, M, G sub b2KMG($) { my ($d) = shift; if ($d < 1000) { return $d; } my $oss; my $kss; my $lg = 0; my $ks = ($d / 1024); #// get Ks my $div = 1; if( $ks < 1000 ) { $div = 1; $oss = "KB"; } elsif ( $ks < 1000000 ) { $div = 1000; $oss = "MB"; } elsif ( $ks < 1000000000 ) { $div = 1000000; $oss = "GB"; } else { $div = 1000000000; $oss = "TB"; } $kss = $ks / $div; $kss += 0.05; $kss *= 10; $lg = int($kss); return( ($lg / 10) . " " . $oss ); ###return( ($lg / 10) . $oss ); } ################################################## # My particular 'nice number' sub get_nn { # perl nice number nicenum add commas my ($n) = shift; if (length($n) > 3) { my $mod = length($n) % 3; my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : ''); my $mx = int( length($n) / 3 ); for (my $i = 0; $i < $mx; $i++ ) { if (($mod == 0) && ($i == 0)) { $ret .= substr( $n, ($mod+(3*$i)), ($mod+(3*$i)+3) ); } else { $ret .= ',' . substr( $n, ($mod+(3*$i)), ($mod+(3*$i)+3) ); } } return $ret; } return $n; } #################################### #################################### # Reducing a line to bare bones # Used when loading # the EditPlus 2 stx files. #################################### sub trim_line($) { my ($l) = shift; chomp $l; # remove LF $l =~ s/\r$//; # and remove CR, if present $l =~ s/\t/ /g; # tabs to a space $l =~ s/\s\s/ /g while ($l =~ /\s\s/); # duplicate space to single $l = substr($l,1) while ($l =~ /^\s/); # each off leading space $l = substr($l,0,length($l)-1) while (($l =~ /\s$/)&&(length($l))); # and trailing space return $l; } #Loading HTML stx [C:/Program Files/EditPlus 2/html.stx] ... #Got KEYWORD [HTML Tags] ... #Got KEYWORD [HTML Attributes] ... #Got KEYWORD [Special characters] ... sub load_html_stx($) { my ($fil) = shift; my $kw = 0; my $nl = ''; prt("Loading HTML stx [$fil] ...\n"); open IF, "<$fil" or mydie( "ERROR: Unable to open [$fil] ...\n" ); my @la = <IF>; close IF; foreach my $ln (@la) { chomp $ln; $ln =~ s/\r$//; if ($ln =~ /^#/) { if ($ln =~ /^#KEYWORD=(.*)/) { prt( "Got KEYWORD [$1] ...\n" ); if ($1 eq 'HTML Tags') { $kw = 1; next; } elsif ($1 eq 'HTML Attributes') { $kw = 2; next; } elsif ($1 eq 'Special characters') { $kw = 3; next; } } $kw = 0; next; } if ($kw == 1) { $nl = trim_line($ln); push(@stxHTM, $nl) if (length($ln)); } elsif ($kw == 2) { $nl = trim_line($ln); push(@stxATT, $nl) if (length($ln)); } elsif ($kw == 3) { $nl = trim_line($ln); push(@stxSPL, $nl) if (length($ln)); } } } sub is_htm_tag($) { my ($tg) = shift; foreach my $t (@stxHTM) { if (uc($t) eq uc($tg)) { return 1; } } return 0; } sub is_htm_att($) { my ($tg) = shift; foreach my $t (@stxATT) { if (uc($t) eq uc($tg)) { return 1; } } return 0; } sub is_in_htm($) { my ($tg) = shift; ##prt( "Testing [$tg] "); $tg =~ s/^\///; # remove any leading '/' ##prt( "now 1 [$tg] " ); if ($tg =~ /\/$/) { # if there is a trailing '/' $tg =~ s/\/$//; # remove that $tg = trim_line($tg); # and trim ##prt( "now 2 [$tg] " ); } my @a = split(/ /,$tg); # split the tag away for any attributes if (scalar @a > 1) { $tg = $a[0]; # just get the first } ##prt( "now 3 [$tg]\n" ); return is_htm_tag($tg); } #Loading PHP stx [C:/Program Files/EditPlus 2/php.stx] ... #Got KEYWORD [Reserved words] ... #Got KEYWORD [Built-in functions] ... #Got KEYWORD [Variables] ... sub load_php_stx($) { my ($fil) = shift; my $kw = 0; my $nl = ''; prt("Loading PHP stx [$fil] ...\n"); open IF, "<$fil" or mydie( "ERROR: Unable to open [$fil] ...\n" ); my @la = <IF>; close IF; foreach my $ln (@la) { chomp $ln; $ln =~ s/\r$//; if ($ln =~ /^#/) { if ($ln =~ /^#KEYWORD=(.*)/) { prt( "Got KEYWORD [$1] ...\n" ); if ($1 eq 'Reserved words') { $kw = 1; next; } elsif ($1 eq 'Built-in functions') { $kw = 2; next; } elsif ($1 eq 'Variables') { $kw = 3; next; } } $kw = 0; next; } elsif ($ln =~ /^;/) { # skip these 'comments' next; } if ($kw == 1) { $nl = trim_line($ln); push(@stxRW, $nl) if (length($ln)); } elsif ($kw == 2) { $nl = trim_line($ln); push(@stxBI, $nl) if (length($ln)); } elsif ($kw == 3) { $nl = trim_line($ln); push(@stxVA, $nl) if (length($ln)); } } } sub do_stx_load() { load_html_stx( $html_stx ); prt( "Loaded ".scalar @stxHTM." HTM, ".scalar @stxATT." ATT, and ".scalar @stxSPL." spls\n" ); load_php_stx( $php_stx ); prt( "Loaded ".scalar @stxRW." RW, ".scalar @stxBI." BI, and ".scalar @stxVA." vars\n" ); } sub out_link_line($$) { my ($oh, $num) = @_; print $oh '<p class="ctr">'; print $oh ' [ <a href="#top">top</a> ] '."\n" if ($num != 1); print $oh ' [ <a href="#alphabetic">alphabetic table</a> ] '."\n" if ($num != 2); print $oh ' [ <a href="#dateindex">date table</a> ] '."\n" if ($num != 3); print $oh ' [ <a href="#jumptable">jump table</a> ] '."\n" if ($num != 4); print $oh ' [ <a href="../index.htm">PHP Index</a> ] '."\n"; print $oh "</p>\n"; } sub mycmp_decend2 { my $off = 1; if (${$a}[$off] < ${$b}[$off]) { prt( "+[".${$a}[$off]."] < [".${$b}[$off]."]\n" ) if $verb3; return 1; } if (${$a}[$off] > ${$b}[$off]) { prt( "-[".${$a}[$off]."] < [".${$b}[$off]."]\n" ) if $verb3; return -1; } prt( "=[".${$a}[$off]."] == [".${$b}[$off]."]\n" ) if $verb3; return 0; } # push(@AFileNames, $ind_file); store the file # push(@AFileHashs, \%hr); # and store the functions used ... sub add_jump_table($) { my ($oh) = shift; my $acnt = scalar @AFileNames; my $bcnt = scalar @AFileHashs; my ($itm, $bi, $b3, $msg); my %nh = (); my @b2 = (); %nh = %HOldbifs; # get any OLD, from the OLD index @b2 = keys %nh; $b3 = scalar @b2; if ($acnt != $bcnt) { prt("\nWARNING: THESE TWO COUNTS SHOULD BE THE SAME!!! $acnt vs $bcnt ???\n"); } prt("Adding jump table for $acnt ($bcnt) new hashes ... plus $b3 from OLD index ...\n"); for ($itm = 0; $itm < $acnt; $itm++) { my $fl = $AFileNames[$itm]; my $hr = $AFileHashs[$itm]; my $nfl = ''; prt("Processing file [$fl] ...\n") if ($verb4); ###my @kys = keys %{$hr}; # get built-ins for this file my @kys = keys %{$AFileHashs[$itm]}; # get built-ins for this file if (@kys) { foreach my $ky (@kys) { $nfl = ''; if (exists $nh{$ky} ) { $nfl = $nh{$ky}; } if ( $nfl =~ /$fl/i ) { prt("$ky - File [$fl] aready in [$nfl] ...\n") if ($verb4); } else { if (length($nfl) && !($nfl =~ /\s$/) ) { $nfl .= ' '; # add space } prt("$ky - Adding [$fl] to [$nfl] ...\n") if ($verb4); $nfl .= $fl; # add file with this built-in $nh{$ky} = $nfl; # store or create built-in with this, these files } } } else { prt("Failed ... NO KEYS for file [$fl] ... check ...\n"); } } # done generation of a set of built in, with each file that contains that built-in @b2 = sort keys %nh; $b3 = scalar @b2; if ( @b2 && ($b3 > 0)) { my $allbi = ' '.join(' ', @stxBI).' '; # ensure begin and end with space prt("Adding 3rd table with $b3 built-ins ...\n"); out_link_line($oh, 4); # avoid jumptable $msg = "<a name=\"jumptable\"></a>\n"; $msg .= "<p>This is a link/jump table for built-in functions. "; $msg .= "The link is to file(s) using that function. Enjoy ;=))</p>\n"; print $oh $msg; print $oh '<table width="100%" border="1" summary="jump index to samples">'."\n"; print $oh '<caption>Jump index to samples</caption>'."\n"; print $oh '<tr><th>Built-In</th><th>Jump file(s)</th></tr>'."\n"; foreach $bi (@b2) { my $v = $nh{$bi}; $msg = "<tr>\n"; $allbi =~ s/\s+$bi\s+/ /; # delete this entry $msg .= '<td>'.add_red($bi)."</td>\n"; ###$msg .= '<td>'.$v."</td>\n"; my @tmpa = split(/\s/,$v); $msg .= "<td>\n"; ###foreach my $tmpf (@tmpa) { foreach my $tmpf (sort @tmpa) { # put jumps in alphabetic order $msg .= " <a href=\"$tmpf\">$tmpf</a>\n"; } $msg .= "</td>\n"; $msg .= "</tr>\n"; print $oh $msg; } $allbi = trim_line($allbi); if (length($allbi)) { $msg = "<tr>\n"; $msg .= "<td><b>unused<b></td>\n"; $msg .= "<td>".add_red($allbi)."</td>\n"; $msg .= "</tr>\n"; print $oh $msg; } print $oh "</table>\n"; } else { prt( "Failed ... no keys in %nh ... NO JUMP TABLE DONE!\n" ); } } sub add_new_table($) { my ($oh) = shift; my @ind_sort = sort mycmp_decend2 @ind_files; my $icnt = scalar @ind_sort; my $cnt = 0; my $i = 0; my $line = ''; my $date = ''; my $sz = 0; my $msg = ''; my $inf = ''; prt("Adding 2nd table ...\n"); out_link_line($oh, 3); # avoid dateindex $msg = "<a name=\"dateindex\"></a>\n"; $msg .= "<p>This is a repeated table in date order, with the latest, most recent listed first."; $msg .= " Enjoy ;=))</p>\n"; print $oh $msg; print $oh '<table width="100%" border="1" summary="Date index to PHP samples">'."\n"; print $oh '<caption>Date index to PHP samples</caption>'."\n"; # actual output of SORTED generated lines $cnt = 0; for ($i = 0; $i < $icnt; $i++) { $line = $ind_sort[$i][0]; $date = YYYYMMDD($ind_sort[$i][1]); $sz = get_nn($ind_sort[$i][2]); $inf = $ind_sort[$i][3]; $msg = ''; if ($cnt == 0) { $msg = "<tr>\n"; } ###mark_old_index($line); $msg .= "<td align=\"center\">$date<br><a href=\"$line\">$line</a><br>$sz</td>\n"; ###$msg .= "<td align=\"center\">$date<br><a href=\"$line\">$inf</a><br>$sz</td>\n"; $cnt++; if ($cnt == $wrap) { $msg .= "</tr>\n"; $cnt = 0; } print $oh $msg; } if ($cnt) { $msg = ''; while ($cnt < $wrap) { $msg .= "<td> </td>"; $cnt++; } $msg .= "\n</tr>\n"; print $oh $msg; } print $oh "</table>\n"; } sub generate_index { # output @ind_files - array of files to index.htm my $icnt = scalar @ind_files; my $cnt = 0; my $msg = ''; my $i = 0; my $dcnt = 0; my $ocnt = 0; my $acnt = 0; # added to index.htm my ($OF, $line, $date, $sz, $tsc); my $inf = ''; if ($icnt == 0) { prt( "No index.htm generated - no files to list ...\n" ); return; } my $slatest = YYYYMMDD($latest); my $searly = YYYYMMDD($earliest); my $of = $in_index; ## "$out_folder/$indexhtm"; # = something line 'index.htm'; $tsc = 0; open $OF, ">$of" or mydie("ERROR: Unable to generate index file ...aborting ...\n"); prt( "\nWriting [$of] HTML with $icnt files ...\n" ); print $OF "$m_doctype\n"; print $OF <<"EOF"; <html> <head> <title>Index to PHP Samples</title> <meta http-equiv="Content-Language" content="en-gb"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> EOF add_metas($OF, 0); print $OF <<"EOF"; <link rel=stylesheet href="php.css" type="text/css"> </head> <body> EOF print $OF "<h1>Index to PHP Samples</h1>\n"; out_link_line($OF, 1); # avoid adding top print $OF <<"EOF"; <a name="top" id="top"></a> <p align="center" class="sz4redb">USE AT OWN RISK</p> <p>This is a rather random sample of the PHP scripts I have generated over the last few years ($searly - $slatest). Some represent complete PHP applications, aimed at a particular purpose, while others are just samples, sometimes not functional! And some, are only 'include' files. A small amount of script has been scraped from various web site, to test some suggested functionality, but most are largely my own fun and games with PHP.</p> <p>When there is a series numbered 01, 02, 03, etc, this usually means the latest is the largest number, but sometimes they are different samples. However, the date following each file name link is a further indication of the age of the sample. And the original file size, in bytes, follows that.</p> <p>Each of these HTML files are generated from the PHP script, php2htm01.pl, with colour coding added, and, as can be read in the preamble to another 'converter', <a href="http://geoffmclane.com/mperl/samples/p2hall02.htm" target="_blank">p2hall02.pl</a>, this means sometimes a simple copy and paste will fail, due mainly to a 'translation' of certain characters. But most of the time it should be ok, or only require minor fixes.</p> <p>As always, <font size="2" color="red"><b>*** USE AT OWN RISK ***</b></font>. These are in the 'public domain' thus there is no 'licence' to worry about. Of course you MUST have a PHP runtime installed, and in some special cases, additional PHP 'libraries' installed/enabled, to run those particular files locally, or on a host.</p> <a name="alphabetic"></a> <p>The table is repeated. The first should be more or less in file alphabetic order, the second is in <a href="#dateindex"><b>date order</b></a> table, with the latest listed first. Then there is a <a href="#jumptable"><b>'jump'</b></a> table, where each PHP built-in function is list, with links to the file(s) that use that built-in. Enjoy ;=))</p> EOF out_link_line($OF, 2); # avoid adding alphabetc print $OF '<table width="100%" border="0" summary="Alphabetic index to PHP samples">'."\n"; print $OF '<caption>Alphabetic index to PHP samples</caption>'."\n"; # actual output of generated lines $cnt = 0; # for $wrap #foreach $line (@ind_files) { for ($i = 0; $i < $icnt; $i++) { $line = $ind_files[$i][0]; $date = YYYYMMDD($ind_files[$i][1]); $sz = get_nn($ind_files[$i][2]); $inf = $ind_files[$i][3]; $msg = ''; if ($cnt == 0) { $msg = "<tr>\n"; } mark_old_index($line); $msg .= "<td><a href=\"$line\">$line</a><br>$date<br>$sz</td>\n"; ###$msg .= "<td><a href=\"$line\">$inf</a><br>$date<br>$sz</td>\n"; $cnt++; if ($cnt == $wrap) { $msg .= "</tr>\n"; $cnt = 0; } print $OF $msg; $acnt++; # bump added } my $tsc2 = scalar @tbl_set; $ocnt = 0; for ($i = 0; $i < $tsc2; $i++ ) { if ($tbl_set[$i][7] == 0) { $ocnt++; } } prt("Checked $tsc files from old index, and found $ocnt NOT MARKED ...\n"); # # 0 1 2 3 4 5 6 7 # # push(@tbl_set, [$hrf, $fil, $dt, $sz, $yr, $mt, $dy, 0]); for ($i = 0; $i < $tsc; $i++ ) { if ($tbl_set[$i][7] == 0) { $line = $tbl_set[$i][0]; if (in_existing($line)) { $date = $tbl_set[$i][2]; $sz = $tbl_set[$i][3]; $msg = ''; if ($cnt == 0) { $msg = "<tr>\n"; } # ###mark_old_index($line); $tbl_set[$i][7] = 2; $msg .= "<td><a href=\"$line\">$line</a><br>$date<br>$sz</td>\n"; $cnt++; if ($cnt == $wrap) { $msg .= "</tr>\n"; $cnt = 0; } print $OF $msg; prt( "NOTE ADDED [$line][$date][$sz] from OLD index ...\n" ); $dcnt++; } else { prt( "WARNING: File [$line] is NO LONGER IN FOLDER! Now dumped!!\n" ); } } } if ($cnt) { $msg = ''; while ($cnt < $wrap) { $msg .= "<td> </td>\n"; $cnt++; } $msg .= "</tr>\n"; print $OF $msg; } print $OF "</table>\n"; prt( "Done primary table ".($acnt + $dcnt)." ... now to do date sorted table ...\n" ); add_new_table($OF); # add new table sorted by time add_jump_table($OF); # put a jump table of build-in function out_link_line($OF, 0); # avoid none # add 4.01 validation ... print $OF <<"EOF"; <p> <a href="http://validator.w3.org/check?uri=referer"> <img src="valid-html401.gif" alt="Valid HTML 4.01 Transitional" width="88" height="31"> </a> </p> EOF print $OF "</body>\n"; $msg = "<!-- P26.".YYYYMMDD(time())." generated by $0 for geoffmclane.com/php/samples -->\n"; print $OF $msg; print $OF "</html>\n"; close($OF); prt( "Done file [$of] with $icnt files, plus $dcnt of $tsc from previous ...\n" ); } ######################################################################## # Main program. ######################################################################## my $tlo = ''; if ($debug_on) { $tlo = $out_folder.'\imgs10.htm'; my $testfile = 'imgs10.php'; my $tli = $in_folder.'\imgs10.php'; my $sbt = stat($tli); push(@php_list, [$testfile, $sbt->mtime, $sbt->size]); } else { $tlo = $out_folder.'\index.htm'; get_dir_files( $in_folder ); } do_stx_load(); # load the built-in, reserved words, etc arrays and hashes get_old_index( $in_index ); # load the OLD index.htm get_existing_files( $out_folder ); # get file names already in out folder process_files( $in_folder ); # MAIN FILE PROCESSING # $skipped - older or same # $newercnt - source is NEWER - re-write file # $newcnt - does NOT previously exist generate_index(); # output @ind_files - array of files to index.htm prt( "Written ".($newcnt + $newercnt).", $newcnt NEW, $newercnt newer, skipped $skipped older.\n" ); system( $tlo ); close_log($outfile,1); exit(0); # eof - php2html02.pl