perl2

Perl Index *|* Back to Perl 1 *|* Back to cv *|* To Home *|* Perl Next

#!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/\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;

Perl Index *|* Back to Perl 1 *|* Back to cv *|* To Home *|* Perl Next

What is ISAPI?

ISAPI (Internet Server Application Programming Interface) is an API for writing extensions to web servers. It was originally developed by Process Software, and adopted by Microsoft as its standard server API. It complements or replaces the Common Gateway Interface (CGI), the standard interprocess protocol for writing extensions to web servers.

ISAPI's main advantage over CGI is that it uses dynamic-link library (DLL) function calls to communicate with extension components, rather than environment variables and standard I/O, as CGI does. There's a lot of overhead when starting new processes on Win32 platforms, and DLL calls eliminate the need for new processes, thus reducing the running time.

Although it was originally developed for Microsoft Internet Information Server, many Windows NT-hosted web servers now support ISAPI. See What HTTP servers support ActivePerl? for the names of a few. If your server isn't there, check its documentation.

 

Perl Index *|* Back to Perl 1 *|* Back to cv *|* To Home *|* Perl Next