# ## MAIN print "\fXTAB - Perl CrossTabulation Program\n\n"; $_start=`date`; $_hv='~'; $f_h=""; $f_c=""; $_i=0; $pg_wid=132; open(S,get_pname()); while () { printf("%6.0f. %s",$_i++,$_); } close(S); print "\n\n"; $i_g_t=0; pp_files(); pp_ws(); pp_tables(); pp_freqs(); pp_reports(); $i_g_t=1; pp_open_outs(); pp_init(); $_read=0; $_selc=0; pp_loop(); pp_term(); pp_close_outs(); $i_g_t=2; pp_tables(); pp_reports(); $_stop=`date`; print "\n"; printf("\f# READ: %12.0f\n# SELECTED: %12.0f\n\n",$_read,$_selc); pp_count_outs(); print "Time ended: $_stop"; print "Time began: $_start"; print "\n\n"; sub pp_loop { open(OLD,$_old) || die ("Cant open file: <$_old>\n\n"); while() { $_read++; $_sel=0; $data=$_; chomp($data); pp_vars(); pp_comp(); pp_ins(); if ($_sel==0) { $_selc++; pp_tables(); pp_reports(); } if ($_limit > 0) { if ($_limit <= $_read) { $_eof=0; last; } } } close(OLD); } ## MAIN END sub pp_pout { print (@_); if (shift(@_) ne "\f") {print "\n"} } sub f_trim { (local $s)=(@_); $s =~s/^\s+//; $s =~ s/\s+$//; return $s } # sub pp_files {$_old='pp.old'} sub pp_ws {} # sub pp_vars {} sub pp_comp {} # sub pp_init {} # sub pp_ins {} # sub pp_term {} # sub pp_tables {} sub pp_reports {} sub pp_ptabs { my ($i,$j,$k,$s,$ss,$ll,$pad,$cl,$qq,$br); $qq='"'; # $pt_heads = page headings # $pt_s1v = stub variable # $pt_s1vc = stub variable count # $pt_s1vl = stub variable label # @pt_s1ls = stub labels # $pt_spv = spread variable # $pt_spvc = spread variable count # $pt_spvl = spread variable label # @pt_spls = spread labels # @pt_tab = table[][] values @s=split('&',$pt_heads); pp_pout("\f"); foreach $s(@s) { $ss=(" " x (($pg_wid-length($s))/2)).$s; pp_pout($ss); } $ll=0; foreach $s(@pt_s1ls) { if ($ll\n"; print HTM "
\n"; foreach $s(@s) { print HTM "$s
\n"; } print HTM "
\n"; print HTM "
\n"; print HTM "\n"; $_bc=1-$_bc; print HTM "\n"; $_bc=1-$_bc; print HTM " \n"; print HTM " \n"; for ($i=0; $i<=$pt_spvc; $i++) { print HTM " \n"; } print HTM " \n"; $_bc=1-$_bc; for ($i=0; $i<=$pt_s1vc; $i++) { if ($i <= 1) { print HTM "\n"; $_bc=1-$_bc; } print HTM " \n"; for ($j=0; $j<=$pt_spvc; $j++) { print HTM " \n"; } print HTM " \n"; $_bc=1-$_bc; } print HTM "
$pt_s1vl
$pt_spvl
$pt_spls[$i]

$pt_s1ls[$i] $pt_tab[$i][$j]
\n"; } if ($f_c ne "") { foreach $s(@s) { print CSV "$qq$s$qq\n"; } print CSV "\n"; print CSV "$qq$pt_spvl$qq\n"; print CSV "$qq$pt_s1vl$qq\n"; for ($i=0; $i<=$pt_spvc; $i++) { print CSV ","."$qq$pt_spls[$i]$qq"; } print CSV "\n\n"; for ($i=0; $i<=$pt_s1vc; $i++) { if ($i <= 1) { print CSV "\n"; } print CSV "$qq$pt_s1ls[$i]$qq"; for ($j=0; $j<=$pt_spvc; $j++) { print CSV ",$pt_tab[$i][$j]"; } print CSV "\n"; } } }

\n"; foreach $s(@s) { print HTM "$s\n"; } print HTM "

\n"; foreach $s(@s) { print HTM "$s
\n"; } print HTM "