# # KEHOME/parser/mkr_io.icn # Richard H. McCullough Sep/24/2014 Mar/22/2015 # May/2/2014 webdir() $include "yyinclude.h" ###$include "keparam.h" ###$include "merr.h" link basename # basename() link io # suffix() global MoreFiles global QUIET,PROMPT global kelabel # for window labels # methods #======== # end_file(fd) # gdbm_fname(concept) # gdbm_open(concept,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) # read_csv(fd,kfile,format,relname) # webdir(dir) # integer procedure read_knit(fd,kfile,format) #=================================== local line,nlines local prop,dval local fname,relname static prog,b,colon,yyprefix static attn,info initial { prog := "read_knit: " b := " " colon := ":" attn := repl("#",5) info := "INFO: "||prog } yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog nlines := 0 kfile := unparse(kfile) /format := "ku" /fd := keopen(kfile,,format) if type(fd) == "null" then return nlines write(mylog,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) if \fname[2] == "csv" then { relname := basename(fname[1]) nlines := read_csv(fd,kfile,"csv",relname) push_line("EOF") # for kfile } if fName == "input" then PS := "ke$ " else PS := "" nestreset() parse_file() return nlines := yylineno end # integer procedure read_csv(fd,kfile,format,relname) #========================================== # first line contains comma-separated labels # append semicolon to each line local t,q,label,arglabel,i,argformat local nlines,line,newfile static prog,b,s,colon,yyprefix static ws,sharp,dollar initial { prog := "read_csv: " b := " " s := ";" colon := ":" ws := ' \t\v\r\n\f' sharp := "#" dollar := "$" } yyprefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(&output,yyprefix,"fd = (",image(fd),") kfile = (",kfile,") format = (",format,") relname = (",relname,")") t := new_nrel(relname) line := read(fd) label := trim(line,ws++s,0) arglabel := list_unparse(parse_csv(label)) write(&output,yyprefix,"arglabel = (",showparse(arglabel),")") argformat := []; every i := key(arglabel) do put(argformat,arglabel[i]||colon||i) q := new_argdef(relname,"relation") ARGINFO[q].arity := *arglabel ARGINFO[q].automatic := "ISU" ARGINFO[q].format := argformat ARGINFO[q].label := arglabel ARGINFO[q].argclass := arglabel ARGINFO[q].argno := keylist(arglabel) newfile := [] put(newfile,"begin relation "||relname||s) ##### put(newfile,label||s) nlines := 0 every line := !fd do { nlines +:= 1 line := trim(line,ws++s,0) if *line = 0 then next if line[1] == sharp then next put(newfile,line||s) } put(newfile,"end relation "||relname||s) put(newfile,"EOF") # for "internal" every line := !reverse(newfile) do push_line(line) ECHO := "on" read_knit(,"internal","nel") return nlines end # string procedure keprefix(kfile) #======================== # change "file" to "$KEHOME/file" # change "/cygdrive/c" to "c:" # need $CHOME prefix if Unicon is not compiled with Cygwin local prefix static cdrive,slash static home,kehome,uhome,chome static prog initial { prog := "keprefix: " cdrive := "/cygdrive/c" slash := "/" chome := getenv("CHOME") | "" home := getenv("HOME") | "" kehome := getenv("KEHOME") | "" uhome := getenv("UHOME") | "" } ##### if kehome ? =cdrive & (prefix := tab(0)) ##### then kehome := "c:"||prefix if DEBUG=="I/O" then write("# keprefix: prefix = (",prefix,")") return chome||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(tname,mode) ##### #================================ ##### # open GDBM file ##### # fd used like table in Unicon ##### # DBDIR usually HOME/db ##### local fd,tail,fname ##### static prog,info,warning,error ##### initial { ##### prog := "gdbm_open: " ##### info := "INFO: "||prog ##### warning := "WARNING: "||prog ##### error := "ERROR: "||prog ##### } ##### /mode := "d" ##### tname := unparse(tname) ##### fname := gdbm_fname(tname) ##### ##### if fd := keopen(fname,mode) then { ##### write(mylog,prog,"fd = (",image(fd),")") ##### } else { ##### Nerror +:= 1 ##### write(&errout,prog,"can't open fname = (",image(fname),")") ##### write(mylog, prog,"can't open fname = (",image(fname),")") ##### fail ##### } ##### return fd ##### end ##### ##### procedure gdbm_close(fd) ##### #======================= ##### keclose(fd) ##### end #----------------------------------------------# # FILE procedure keclose(oldfd) #======================= local newfd static prog,b,colon,prefix initial { prog := "keclose: " b := " " colon := ":" } prefix := 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 prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(mylog,prefix,"oldfd = (",image(oldfd),") newfd = (",image(newfd),") new format = (",KFORMAT,")") writes(mylog,prefix,"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 static prog,b,colon,prefix 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" } /mode := "r" /format := "ku" kehome := getenv("KEHOME") fname := unparse(fname) if type(fname) == "null" then fail if *fname = 0 then fail prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog ##if DEBUG == "OPEN" then { write(mylog,prefix,"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(mylog,prefix,"pname = (",image(pname),")") } every kfile := ![fname,pname] do { fd := &null if fd := open(kfile,mode) then { push_file(fd,kfile) break } else { write(mylog,prefix||"can't open (",kfile,")") if kfile == pname then write(&errout,prefix,"can't open (",kfile,")") next } # end if open kfile } # end every kfile } # end default } # end case prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(mylog,prefix,"fname = (",image(fname),") fd = (",image(fd),") format = (",KFORMAT,")") writes(mylog,prefix,"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 static prog,b,colon,prefix static attn initial { prog := "end_file: " b := " " colon := ":" attn := repl("#",5) } oldfname := yyfnametab[image(fd)] FD := keclose(fd) nestreset() prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog write(mylog,attn,b,prefix,"EOF fd = (",image(fd),") new fd = (",image(FD),") new format = (",KFORMAT,")",b,attn) if (ECHO==("on"|"ON")) & (oldfname ~== "internal") then write(&output,attn,b,prefix,"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 static prog,b,colon,prefix initial { prog := "push_file: " b := " " colon := ":" /yyfdstack := [] /yyfnametab := table() /yylinenotab := table() /yywordnotab := table() /yyformattab := table() } /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 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 static prog,b,colon,prefix initial { prog := "pop_file: " b := " " colon := ":" } prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog ###write(mylog,prefix,"old fd = (",image(fd),")") topfd := yyfdstack[1] if fd === topfd then {} else { write(&errout,prefix,"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)] prefix := yylineno||colon||yywordno||b||KFORMAT||b||prog ###write(mylog,prefix,"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,prefix static info,warning,error initial { prog := "myopen: " b := " " c := "," colon := ":" logfile := "mke.log" info := "INFO: "||prog warning := "WARNING: "||prog error := "ERROR: "||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||")") #####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) #==================== # suspend file names of web directory local fd,line static prefix,fchar initial { prefix := "\"[DIR]\"