1#
2# This file is part of:
3#
4#  gpsman --- GPS Manager: a manager for GPS receiver data
5#
6# Copyright (c) 1998-2013 Miguel Filgueiras migfilg@t-online.de
7#
8#    This program is free software; you can redistribute it and/or modify
9#      it under the terms of the GNU General Public License as published by
10#      the Free Software Foundation; either version 3 of the License, or
11#      (at your option) any later version.
12#
13#      This program is distributed in the hope that it will be useful,
14#      but WITHOUT ANY WARRANTY; without even the implied warranty of
15#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16#      GNU General Public License for more details.
17#
18#      You should have received a copy of the GNU General Public License
19#      along with this program.
20#
21#  File: check.tcl
22#  Last change:  6 October 2013
23#
24# Includes contributions by
25#  - Valere Robin (valere.robin _AT_ wanadoo.fr) marked "VR contribution"
26#
27
28proc CheckName {errproc name} {
29    # check length and characters of name; call $errproc on error
30    global ACCEPTALLCHARS NAMELENGTH NOLOWERCASE MYGPS RECNAMECHARS MESS
31
32    set n [string length $name]
33    if { $n > $NAMELENGTH } {
34	$errproc [format $MESS(namelgth) $NAMELENGTH]
35	return 0
36    }
37    if { $n == 0 } {
38	$errproc $MESS(namevoid)
39	return 0
40    }
41    if { $ACCEPTALLCHARS } { return 1 }
42    if { ! $NOLOWERCASE } {
43	set name [string toupper $name]
44    }
45    if { [regexp $RECNAMECHARS($MYGPS) $name] } {
46	return 1
47    }
48    $errproc $MESS(badstrg)
49    return 0
50}
51
52proc CheckDateEls {y m d h mn s} {
53    # check year, month, day, hour, minutes, seconds
54    global YEAR0 DAYSOF
55
56    if { $y<$YEAR0 || $m<1 || $m>12 || $d<1 || \
57	    $h<0 || $h>23 || $mn<0 || $mn>59 || $s<0 || $s>59 || \
58	    ( $d>$DAYSOF($m) && ($m != 2 || $d != 29 || \
59	      $y%4 != 0 || ($y%100 == 0 && $y%400 != 0)) ) } {
60	return 0
61    }
62    return 1
63}
64
65proc CheckDate {errproc date} {
66    global CREATIONDATE MESS
67
68    if { $CREATIONDATE && [ScanDate $date] == "" } {
69	$errproc [format $MESS(baddateas) $date]
70	return 0
71    }
72    return 1
73}
74
75proc CheckConvDate {string} {
76    # convert string to date
77    global DateFormat MESS
78
79    if { [set l [ScanDate $string]] != "" } {
80	return [list [eval FormatDate $DateFormat $l] [eval DateToSecs $l]]
81    }
82    GMMessage "$MESS(baddate): $string"
83    return ""
84}
85
86proc CheckTime {errproc time} {
87    # check hours, minutes and seconds separated by ":", where hours
88    #  and minutes may be absent, seconds may be a float
89    # accept "" as undefined value
90    global MESS
91
92    if { $time == "" } { return 1 }
93    if { [set n [llength [set fs [split $time ":"]]]] <= 3 && \
94	     [CheckFloat Ignore [set s [lindex $fs end]]] && $s < 60 } {
95	if { $n == 1 } { return 1 }
96	if { [CheckNumber Ignore [set m [lindex $fs end-1]]] && $m < 60 } {
97	    if { $n == 2 } { return 1 }
98	    if { [CheckNumber Ignore [lindex $fs 0]] } { return 1 }
99	}
100    }
101    $errproc $MESS(badtimeval)
102    return 0
103}
104
105proc CheckLat {errproc lat pformt} {
106    # positive latitudes to North
107    return [CheckCoord $errproc $pformt $lat N 90]
108}
109
110proc CheckLong {errproc long pformt} {
111    # positive longitudes to East
112    return [CheckCoord $errproc $pformt $long E 180]
113}
114
115proc CheckCoord {errproc pformt coord posh max} {
116    # check coordinate $coord under format $pformt, with positive heading $posh
117    #  and maximum value $max in degrees; call $errproc on error
118    global MESS TXT
119
120    set coord [string trim $coord]
121    set h [string index $coord 0]
122    if { ! [regexp {[0-9]} $h] } {
123	if { ! [regexp {[+-]} $h] && $h != $posh && \
124		$h != [ChangeCoordSign $posh] } {
125	    $errproc [format $MESS(badhdg) $h $posh/[ChangeCoordSign $posh]]
126	    return 0
127	}
128	set coord [string range $coord 1 end]
129    }
130    switch $pformt {
131	DMS {
132	    if { [scan $coord "%d %d %f%s" d m s err] == 3 } {
133		if { ($d<$max && $m<60 & $s<60) || \
134			($d==$max && $m==0 && $s==0) } { return 1 }
135	    }
136	}
137	DMM {
138	    if { [scan $coord "%d %f%s" d m err] == 2 } {
139		if { ($d<$max && $m<60) || ($d==$max && $m==0) } {
140		    return 1
141		}
142	    }
143	}
144	DDD {
145	    if { [scan $coord "%f%s" d err] == 1 } {
146		if { $d <= $max } { return 1 }
147	    }
148	}
149	GRA {
150	    if { [scan $coord "%f%s" d err] == 1 } {
151		if { $d <= $max/0.9 } { return 1 }
152	    }
153	}
154    }
155    $errproc [format $MESS(badcoord) $coord $TXT($pformt)]
156    return 0
157}
158
159proc CheckZE {errproc ze} {
160    # check zone east of UTM coordinate; call $errproc on error
161    global MESS
162
163    if { [CheckNumber $errproc $ze] } {
164	if { $ze<0 || $ze>99 } {
165	    $errproc "$MESS(outofrng) \[0..99\]"
166	} else { return 1 }
167    }
168    return 0
169}
170
171proc CheckZN {errproc zn} {
172    # check zone north of UTM coordinate; call $errproc on error
173    global MESS
174
175    if { [regexp {^[A-Z]$} $zn] && $zn != "I" && $zn != "O" } { return 1 }
176    $errproc $MESS(UTMZN)
177    return 0
178}
179
180proc CheckZone {errproc zone pformt} {
181    # check zone for the grid $pformt; call $errproc on error
182    global MESS GRIDZN
183
184    if { [regexp $GRIDZN($pformt) $zone] } { return 1 }
185    $errproc $MESS(badgridzone)
186    return 0
187}
188
189proc CheckMHLocator {errproc mh} {
190    global MESS
191
192    if { [regexp {^[A-R][A-R][0-9][0-9][A-X][A-X]$} $mh] } { return 1 }
193    $errproc $MESS(badMHloc)
194    return 0
195}
196
197proc CheckComment {errproc comm} {
198    # check length and characters of comment; call $errproc on error
199    global COMMENTLENGTH MESS
200
201    if { [string length $comm] > $COMMENTLENGTH } {
202	$errproc [format $MESS(cmmtlgth) $COMMENTLENGTH]
203	return 0
204    }
205    return [CheckChars $errproc $comm]
206}
207
208proc CheckChars {errproc string} {
209    # check characters in comment string; call $errproc on error
210    global ACCEPTALLCHARS NOLOWERCASE MESS
211
212    if { $ACCEPTALLCHARS } { return 1 }
213    if { ! $NOLOWERCASE || [regexp {^[-A-Z0-9 -]*$} $string] } {
214	return 1
215    }
216    $errproc $MESS(badstrg)
217    return 0
218}
219
220proc CheckString {errproc string} {
221    # check that string is not void; call $errproc on error
222    global MESS
223
224    if { [string length $string] == 0 } {
225	$errproc $MESS(strgvoid)
226	return 0
227    }
228    return 1
229}
230
231proc CheckNumber {errproc n} {
232    # check that $n is a natural number; may be preceded/followed by spaces;
233    # call $errproc on error
234    global MESS
235
236    if { [regexp {^ *[0-9]+ *$} $n] } { return 1 }
237    $errproc [format $MESS(nan) $n]
238    return 0
239}
240
241proc CheckFloat {errproc n} {
242    # check that $n is floating-point number that may be preceded/followed
243    #  by spaces; scientific notation accepted
244    # call $errproc on error
245    global MESS
246
247    if { [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $n] } {
248	return 1
249    }
250    $errproc [format $MESS(nan) $n]
251    return 0
252}
253
254proc CheckSignedFloat {errproc n} {
255    # check that $n is a floating-point number, that may have a minus sign
256    #  and be preceded/followed by spaces; scientific notation accepted
257    # call $errproc on error
258    global MESS
259
260    if { [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $n] } {
261	return 1
262    }
263    $errproc [format $MESS(nan) $n]
264    return 0
265}
266
267proc CheckNB {text} {
268    # delete empty lines and leading blanks from text
269
270    while { [regsub -all "\n\n+" $text "\n" text] } {}
271    return [string trim $text " \t\n"]
272}
273
274proc Ignore {args} {
275    # to be used as error/checking procedure when ignoring errors
276
277    return 0
278}
279
280proc CheckArrayElement {array val} {
281    # check that $val is an element of $array
282    # return 1 on success, 0 on error
283    global $array
284
285    foreach an [array names $array] {
286	if { [set [set array]($an)] == $val } { return 1 }
287    }
288    return 0
289}
290
291proc BadAltitude {altlst} {
292    # check internal representation of altitude as list
293    # also used for depth
294    global AltUnit ALSCALE DLUNIT
295
296    if { $altlst == "" || [CheckSignedFloat Ignore $altlst] } { return 0 }
297    if { [llength $altlst] != 3 || \
298	    [catch {expr [lindex $altlst 0]+[lindex $altlst 1]}] || \
299	    [catch {set DLUNIT([lindex $altlst 2],dist)}] } { return 1 }
300    return 0
301}
302
303proc BadWidth {w} {
304    # check value for line width
305
306    if { [regexp {^[1-9][0-9]?$} $w] } { return 0 }
307    return 1
308}
309
310proc BadColour {c} {
311    # check that string describing a colour, either in "#A0B0C0" form or
312    #  as an acceptable name
313
314    if { [ColourToDec $c] != -1 } { return 0 }
315    return 1
316}
317
318proc BadDatumFor {pformt datum errproc} {
319    # check whether datum is suitable for use with position format
320    # if not call $errproc with appropriate message
321    # return 0 if it is, otherwise the required datum
322    global POSTYPE TXT MESS
323
324    if { ( [set t $POSTYPE($pformt)] == "nzgrid" || $t == "grid" ) && \
325	     [set gd [GridDatum $pformt $datum]] != $datum } {
326	$errproc [format $MESS(badgriddatum) $TXT($pformt) $gd]
327	return $gd
328    }
329    return 0
330}
331
332proc BadParam {name type value} {
333    # check $value for numeric parameter of definition $name
334    #  $type as used in MAPPROJDTYPE array (projections.tcl)
335    #  $name is used only in the error message
336    global MESS GRIDZN
337
338    set e 1
339    if { [regexp {zone=(.*)} $type x grname] } {
340	if { [regexp $GRIDZN($grname) $value] } { return 0 }
341    } elseif { \
342	    [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $value] } {
343	switch -glob $type {
344	    lat=*,* {
345		regexp {lat=([^,]+),(.*)} $type z mn mx
346		set e [expr $value<$mn || $value>$mx]
347	    }
348	    long=*,* {
349		regexp {long=([^,]+),(.*)} $type z mn mx
350		set e [expr $value<$mn || $value>$mx]
351	    }
352	    lat {
353		set e [expr $value<-90 || $value>90]
354	    }
355	    long {
356		set e [expr $value<-180 || $value>180]
357	    }
358	    float>* {
359		regsub float> $type "" mn
360		set e [expr $value<$mn]
361	    }
362	    list=* -  list:* {
363		set l [string range $type 5 end]
364		foreach v [split $l ,] {
365		    if { $value == $v } { return 0 }
366		}
367	    }
368	    float {
369		return 0
370	    }
371	}
372    }
373    if { $e } {
374	GMMessage [format $MESS(badparam) $name]
375	return 1
376    }
377    return 0
378}
379
380
381