# # KEHOME/parser/mkr_io.icn # Richard H. McCullough Oct/16/2005 Jul/20/2009 Oct/10/2014 Apr/9/2015 $include "yyinclude.h" link basename # basename() link io # suffix() link tables # keylist() global MoreFiles global QUIET,PROMPT global kelabel # for window labels # procedures #==========# # end_file(fd) # gdbm_close(fd) # gdbm_fname(tname) # gdbm_open(tname,mode) # keclose(oldfd) # keopen(fname,mode,format) # keprefix(kfile) # myclose() # myopen(arg0) # pop_file(fd,fname) # push_file(fd,fname,format) # read_knit(fd,kfile,format) # webdir(dir,option) # integer procedure read_knit(fd,kfile,format) #=================================== local line,nlines local prop,dval local fname,relname local fdebug static prog,b,colon,yyprefix static attn,info initial { prog := "read_knit: " b := " " colon := ":" attn := repl("#",5) info := "INFO: "||prog } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog nlines := 0 kfile := unparse(kfile) write(fdebug,attn,b,yyprefix,"kfile = (",kfile,") fd = (",image(fd),")",b,attn) if (ECHO==("on"|"ON")) & (kfile ~== "internal") then write(&output,attn,b,yyprefix,"kfile = (",kfile,") fd = (",image(fd),")",b,attn) fname := suffix(kfile) case \fname[2] of { default: { /format := "ku" /fd := keopen(kfile,,format) if type(fd) == "null" then return nlines } ("csv"|"CSV"): { format := "csv" /fd := keopen(kfile,,format) if type(fd) == "null" then return nlines relname := basename(fname[1]) nlines := read_csv(fd,kfile,format,relname) # csv.icn push_line("EOF") # for kfile } ("ged"|"GED"): { format := "ged" /fd := keopen(kfile,,format) if type(fd) == "null" then return nlines relname := basename(fname[1]) nlines := read_ged(fd,kfile,format) # ged_read.icn push_line("EOF") # for kfile return nlines } } if fName == "input" then PS := "ke$ " else PS := "" nestreset() parse_file() return nlines := yylineno end # string procedure keprefix(kfile) #======================== # change "file" to "$KEHOME/file" # change "/cygdrive/c" to "c:" local prefix local fdebug static prog,b,colon,yyprefix static cdrive,slash static home,kehome,uhome,chome initial { prog := "keprefix: " b := " " colon := ":" cdrive := "/cygdrive/c" slash := "/" chome := getenv("CHOME") | "" home := getenv("HOME") | "" kehome := getenv("KEHOME") | "" uhome := getenv("UHOME") | "" } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog ##### if kehome ? =cdrive & (prefix := tab(0)) ##### then kehome := "c:"||prefix if DEBUG == "I/O" then write(fdebug,yyprefix,"prefix = (",prefix,")") return kehome||slash||kfile end # string procedure gdbm_fname(xname) #========================== # file name for accessing table (GDBM file) local dbdir,fname static s initial s := "/" xname := unparse(xname) dbdir := getenv("DBDIR") fname := dbdir||s|| xname return fname end # fd procedure gdbm_open(xname,mode) #============================== # open GDBM file # fd used like table in Unicon local fd,tail,fname local fdebug static prog,b,colon,yyprefix static info,warning,error initial { prog := "gdbm_open: " info := "INFO: " warning := "WARNING: " error := "ERROR: " } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog /mode := "d" xname := unparse(xname) mode := unparse(mode) fname := gdbm_fname(xname) if fd := keopen(fname,mode) then { write(fdebug,yyprefix,"fd = (",image(fd),")") } else { Nerror +:= 1 write(&errout,yyprefix,"can't open fname = (",image(fname),")") write(fdebug, yyprefix,"can't open fname = (",image(fname),")") fail } return fd end procedure gdbm_close(fd) #======================= keclose(fd) end #----------------------------------------------# # FILE procedure keclose(oldfd) #======================= local newfd local fdebug static prog,b,colon,yyprefix initial { prog := "keclose: " b := " " colon := ":" } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog newfd := open("/dev/null") case oldfd of { &input: { newfd := pop_file(oldfd) } &output: { newfd := pop_file(oldfd) } &errout: { newfd := pop_file(oldfd) } "internal": { newfd := pop_file(oldfd) } default: { newfd := pop_file(oldfd); close(oldfd) } } # end case yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(fdebug,yyprefix,"oldfd = (",image(oldfd),") newfd = (",image(newfd),") new format = (",KFORMAT,")") writes(mylog,yyprefix,"yyfdstack = ( "); every writes(mylog,image(!yyfdstack),b); write(mylog,")") return newfd end # FILE procedure keopen(fname,mode,format) #=================================== # try current directory # then kepath (KEHOME) # then cgypath <<<=== different file system problem ??? # then bname (use \ instead of /) <<<=== NO! # write all msgs to log file local kehome local fprefix,minfo,merror,mwarning local fd,pname,kfile local fdebug static prog,b,colon,yyprefix static info,error,warning,defaultKEHOME initial { prog := "keopen: " b := " " colon := ":" info := "INFO: keopen: " error := "ERROR: keopen: " warning := "WARNING: keopen: " defaultKEHOME := "C:/home/ke" /yyfdstack := [] /yylineno := 0 /yywordno := 0 /yyformat := "ku" } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog /mode := "r" /format := "ku" kehome := getenv("KEHOME") fname := unparse(fname) if type(fname) == "null" then fail if *fname = 0 then fail ##if DEBUG == "OPEN" then { write(fdebug,yyprefix,"fname = (",image(fname), ") mode = (",image(mode), ") format = (",image(format), ") kehome = (",image(kehome),")") ##} case fname of { "input": { fd := push_file(&input, "input", format)} "output": { fd := push_file(&output, "output", format)} "errout": { fd := push_file(&errout, "errout", format)} "internal": { fd := push_file("internal","internal",format)} default: { if upto(":",fname) then { fprefix := suffix(fname,colon)[1] # Unicon library io.u fprefix := map(fprefix,&ucase,&lcase) case fprefix of { "http": { mode ||:= "m" } "smtp": { mode ||:= "m" } "pop": { mode ||:= "m" } "tcp": { mode ||:= "n" } "udp": { mode ||:= "n" } } # end case fprefix pname := "" kfile := [fname] } else { pname := keprefix(fname) kfile := [fname,pname] } minfo := info||"mode ("||mode||") " merror := error||"mode ("||mode||") " mwarning := warning||"mode ("||mode||") " if DEBUG=="OPEN" then { write(fdebug,yyprefix,"pname = (",image(pname),")") } every kfile := ![fname,pname] do { fd := &null if fd := open(kfile,mode) then { push_file(fd,kfile) break } else { write(fdebug,yyprefix||"can't open (",kfile,")") if kfile == pname then write(&errout,yyprefix,"can't open (",kfile,")") next } # end if open kfile } # end every kfile } # end default } # end case yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(fdebug,yyprefix,"fname = (",image(fname),") fd = (",image(fd),") format = (",KFORMAT,")") writes(fdebug,yyprefix,"yyfdstack = ( "); every writes(mylog,image(!yyfdstack),b); write(mylog,")") return fd end procedure end_file(fd) #===================== # called by parse_file() in mkr_parser.y local oldfname local fdebug static prog,b,colon,yyprefix static attn initial { prog := "end_file: " b := " " colon := ":" attn := repl("#",5) } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog oldfname := yyfnametab[image(fd)] FD := keclose(fd) nestreset() write(fdebug,attn,b,yyprefix,"EOF fd = (",image(fd),") new fd = (",image(FD),") new format = (",KFORMAT,")",b,attn) if (ECHO==("on"|"ON")) & (oldfname ~== "internal") then write(&output,attn,b,yyprefix,"EOF fd = (",image(fd),") new fd = (",image(FD),") new format = (",KFORMAT,")",b,attn) return FD end #----------------------------------------------# #----------------------------------------------# # FILE procedure push_file(fd,fname,format) #=================================== # save file parameters # called by keopen() in mkr_io.icn local fdebug static prog,b,colon,yyprefix initial { prog := "push_file: " b := " " colon := ":" /yyfdstack := [] /yyfnametab := table() /yylinenotab := table() /yywordnotab := table() /yyformattab := table() } fdebug := mylog /format := "ku" # save current values if *yyfdstack > 0 then { yylinenotab[image(FD)] := yylineno yywordnotab[image(FD)] := yywordno yyformattab[image(FD)] := yyformat := KFORMAT } # set new values FD := fd fName := fname yylineno := 0 yywordno := 0 yyformat := KFORMAT := format yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog push(yyfdstack,FD) yyfnametab[image(FD)] := fName yylinenotab[image(FD)] := yylineno yywordnotab[image(FD)] := yywordno yyformattab[image(FD)] := yyformat return FD end # FILE procedure pop_file(fd,fname) #============================ # restore file parameters # called by keclose() in mkr_io.icn local topfd local fdebug static prog,b,colon,yyprefix initial { prog := "pop_file: " b := " " colon := ":" } fdebug := mylog yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog ###write(fdebug,yyprefix,"old fd = (",image(fd),")") topfd := yyfdstack[1] if fd === topfd then {} else { write(&errout,yyprefix,"Internal ERROR: fd = (",image(fd), ") topfd = (",image(topfd),")") } # restore previous values fd := pop(yyfdstack) FD := yyfdstack[1] | keopen("input") fName := yyfnametab[image(FD)] yylineno := yylinenotab[image(FD)] yywordno := yywordnotab[image(FD)] yyformat := KFORMAT := yyformattab[image(FD)] yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog ###write(fdebug,yyprefix,"new fd = (",image(FD),")") if fName == "input" then PS := "ke$ " else PS := "" return FD end # FILE procedure myopen(arg0) #===================== # called from ke,ksc,hoke,... # set up mylog # write all messages to log file local argc,logfile static prog,b,c,colon,yyprefix static info,warning,error initial { prog := "myopen: " b := " " c := "," colon := ":" logfile := "mke.log" info := "INFO: "||prog warning := "WARNING: "||prog error := "ERROR: "||prog /QUIET := "yes" } yyprefix := yylineno||colon||yywordno||b||yyformat||b||prog /arg0 := "ke" PS := arg0||"$ " # do NOT use keopen() - don't want logfile on yyfdstack remove(logfile) mylog := open(logfile,"w") | stop(prog||"can't open log file ("||logfile||")") write(mylog,yyprefix,"arg0 = (",showparse(arg0),") mylog = (",image(mylog),")") if QUIET == ("no"|"NO") then write(&errout,yyprefix,"arg0 = (",showparse(arg0),") mylog = (",image(mylog),")") #####db_open() # database.icn return mylog end procedure myclose() #================== # called from do_exit() in ke.icn, ksc.icn, hoke.icn close(mylog) #####db_close() # database.icn end # # string procedure webdir(dir,option) #=========================== # suspend file names of web directory # option ::= file | all local fd,line static fchar,ws,p1,p2 initial { ws := ' \t\b\r\b\f' fchar := &letters ++ &digits ++ '%' ++ ws ++ '.-_' ++ '/\\' p1 := "\"[DIR]\"