Skip to content

Commit 6ecc3db

Browse files
dacasedacase
committed
initial copy from ../rdb and ../stats
0 parents  commit 6ecc3db

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

63 files changed

+8882
-0
lines changed

‎README

+42
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,42 @@
1+
Documentation
2+
3+
The documentation is the (postscript) file 'RDB.ps'. This is about
4+
60 pages when printed on a postscript printer. The file 'rdb'
5+
contains a quick overview of this RDB system, also, each of the RDB
6+
operators takes a '-help' option for online information. There is
7+
information on the RDB system in the magazine article referenced
8+
below and in the book referenced in the documentation file.
9+
10+
Disclamer
11+
12+
This program (the set of RDB operators) is still in the process of
13+
development. It is not guaranteed to be error free; however it
14+
works very well for our current efforts and I know of no outstanding
15+
errors. Use as desired; if errors or unusual conditions are found
16+
please let me know. Feedback is encouraged. I will make modifications
17+
and distribute updated versions.
18+
19+
Send feedback to: [email protected]
20+
21+
The development of this program was NOT done under any Government
22+
contract or Government sponsored effort.
23+
24+
Note that this program was implemented ENTIRELY from the
25+
information contained in the article in "Unix Review", March,
26+
1991, page 24, entitled "A 4GL Language" and our own expansion on
27+
those ideas. No other outside source of information on RDB was
28+
known or used at the time.
29+
30+
>>>>>> NO WARRANTY <<<<<<
31+
32+
THERE IS NO WARRANTY FOR THIS PROGRAM. THE PROGRAM IS PROVIDED
33+
"AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR
34+
IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
35+
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
36+
37+
This program is not copyrighted, is freely available, and is free.
38+
However if you like and use it, or give it to another, you might
39+
remember where it originated ...
40+
41+
Walt Hobbs [email protected]
42+
Santa Monica, CA

‎bin/column

+126
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
#!/usr/bin/perl
2+
$RCS_ID = '$Id: column,v 2.4 1993/03/29 13:34:46 hobbs Exp $' ;
3+
$0 =~ s-.*/-- ;
4+
$HelpInfo = <<EOH ;
5+
6+
RDB operator: $0
7+
8+
Usage: $0 [options] list
9+
10+
Options:
11+
-edit Edit option. Used by etbl.
12+
-help Print this help info.
13+
-v Inverse option. Selects all columns except those named.
14+
15+
Selects columns by name (and order) and outputs an rdbtable with these columns.
16+
Can effectively select, order, add, delete, or duplicate columns.
17+
18+
The value 'list' is normally a list of column names. If 'list' contains a
19+
triplicate of the form '-c NAME NEW' then column name 'NAME' will be changed
20+
to 'NEW'. If 'list' contains a triplicate of the form '-a NAME DEFN' then
21+
a new (null) column is added, at that point in the list of column names,
22+
with name 'NAME' and definition 'DEFN'.
23+
24+
The definition is described under the 'ptbl' operator.
25+
26+
This RDB operator reads an rdbtable from STDIN and writes an rdbtable to STDOUT.
27+
Options may be abbreviated.
28+
29+
$RCS_ID
30+
EOH
31+
while ( ($_ = $ARGV[0]) =~ /^-/ ) { # Get args
32+
if( /^-a.*/ || /^-c.*/ ){ last ; }
33+
if( /^-e.*/ ){ $EDT++ ; shift ; next ; }
34+
if( /^-h.*/ ){ print $HelpInfo ; exit 1 ; }
35+
if( /^-v.*/ ){ $INV++ ; shift ; next ; }
36+
if( /^-(\d.*)/ ){ $CBC = $1 ; shift ; next ; }
37+
die "\nBad arg: $_\n", "For help type \"$0 -help\".\n" ;
38+
}
39+
while(<STDIN>){ # get header info, 2 lines
40+
if( /^\.\.>>>/ ){ print ; next ; }
41+
if( /^\s*#/ ){ print ; next ; } # comment
42+
$lln++ ;
43+
chop ;
44+
if( $lln == 1 ){
45+
@H = split( /\t/, $_ ) ; # column names
46+
$nrf = @H ; } # nr of fields for data reads
47+
elsif( $lln == 2 ){
48+
@F = split( /\t/, $_ ) ; # data definitions
49+
last ; } }
50+
if( $CBC ){ # columns by count option
51+
# chk @ARGV empty ... die error ...
52+
@cbc = split( /([a-z])/, $CBC ) ;
53+
unshift( @cbc, 'n' ) ;
54+
@tmp = @H ;
55+
while(@cbc){
56+
$opr = shift( @cbc ) ;
57+
$cnt = shift( @cbc ) ;
58+
while( @tmp && $cnt-- ){
59+
if( $opr eq 'n' ){
60+
push( @ARGV, shift(@tmp) ) ; }
61+
else{
62+
shift(@tmp) ; }
63+
}
64+
}
65+
}
66+
while( $arg = shift ){ # process column names
67+
if( $arg =~ /^-a/ ){ # add new column
68+
if( $INV ){
69+
push( @add, shift ) ;
70+
push( @add, shift ) ; }
71+
else{
72+
push( @H, shift ) ;
73+
push( @F, shift ) ;
74+
push( @nh, $#H ) ;
75+
push( @nd, '-' ) ; }
76+
next ; }
77+
if( $arg =~ /^-c/ ){ # change column name
78+
$arg = shift ;
79+
$new = shift ; } # ( No 'next' here ... )
80+
for( $ok=$f=0 ; $f <= $#H ; $f++ ){
81+
if( $arg eq $H[$f] ){ # select existing column
82+
$ok++ ;
83+
if( ! $INV ){
84+
push( @nh, $f );
85+
push( @nd, $f );
86+
if( $new ){
87+
splice( @H, $f, 1, $new ) ;
88+
$new = "" ; } }
89+
else{
90+
push( @xh, $f );
91+
push( @x, $f ); }
92+
last ; }
93+
}
94+
die "$0: Bad column name: $arg\n" if ! $ok ;
95+
}
96+
if( $INV ){ # inverse option
97+
loop: for( $f=0 ; $f <= $#H ; $f++ ){
98+
for $i (@x){
99+
if( $i eq $f ){ next loop ; } }
100+
push( @nh, $f );
101+
push( @nd, $f ); }
102+
while (@add){
103+
push( @H, shift(@add) ) ;
104+
push( @F, shift(@add) ) ;
105+
push( @nh, $#H ) ;
106+
push( @nd, '-' ) ; }
107+
}
108+
@n = @nh ; # print the new header
109+
@D = @H ; &printem ;
110+
@D = @F ; &printem ;
111+
@n = @nd ;
112+
113+
while(<STDIN>){ # read the data
114+
if( /^\.\.>>>/ ){ print ; next ; }
115+
chop ;
116+
@D = split( /\t/, $_, $nrf );
117+
&printem ;
118+
}
119+
sub printem { # print a row from @D
120+
$c = 0 ;
121+
for $x (@n) {
122+
print "\t" if $c++ > 0 ;
123+
next if $x eq '-' ;
124+
print $D[$x] ; }
125+
print "\n" if @n ;
126+
}

‎bin/compute

+94
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,94 @@
1+
#! /usr/bin/perl
2+
$RCS_ID = '$Id: compute,v 2.6 1994/11/09 10:43:59 hobbs Exp $' ;
3+
$0 =~ s-.*/-- ;
4+
$HelpInfo = <<EOH ;
5+
6+
RDB operator: $0
7+
8+
Usage: $0 [options] [statements]
9+
10+
Options:
11+
-help Print this help info.
12+
-fXXX The statements are in the file 'XXX', instead of on the
13+
command line. The advantage in this case is that no quoting
14+
of chars that might be special to the UNIX shell is necessary.
15+
16+
Computes values for data fields based on arbitrary statements using
17+
column names. Chars that are special to the UNIX shell must be quoted.
18+
19+
Comparsion operators may be of the form: gt, ge, lt, le, eq, ne. E.g
20+
'column eq Hobbs'. Logical constructors 'or' and 'and' may be used; as
21+
well as 'null' to indicate an empty data value.
22+
23+
This operator reads a rdbtable via STDIN and writes a rdbtable via STDOUT.
24+
Options may be abbreviated.
25+
26+
$RCS_ID
27+
EOH
28+
%cmpop = ( "lt", "<", "le", "<=", "gt", ">", "ge", ">=", # cmp opers
29+
"eq", "==", "ne", "!=" ) ;
30+
%resw = ( "or", "||", "and", "&&", "null", "\"\"" ) ;# reserved words
31+
while ( $ARGV[0] =~ /^-/ ) { # Get args
32+
$_ = shift ;
33+
if( /-f(\S+)/ ) { $FEXP = $1 ; next ; }
34+
if( /^-h.*/ ){ print $HelpInfo ; exit 1 ; }
35+
if( /-x.*/ ){ $XBUG++ ; next ; }
36+
die "\nBad arg: $_\n", "For help type \"$0 -help\".\n" ;
37+
}
38+
while(<STDIN>){
39+
print ;
40+
next if /^\s*#/ ; # comment
41+
chop ;
42+
@F = split( /\t/, $_ );
43+
if( ++$lln == 1 ){ # col name line
44+
@H = @F ; # save headers
45+
$nrf = @H ; # nr of fields
46+
next ; }
47+
if( $lln == 2 ){ # col define line
48+
if( $FEXP ){ # exp from file
49+
open( FEXP ) || die "\nCan't open input: $FEXP\n" ;
50+
while( <FEXP> ){
51+
s/(^|\s+)#.*$// ; # skip comments
52+
$x .= $_ ; }
53+
@ARGV = split( ' ', $x ) ; }
54+
for $arg ( @ARGV ){
55+
&convert ; }
56+
push( @ARGV, ";" ) if $ARGV[$#ARGV] ne ';' ;
57+
$exp = join( ' ', @ARGV ) ;
58+
$prog = <<EOP ;
59+
while(<STDIN>){
60+
chop ;
61+
\@F = split( /\\t/, \$_, $nrf );
62+
$exp
63+
print join( "\\t", \@F ), "\\n" ;
64+
}
65+
EOP
66+
last ;
67+
}
68+
}
69+
# print STDERR $prog, "\n" if $XBUG ;
70+
print STDERR $prog if $XBUG ; # chg for perl5
71+
eval( $prog ) ;
72+
print STDERR $@ if $@ ;
73+
74+
sub convert { # chk and convert $arg if necessary
75+
for( $f=0 ; $f <= $#H ; $f++ ){
76+
if( $arg eq $H[$f] ){ # col name trans
77+
$arg = '$F[' . $f . ']' ; # defn line
78+
if( $F[$f] =~ /(\S+)/ && $1 =~ /N/i ){
79+
$numf++ ; # num data flag
80+
}
81+
return ;
82+
}
83+
}
84+
if( $numf && $cmpop{$arg} ){ # numeric op trans
85+
$arg = $cmpop{$arg} ;
86+
}
87+
else{ # quote leading zeros
88+
$arg = '"' . $arg . '"' if $arg =~ /^0/ ;
89+
}
90+
$numf = "" ;
91+
if( $resw{$arg} ){ # reserved word chk
92+
$arg = $resw{$arg} ;
93+
}
94+
}

‎bin/cterm.pl

+68
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,68 @@
1+
#! /local/bin/perl
2+
3+
do 'cdefs.pl' || die "cterm.pl can't include cdefs.pl\n" ;
4+
do 'curcon.pl' || die "cterm.pl can't include curcon.pl\n" ;
5+
6+
sub curFlush
7+
{ $oldpipe = $| ;
8+
$| = 1 ;
9+
print "" ;
10+
$| = $oldpipe ;
11+
}
12+
13+
sub frefresh { &refresh ; &curFlush if $flushOn ; }
14+
15+
sub ch2str
16+
{ local($c) = shift ;
17+
if ( (31 < $c) && ($c < 128) )
18+
{ return(sprintf("%c", $c)) ; }
19+
elsif ( defined $curkey{$c} )
20+
{ return($curkey{$c}) ; }
21+
else
22+
{ return($c) ; }
23+
}
24+
25+
sub getchint { return &ch2str(&getch) ; }
26+
27+
sub safeCterm { $safeCterm = 1 ; }
28+
29+
sub startCterm
30+
{ pipe(CURIN,PERLOUT) || die "cterm.pl can\'t create pipe CURIN/PERLOUT" ;
31+
pipe(PERLIN,CUROUT) || die "cterm.pl can\'t create pipe PERLIN/CUROUT" ;
32+
33+
$ctermPid = fork ;
34+
35+
if ( $safeCterm ? ( $ctermPid != 0 ) : ( $ctermPid == 0 ) )
36+
{ close(PERLIN) || die "cterm.pl can\'t close PERLIN" ;
37+
close(PERLOUT) || die "cterm.pl can\'t close PERLOUT" ;
38+
exec('cterm.exe',fileno(CURIN),fileno(CUROUT),@_) ;
39+
die 'cterm.pl can\'t exec cterm' ;
40+
}
41+
else
42+
{ close(CURIN) || die "cterm.pl can\'t close CURIN" ;
43+
close(CUROUT) || die "cterm.pl can\'t close CUROUT" ;
44+
open(SAVESTDIN, "<&STDIN") || die 'cterm.pl can\'t save STDIN' ;
45+
open(SAVESTDOUT,">&STDOUT") || die 'cterm.pl can\'t save STDOUT' ;
46+
open(STDIN, "<&PERLIN") || die 'cterm.pl can\'t redirect STDIN' ;
47+
open(STDOUT,">&PERLOUT") || die 'cterm.pl can\'t redirect STDOUT' ;
48+
$preCtermPipe = $| ;
49+
$preCtermSelect = select(STDOUT) ;
50+
$| = 0 ;
51+
$flushOn = 0 ;
52+
}
53+
}
54+
55+
sub finishCterm
56+
{ &quitcterm ;
57+
close(PERLOUT) ;
58+
sleep 1 ;
59+
close(PERLIN) ;
60+
open(STDIN, "<&SAVESTDIN") || die 'cterm.pl can\'t reredirect STDIN' ;
61+
open(STDOUT,">&SAVESTDOUT") || die 'cterm.pl can\'t reredirect STDOUT' ;
62+
close(SAVESTDIN) ;
63+
close(SAVESTDOUT) ;
64+
select($preCtermSelect) ;
65+
$| = $preCtermPipe ;
66+
}
67+
68+
1;

0 commit comments

Comments
 (0)