Generated: Tue Feb 2 17:54:40 2010 from gentable.pl 2007/01/27 13.4 KB.
#!/Perl # AIM: Generate a BIG link table ... it can contain all 'links', other files, and/or images # 20070127 - fix for get_nn only use File::stat; # to get the file date 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 $add_links = 1; my $add_other = 1; my $add_imgs = 0; # do the actual OUTPUT my $write_out = 1; my $dbg1 = 0; my $dbg2 = 0; my $dbg3 = 0; my $dbg4 = 0; # show processing my $dbg5 = 0; my $dbg6 = 0; # show finding title my $dbg7 = 0; # show NO TITLE my $in_folder = "C:/HOMEPAGE/Max5"; my @excl_dirs = qw(_vti_cnf _derived _private _vti_pvt stats samples); ##my @excl_dirs = qw(_vti_cnf _derived _private _vti_pvt stats); my @excl_fils = qw(041105IMPACT-SITE.dmg); my @link_files = (); my @img_files = (); my @zip_files = (); my @other_files = (); my $v401 = 'images/valid-html401.gif'; my $out_file = ''; if ($add_links > 0) { $mtit = 'Links'; $out_file = $in_folder . '/linkall.htm'; } else { $mtit = 'Images'; $out_file = $in_folder . '/imgsall.htm'; } process_dir($in_folder, 0); process_out($out_file) if ($write_out > 0); close_log($outfile,1); exit(0); sub process_out() { my ($outf) = shift; my $cnt = scalar @link_files; my $ocnt = scalar @other_files; my $icnt = scalar @img_files; my $i = 0; prt( "Got $cnt htm/php link, $icnt image files, and $ocnt other files ...\n" ); open OF, ">$outf" or mydie("ZEEK: Unable to create [$outf] ...\n"); print OF <<"EOF"; <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html> <head> <meta http-equiv="Content-Language" content="en-au"> <meta http-equiv="Content-Type" content="text/html; charset=windows-1252"> <meta name="description" content="macpcfirstaid computerhelp mac and pc cross platform hardware sale bargains anywhere anytime small business help and support telephone help a speciality"> <meta name="keywords" content="macpcfirstaid, computer, help, computerhelp, machelp, help4computers, mac, pc, crash, system, support, helpdesk, networking, failure, imac, apple, windows, xp, nt, osx, classic, urgent, emergency, firstaid, first, aid"> <meta name="robots" content="index, follow"> <!-- robot should analyse linked pages --> <meta name="revisit-after" content="10 days"> <!-- robot should come again after x days --> <title>List of $mtit</title> <style type="text/css"> <!-- /* Style Definitions */ body { margin:0cm 1cm 1cm 1cm; background-image:url("images/clds3.jpg"); } --> </style> </head> <body> <h1 align="center">List of $mtit</h1> <p align="center"><a href="index.htm">index</a></p> EOF if (($cnt > 0) && ($add_links > 0)) { prt( "Outing $cnt htm/php links to table ...\n" ); print OF <<"EOF"; <p>Table of $cnt htm/php links ... This is the full current set of links on this site as of the date of this files creation ... Some items may have been subsequently deleted.</p> <p align="center"> <table border="1" summary="Table of all HTML/PHP on this site"> <tr> <th>Link</th> <th>Title</th> <th>Relative Path</th> <th>Size</th> <th>Date</th> </tr> EOF for ($i = 0; $i < $cnt; $i++ ) { my $file = $link_files[$i][0]; my $sz = b2KMG( $link_files[$i][1]); my $tm = YYYYMMDD( $link_files[$i][2]); my $tl = $link_files[$i][3]; my $pth = my_path($file); ##my $fn = my_file_name(my_file($file)); my $fn = my_file($file); prt( "$i - href = [$file], name = [$fn], path = [$pth] ..\n" ) if $dbg5; print OF "<tr>\n"; print OF ' <td align="left"><a href="'.$file.'">'.$fn.'</a></td>'."\n"; print OF ' <td align="left">'.$tl.'</td>'."\n"; print OF ' <td align="left">'.$pth.'</td>'."\n"; print OF ' <td align="right" nowrap>'.$sz.'</td>'."\n"; print OF ' <td align="left">'.$tm.'</td>'."\n"; print OF "</tr>\n"; } print OF <<"EOF"; <tr> <td align="left"><a href="samples/index.htm">index.htm</a></td> <td align="left">Index to Perl HTML Samples</td> <td align="left">samples</td> <td align="right">17.9 KB</td> <td align="left">2006/08/01</td> </tr> EOF print OF "</table>\n"; ###print OF "</p>\n"; } if (($ocnt > 0) && ($add_other > 0)) { prt( "Outing $ocnt other files to table ...\n" ); print OF <<"EOF"; <p>Table of $ocnt other links ... Many of these files are files used in other pages, or are 'configuration' type files ... You may not have an associated application to show these files in any meaningful way ...</p> <p align="center"> <table border="1" summary="Table of all other files on this site"> <tr> <th>Link</th> <th>Relative Path</th> <th>Size</th> <th>Date</th> </tr> EOF for ($i = 0; $i < $ocnt; $i++ ) { my $file = $other_files[$i][0]; my $sz = b2KMG( $other_files[$i][1] ); my $tm = YYYYMMDD( $other_files[$i][2] ); my $pth = my_path($file); my $fn = my_file($file); prt( "$i - href = [$file], name = [$fn], path = [$pth] ..\n" ) if $dbg5; if (length($file) && length($fn)) { print OF "<tr>\n"; print OF ' <td align="left"><a href="'.$file.'">'.$fn.'</a></td>'."\n"; print OF ' <td align="left">'.$pth.'</td>'."\n"; print OF ' <td align="right" nowrap>'.$sz.'</td>'."\n"; print OF ' <td align="left">'.$tm.'</td>'."\n"; print OF "</tr>\n"; } else { prt( "CHECK $i: href = [$file], name = [$fn], path = [$pth] ...\n" ); } } print OF "</table>\n"; ####print OF "</p>\n"; } if (($icnt > 0) && ($add_imgs > 0)) { prt( "Outing $icnt image files to table ...\n" ); print OF <<"EOF"; <p>Table of $icnt image links ... Due to the NUMBER and SIZE of these images, this page may take a considerable time to load! And some browsers can 'give-up' before all images are loaded ;=(( Note, each image is clipped to 128x128, thus may appear distorted, but clicking on the image should load the full correct image into your browser ... the table also shows the image name, the relative path to the image, its approximate size, and file date.</p> <p align="center"> <table border="1" summary="Table of all images files on this site"> <tr> <th>Image Link</th> <th>Relative Path</th> <th>Size</th> <th>Date</th> </tr> EOF for ($i = 0; $i < $icnt; $i++ ) { my $file = $img_files[$i][0]; my $sz = b2KMG( $img_files[$i][1] ); my $tm = YYYYMMDD( $img_files[$i][2] ); my $pth = my_path($file); my $fn = my_file($file); prt( "$i - href = [$file], name = [$fn], path = [$pth] ..\n" ) if $dbg5; if (length($file) && length($fn)) { print OF "<tr>\n"; print OF ' <td align="left"><a href="'.$file.'">'; print OF '<img src="'.$file.'" width="128" height="128" alt=""><br>'.$fn.'</a></td>'."\n"; print OF ' <td align="left">'.$pth.'</td>'."\n"; print OF ' <td align="right">'.$sz.'</td>'."\n"; print OF ' <td align="left">'.$tm.'</td>'."\n"; print OF "</tr>\n"; } else { prt( "CHECK $i: href = [$file], name = [$fn], path = [$pth] ...\n" ); } } print OF "</table>\n"; ####print OF "</p>\n"; } print OF '<p align="center"><a href="index.htm">index</a></p>'."\n"; # add 4.01 validation ... print OF <<"EOF"; <p> <a href="http://validator.w3.org/check?uri=referer"> <img src="$v401" alt="Valid HTML 4.01 Transitional" width="88" height="31"> </a> </p> EOF print OF "</body>\n"; print OF "</html>\n"; close(OF); system($out_file); } sub process_dir($$) { my ($name, $lev) = @_; prt("processing [$name], level=$lev ...\n") if $dbg3; opendir(THEDIR, $name) || mydie("Couldn't open directory [$name] ...\n"); my @dfiles = readdir(THEDIR); # slurp in ALL directories, and files, (and . & ..!) closedir(THEDIR); my $dircnt = scalar @dfiles; prt( "Level $lev: Processing $dircnt entries in [$name] directory ...\n" ) if $dbg4; my @dirs = (); my $file; foreach $file (@dfiles) { if (($file eq '.') || ($file eq '..') || (length($file) == 0)) { # skip these entries ###prt( "Skipped [$file] ...\n" ); } else { my $ff = $name . '/' . $file; ###$ff =~ s/\//\\/g; $sb = stat($ff) or mydie("YEEK: Unable to 'stat' [$ff] ...\n"); if ( -d $ff ) { # got a FOLDER if ( !in_excluded_dirs($file) ) { push(@dirs, $ff); } } elsif ( -f $ff) { # got a FILE ... if ( !in_excluded_fils($file) ) { my $sf = remove_in_folder($ff); my $ft = is_link_file($file); if ($ft > 0) { prt( "File: [$ff] [$sf] ...\n" ) if $dbg2; if ($ft == 1) { my $tit = get_title($ff); if (length($tit) == 0) { $tit = 'no title found'; } push(@link_files, [$sf, $sb->size, $sb->mtime, $tit ]); } elsif ($ft == 2) { push(@img_files, [$sf, $sb->size, $sb->mtime ]); } else { # zip file - exclude push(@zip_files, [$sf, $sb->size, $sb->mtime ]); } } else { if ((length($sf) > 0) && (length($file) > 0) && !($sf eq '..')) { push(@other_files, [$sf, $sb->size, $sb->mtime ]); } else { prt( "CHECK: Failed on [$file] to get length ...\n" ); } } } } else { prt( "CHECK: What is this? [$file] [$ff] ...\n" ); ##prt( "Item [$ff] size = ".$sb->size." mode=". ($sb->mode & 07777) . ## " time=" .(scalar localtime $sb->mtime). " ...\n" ); } } } foreach $file (@dirs) { process_dir( $file, ($lev + 1) ); } } sub get_title($) { my $rt = ''; my ($if) = shift; open INF, "<$if" or mydie("ERROR: Unable to open [$if] ...\n"); my @larr = <INF>; # slurp in the whole file close(INF); my $lc = scalar @larr; my $fnd = 0; prt( "Processing $lc line from [$if] ...\n" ) if $dbg6; ###foreach my $ln (@larr) { for (my $i = 0; $i < $lc; $i++) { $ln = $larr[$i]; chomp $ln; $ln =~ s/\r$//; # and remove CR, if present if ($ln =~ /<title.*>/i) { while ( !($ln =~ /<\/title>/i) ) { $i++; if ($i < $lc) { $ln .= ' '.$larr[$i]; $ln =~ s/\r$//; # and remove CR, if present } else { last; } } } if ($ln =~ /<title.*>(.*)<\/title>/i) { $rt = $1; $fnd = 1; last; } } if ($fnd > 0) { prt( "TITLE=[$rt] ...\n" ) if $dbg6; } else { prt( "NO FIND of TITLE in [$if], $lc lines ...\n" ) if $dbg7; } return $rt; } sub in_excluded_dirs($) { my ($d) = shift; $d = lc($d); foreach my $xd (@excl_dirs) { if ($xd eq $d) { return 1; } } return 0; } sub in_excluded_fils($) { my ($d) = shift; $d = lc($d); foreach my $xd (@excl_fils) { if ($xd eq $d) { return 1; } } return 0; } sub remove_in_folder($) { my ($f) = shift; return( substr($f, length($in_folder) + 1) ); } sub is_link_file($) { my ($f) = shift; my $ext = my_file_ext($f); if ($ext =~ /^htm/i) { prt( "got htm file [$f] ...\n" ) if $dbg1; return 1; } if ($ext =~ /^php/i) { prt( "got php file [$f] ...\n" ) if $dbg1; return 1; } if (($ext =~ /^jpg/i)||($ext =~ /^jpeg/)||($ext =~ /^gif/)) { return 2; } if ($ext =~ /^zip/i) { return 3; } prt( "not my file [$f] ...\n" ) if $dbg1; return 0; } sub my_file_ext($) { my ($f) = shift; my @a = split(/\./, $f); my $cnt = scalar @a; if ($cnt > 1) { return $a[-1]; } elsif (substr($f,0,1) eq '.') { return $f; } return ''; } sub my_file_name($) { my ($f) = shift; my @a = split(/\./, $f); my $cnt = scalar @a; if ($cnt > 1) { pop @a; return join( '.', @a); } return $f; } sub my_file($) { my ($f) = shift; $f =~ s/\\/\//g; my @a = split(/\//, $f); my $cnt = scalar @a; if ($cnt > 1) { $f = pop @a; } return $f; } sub my_path($) { my ($f1) = shift; if (length($fl)) { return ''; } $f1 =~ s/\\/\//g; my @a = split(/\//, $f1); my $cnt = scalar @a; if ($cnt > 1) { pop @a; $f1 = join('/', @a); } else { $f1 = '.'; } return $f1; } 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 ); } sub get_nn { # perl nice number nicenum add commas my ($n) = @_; 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)), 3 ); } else { $ret .= ',' . substr( $n, ($mod+(3*$i)), 3 ); } } return $ret; } return $n; } ################################################ # My particular time 'translation' sub YYYYMMDD { # 0 1 2 3 4 5 6 7 8 my ($tm) = shift; my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm); $year += 1900; my $ymd = "$year/"; if ($mon < 10) { $ymd .= '0'.$mon.'/'; } else { $ymd .= "$mon/"; } if ($mday < 10) { $ymd .= '0'.$mday; } else { $ymd .= "$mday"; } return $ymd; } # eof - gentable.pl