Generated: Tue Feb 2 17:54:58 2010 from txt2htm.pl 2006/09/16 6.6 KB.
#!perl -w # coded using EditPlus v2.12 (76) # March, 2005 geoff mclane use strict; use Cwd; my $M_VERSION = "0.1"; my $start_time = time(); my $program = 'txt2htm'; my $verbose = 0; my $verb2 = 0; my $package = 'tempt2h.htm'; my @input_files = (); my $file_lines = 0; my @files = (); my @file_list = (); my $WHITE_PATTERN = "^[ \t]*\$"; my $tab_stg = ' '; my $in_file; my $check_out = 0; print "$program: Started on " . localtime($start_time) . "...\n"; my $dir = getcwd(); print "Running in $dir ...\n"; ### just for fun get_dir_list($dir); parse_arguments(@ARGV); die "$program: no input files found or specified\n" if ! @input_files; # pre-process foreach $in_file (@input_files) { if (-f $in_file) { print "File: $in_file ok\n"; } else { die "ERROR: Can not locate file [$in_file] ... check command ...\n"; } } init_out_file($package); # abort, if no create ... # show count in the array ... print "Adding $#input_files lines to file $package.\n" if $verbose; foreach $in_file (@input_files) { do_this_file($package, $in_file); } end_out_file($package); print "Done $package on " . localtime(time()) . ".\n"; sub get_dir_list { my $name = shift; # put all files in the current directory in @files: # opendir(THEDIR, ".") || die("Couldn't open current directory\n"); opendir(THEDIR, $name) || die("Couldn't open current directory\n"); @files = readdir(THEDIR); closedir(THEDIR); my $f_cnt = 0; my $d_cnt = 0; print "Found " . $#files . " files and folders ...\n"; foreach my $dfile (@files) { if ( -d $dfile ) { # if ($dfile eq '.' || $dfile eq '..') or if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') { # do nothing with DOT and DOUBLE DOT } else { $d_cnt++; print "$dfile <DIR>\n" if $verb2; } } else { $f_cnt++; my $ff = $name . '\\' . $dfile; # $ff =~ s/\//\\/g; # set DOS path separators ... $ff =~ s/\\/\//g; # set *nix path separators ... my $sb = dirname($ff); $ff =~ s/\//\\/g; # set DOS path separators ... $sb =~ s/\//\\/g; # set DOS path separators ... print "$dfile dos [$ff] [$sb] " if $verb2; if ($f_cnt == 1) { $sb =~ s/\\/\//g; # set *nix path separators ... print "[$sb]" if $verb2; } print "\n" if $verb2; } } print "Found " . $#files . " - folders = $d_cnt, files = $f_cnt ...\n"; } sub parse_arguments { my @av = @_; # take it off the passed stack while (@av) { my $a = shift @av; # get and move to next if ($a eq '--version') { print "$M_VERSION\n"; } elsif ($a eq '--help' || $a eq '--h' || $a eq '-h' || $a eq '-?') { die "No help available! ;=))\nexcept reading the code here!\nTry --version, -v, -p name, etc ..."; } elsif ($a eq '--verbose' || $a eq '-v') { print "Setting verbose.\n"; $verbose = 1; } elsif ($a eq '-v2') { print "Setting verbose 2.\n"; $verbose = 1; $verb2 = 1; } elsif ($a eq '--package' || $a eq '-p') { die "$program: no argument given for option \`$a'\n" if ! @av; # require_argument(@av); my $tmp = shift @av; # take next argument if ($tmp ne $package) { $check_out = 1; $package = $tmp; } } elsif ($a =~ /^-/) { die "$program: unrecognised option -- `$a'\nTry $program --help for more information.\n"; } else { print "Storing argument [$a].\n"; push(@input_files, $a); } } # while arguments } sub init_out_file { my $out_name = shift; print "Creating $out_name\n"; open(DSP, ">$out_name") || die "Can not create $out_name: $!\n"; print "Writing to $out_name ...\n" if $verbose; $file_lines++; print DSP <<"EOF"; <html> <head> <title>$out_name</title> </head> <body> <h1 align="center">$out_name</h1> EOF print "Closing $out_name.\n" if $verbose; close(DSP); } sub end_out_file { my $out_name = shift; print "Appending to $out_name\n" if $verbose; open(DSP, ">>$out_name") || die "Can not append to $out_name: $!\n"; print "Writing to $out_name ...\n" if $verbose; $file_lines++; print DSP <<"EOF"; </html> EOF print "Closing $out_name.\n"; close(DSP); } sub do_this_file { my ($out_name,$mfile) = @_; print "Opening, for append $out_name\n" if $verbose; open(DSP, ">>$out_name") || die "Can't append to $out_name: $!\n"; print "Writing to $out_name ...\n" if $verbose; $file_lines++; dsp_add_src(\*DSP, $mfile); close(DSP); print "Closed $out_name.\n" if $verbose; } sub dsp_add_src { my ($fh,$file) = @_; my $line_num = 0; my $dn_para = 0; if (-f $file) { print "Reading $file ...\n"; open(INF, $file) || die "Unable to open $file!\n"; while (<INF>) { $line_num++; #$_ .= "\n" unless substr ($_, -1, 1) eq "\n"; chomp; # clear end of line my $ln = length; # if ( ! $ln || /$WHITE_PATTERN/o) { if ( /$WHITE_PATTERN/o ) { print "white [$_]$ln\n" if $verb2; print $fh "\</p\>\n" if $dn_para; $dn_para = 0; } else { print $fh "\<p\>\n" if ! $dn_para; $dn_para = 1; #chomp; # clear end of line #s/\t/ /g; s/&/&/g; # convert '&' to '&' s/\t/$tab_stg /g; # substitute TAB characters s/"/"/g; # sub double quotes s/\</</g; # sub less than tag beginning s/\>/>/g; # and html/xml tag ending $ln = length; # get the final length if (substr ($_, 0, 1) eq ' ') { # if starts with a space my $sps = 0; my $nbs = ' '; for ($sps = 1; $sps < $ln; $sps++) { if (substr ($_, $sps, 1) ne ' ') { last; } $nbs .= ' ' if $sps > 1; } $sps-- if $sps > 1; # back off last space, if more than 1 print "Replacing $sps with [$nbs] ...\n" if $verb2; s/ {$sps}/$nbs/; # replace (N) spaces with ' x N if ($verb2) { my (@vals) = split; while (@vals) { my ($vc) = shift (@vals); print "[$vc] "; } print "\n"; } } # if it was space beginning print $fh "$_\<BR\>\n"; # out the line print "sig [$_]$ln\n" if $verb2; } } print $fh "\</p\>\n" if $dn_para; close(INF); print "Done $file ... $line_num lines ...\n"; } else { print $fh "WARNING: Missed SOURCE [$file]\n"; print "WARNING: Missed SOURCE [$file]\n"; } } sub dirname { # passed a path, './dir1/dir2/file.name' returns './dir1/dir2/ my ($file) = @_; my ($sub); ($sub = $file) =~ s,/+[^/]+$,,g; $sub = '.' if $sub eq $file; return $sub; } #if (substr ($_, 0, 1) eq ' ') { # my (@vals) = split; # while (@vals) { # my ($vc) = shift (@vals); # print "[$vc] "; # } # print "\n"; #} 1;