StarLingPlugins: plugin_toolbox_import.prg

File plugin_toolbox_import.prg, 5.1 KB (added by phil, 5 years ago)

SIL Toolbox import - source code

Line 
1/* $Id$ */
2/* StarLing plugin: Import Toolbox files */
3
4#include "common.ch"
5
6#include "dialog.ch"
7
8INIT FUNCTION register()
9  stPluginRegister( "Import Toolbox files", {|| toolbox_import() } )
10RETURN 0
11
12
13PROCEDURE toolbox_import(filename, dbfname, delimiter, tblname)
14  LOCAL place := 0
15  LOCAL fields := {}
16  LOCAL recs := {}
17  LOCAL rec := {}
18  LOCAL haskey := {}
19  LOCAL h, total, line, n, m, fld, astruct, dlg, table, nRec, sep_recs
20
21  DEFAULT tblname TO ""
22
23  IF Empty(filename) .OR. Empty(dbfname) .OR. Empty(delimiter)
24    dlg := { ;
25      { st_FILENAME, "Source Toolbox file", filename }, ;
26      { st_FILENAME_SAVE, "Target StarLing file", dbfname, "*.dbf" }, ;
27      { st_RICHEDIT, "Delimiter for duplicate fields (leave empty to create separate records)", " " }, ;
28      { st_FILENAME, "Encoding conversion table (leave empty for UTF8)", tblname } }
29    IF !stDialog("Import Toolbox files", , dlg)
30      RETURN
31    ENDIF
32    filename := dlg[1]
33    dbfname := dlg[2]
34    delimiter := dlg[3]
35    tblname := dlg[4]
36  ENDIF
37
38  sep_recs := ( Len(delimiter) == 0 )
39
40  IF (h := stOpen(filename)) <= 0
41    stMessage( filename + ": file does not exist" )
42    RETURN
43  ENDIF
44  IF !Empty(tblname)
45    IF !File(tblname)
46      stMessage(tblname + ": file does not exist" )
47      RETURN
48    ELSE
49      table := load_tbl(tblname)
50    ENDIF
51  ENDIF
52  total := stSeek(h, 0, 2)
53  DO WHILE place < total
54    line := stReadLine(@h, @place, total)
55    IF Left(line, 3) == E"\xEF\xBB\xBF"
56      line := SubStr(line, 4)
57    ENDIF
58    do case
59      case Left(line, 4) == "\_sh"
60      case Len(line) > 0 .AND. line[1] == '\'
61        n := at(' ', line)
62        m := 0
63        if n == 0
64          n := Len(line) + 1
65        endif .ASD
66        fld := substr(line, 2, n - 2)
67        if isdigit(Right(fld, 1)) .OR. Right(fld, 1) == ':'
68          fld := Left(fld, len(fld) - 1)
69        endif
70        if (m := AScan(fields, fld)) == 0
71          AAdd(fields, fld)
72          m := len(fields)
73        endif
74        IF n <= Len(line)
75          if len(rec) < m
76            asize(rec, m)
77          endif
78          if AScan(haskey, fld) == 0
79            rec[m] := Substr(line, n + 1)
80            aadd(haskey, fld)
81          elseif !sep_recs
82            if rec[m] == NIL
83              rec[m] := ""
84            endif
85            IF Len(rec[m]) > 0
86              rec[m] += delimiter
87            ENDIF
88            rec[m] += Substr(line, n + 1)
89          else
90            aadd(recs, rec)
91            rec := array(len(fields))
92            haskey := { fld }
93            rec[m] := SubStr(line, n + 1)
94          endif
95        endif
96      case empty(line)
97        aadd(recs, rec)
98        statusstring(str(len(recs)) + " records read")
99        rec := array(len(fields))
100        haskey := {}
101      otherwise
102        if len(rec) < m
103          asize(rec, m)
104        endif
105        if rec[m] == NIL
106          rec[m] := ""
107        endif
108        rec[m] += " " + line
109    endcase
110  enddo
111  stClose(h)
112  astruct := {}
113  AEval(fields, {|x| AAdd(astruct, { tofieldname(x, aStruct), "V", 6, 0, 0, x }) })
114  stDbCreate(dbfname, astruct)
115  stUse(dbfname)
116  nRec := 0
117  for nRec := 1 TO Len(recs)
118    AEval(recs[nRec], {|v,i| if(!Empty(v), stReplace(i, convert(v,table)), ) })
119    dbappend()
120    statusstring(str(len(recs)) + " records read, " + Str(RecNo()) + " written." )
121  next
122  GO TOP
123  stUse()
124  browseNew(dbfname)
125RETURN
126
127STATIC FUNCTION tofieldname(x, aStruct)
128  LOCAL i, s := "", stry
129  FOR i := 1 TO Len(x)
130    IF !(Len(s) == 0 .AND. IsDigit(x[i]))
131      IF ('A' <= Upper(x[i]) .AND. Upper(x[i]) <= 'Z') .OR. IsDigit(x[i])
132        s += Upper(x[i])
133      ELSE
134        IF Len(s) == 0
135          s := "F"
136        ENDIF
137        s += '_'
138      ENDIF
139    ENDIF
140  NEXT
141  stry := s
142  i := 1
143  DO WHILE AScan(aStruct, {|a| a[1] == stry }) > 0
144    stry := Left(s, 9) + LTrim(Str(i++))
145  ENDDO
146RETURN stry
147
148STATIC FUNCTION load_tbl(name)
149  LOCAL table := { => }, i, j:=1
150  LOCAL lines := stReadFile(name)
151  LOCAL line, key, value
152 
153  FOR EACH line IN lines
154    IF Len(line) > 0 .AND. line[1] == 'd'
155      key := ""
156      value := ""
157      i := 1
158      DO WHILE i <= Len(line)
159        IF line[i] == 'd'
160          key += Chr(Val(SubStr(line, i + 1, 3)))
161          DO WHILE IsDigit(line[++i])
162          ENDDO
163          DO WHILE line[i] $ " >" + Chr(9)
164            i++
165          ENDDO
166        ELSEIF line[i] == 'U'
167          value += wchar_to_utf8(hb_HexToNum(SubStr(line, i + 1, 4)))
168          i += 6
169          DO WHILE line[i] $ " >" + Chr(9)
170            i++
171          ENDDO
172        ELSEIF line[i] == 'c'
173          EXIT
174        ELSE
175          stMessage("Ignoring invalid conversion line "+Str(j)+": "+line + str(i))
176          EXIT
177        ENDIF
178      ENDDO
179      table[key] = value 
180    ENDIF
181    j++
182  NEXT
183RETURN table
184
185
186STATIC FUNCTION convert(s, table)
187  LOCAL t := "", i := 1, l, pos, len_s := Len(s)
188
189  IF Empty(table)
190    RETURN utf8_to_star(s)
191  ENDIF
192
193  DO WHILE i <= len_s
194    FOR l := Min(len_s - i + 1, 4) TO 1 STEP -1
195      pos := hb_HPos(table, SubStr(s, i, l))
196      IF pos > 0
197        t += hb_HValueAt(table, pos)
198        i += l
199        EXIT
200      ENDIF
201    NEXT
202    IF pos == 0
203      t += s[i]
204      i++
205    ENDIF
206  ENDDO
207RETURN utf8_to_star(t)
208