gpsman 6.4.3-1 / usr / lib / gpsman / check.tcl

#
# This file is part of:
#
#  gpsman --- GPS Manager: a manager for GPS receiver data
#
# Copyright (c) 1998-2011 Miguel Filgueiras migf@portugalmail.pt
#
#    This program is free software; you can redistribute it and/or modify
#      it under the terms of the GNU General Public License as published by
#      the Free Software Foundation; either version 3 of the License, or
#      (at your option) any later version.
#
#      This program is distributed in the hope that it will be useful,
#      but WITHOUT ANY WARRANTY; without even the implied warranty of
#      MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#      GNU General Public License for more details.
#
#      You should have received a copy of the GNU General Public License
#      along with this program.
#
#  File: check.tcl
#  Last change:  19 July 2011
#
# Includes contributions by
#  - Valere Robin (valere.robin _AT_ wanadoo.fr) marked "VR contribution"
#

proc CheckName {errproc name} {
    # check length and characters of name; call $errproc on error
    global ACCEPTALLCHARS NAMELENGTH NOLOWERCASE MYGPS RECNAMECHARS MESS

    set n [string length $name]
    if { $n > $NAMELENGTH } {
	$errproc [format $MESS(namelgth) $NAMELENGTH]
	return 0
    }
    if { $n == 0 } {
	$errproc $MESS(namevoid)
	return 0
    }
    if { $ACCEPTALLCHARS } { return 1 }
    if { ! $NOLOWERCASE } {
	set name [string toupper $name]
    }
    if { [regexp $RECNAMECHARS($MYGPS) $name] } {
	return 1
    }
    $errproc $MESS(badstrg)
    return 0
}

proc CheckDateEls {y m d h mn s} {
    # check year, month, day, hour, minutes, seconds
    global YEAR0 DAYSOF

    if { $y<$YEAR0 || $m<1 || $m>12 || $d<1 || \
	    $h<0 || $h>23 || $mn<0 || $mn>59 || $s<0 || $s>59 || \
	    ( $d>$DAYSOF($m) && ($m != 2 || $d != 29 || \
	      $y%4 != 0 || ($y%100 == 0 && $y%400 != 0)) ) } {
	return 0
    }
    return 1
}

proc CheckDate {errproc date} {
    global CREATIONDATE MESS

    if { $CREATIONDATE && [ScanDate $date] == "" } {
	$errproc [format $MESS(baddateas) $date]
	return 0
    }
    return 1
}

proc CheckConvDate {string} {
    # convert string to date
    global DateFormat MESS

    if { [set l [ScanDate $string]] != "" } {
	return [list [eval FormatDate $DateFormat $l] [eval DateToSecs $l]]
    }
    GMMessage "$MESS(baddate): $string"
    return ""
}

proc CheckTime {errproc time} {
    # check hours, minutes and seconds separated by ":", where hours
    #  and minutes may be absent, seconds may be a float
    # accept "" as undefined value
    global MESS

    if { $time == "" } { return 1 }
    if { [set n [llength [set fs [split $time ":"]]]] <= 3 && \
	     [CheckFloat Ignore [set s [lindex $fs end]]] && $s < 60 } {
	if { $n == 1 } { return 1 }
	if { [CheckNumber Ignore [set m [lindex $fs end-1]]] && $m < 60 } {
	    if { $n == 2 } { return 1 }
	    if { [CheckNumber Ignore [lindex $fs 0]] } { return 1 }
	}
    }
    $errproc $MESS(badtimeval)
    return 0
}

proc CheckLat {errproc lat pformt} {
    # positive latitudes to North
    return [CheckCoord $errproc $pformt $lat N 90]
}

proc CheckLong {errproc long pformt} {
    # positive longitudes to East
    return [CheckCoord $errproc $pformt $long E 180]
}

proc CheckCoord {errproc pformt coord posh max} {
    # check coordinate $coord under format $pformt, with positive heading $posh
    #  and maximum value $max in degrees; call $errproc on error
    global MESS TXT

    set coord [string trim $coord]
    set h [string index $coord 0]
    if { ! [regexp {[0-9]} $h] } {
	if { ! [regexp {[+-]} $h] && $h != $posh && \
		$h != [ChangeCoordSign $posh] } {
	    $errproc [format $MESS(badhdg) $h $posh/[ChangeCoordSign $posh]]
	    return 0
	}
	set coord [string range $coord 1 end]
    }
    switch $pformt {
	DMS {
	    if { [scan $coord "%d %d %f%s" d m s err] == 3 } {
		if { ($d<$max && $m<60 & $s<60) || \
			($d==$max && $m==0 && $s==0) } { return 1 }
	    }
	}
	DMM {
	    if { [scan $coord "%d %f%s" d m err] == 2 } {
		if { ($d<$max && $m<60) || ($d==$max && $m==0) } {
		    return 1
		}
	    }
	}
	DDD {
	    if { [scan $coord "%f%s" d err] == 1 } {
		if { $d <= $max } { return 1 }
	    }
	}
	GRA {
	    if { [scan $coord "%f%s" d err] == 1 } {
		if { $d <= $max/0.9 } { return 1 }
	    }
	}
    }
    $errproc [format $MESS(badcoord) $coord $TXT($pformt)]
    return 0
}

proc CheckZE {errproc ze} {
    # check zone east of UTM coordinate; call $errproc on error
    global MESS

    if { [CheckNumber $errproc $ze] } {
	if { $ze<0 || $ze>99 } {
	    $errproc "$MESS(outofrng) \[0..99\]"
	} else { return 1 }
    }
    return 0
}

proc CheckZN {errproc zn} {
    # check zone north of UTM coordinate; call $errproc on error
    global MESS

    if { [regexp {^[A-Z]$} $zn] && $zn != "I" && $zn != "O" } { return 1 }
    $errproc $MESS(UTMZN)
    return 0
}

proc CheckZone {errproc zone pformt} {
    # check zone for the grid $pformt; call $errproc on error
    global MESS GRIDZN

    if { [regexp $GRIDZN($pformt) $zone] } { return 1 }
    $errproc $MESS(badgridzone)
    return 0
}

proc CheckMHLocator {errproc mh} {
    global MESS

    if { [regexp {^[A-R][A-R][0-9][0-9][A-X][A-X]$} $mh] } { return 1 }
    $errproc $MESS(badMHloc)
    return 0
}

proc CheckComment {errproc comm} {
    # check length and characters of comment; call $errproc on error
    global COMMENTLENGTH MESS

    if { [string length $comm] > $COMMENTLENGTH } {
	$errproc [format $MESS(cmmtlgth) $COMMENTLENGTH]
	return 0
    }
    return [CheckChars $errproc $comm]
}

proc CheckChars {errproc string} {
    # check characters in comment string; call $errproc on error
    global ACCEPTALLCHARS NOLOWERCASE MESS

    if { $ACCEPTALLCHARS } { return 1 }
    if { ! $NOLOWERCASE || [regexp {^[-A-Z0-9 -]*$} $string] } {
	return 1
    }
    $errproc $MESS(badstrg)
    return 0
}

proc CheckString {errproc string} {
    # check that string is not void; call $errproc on error
    global MESS

    if { [string length $string] == 0 } {
	$errproc $MESS(strgvoid)
	return 0
    }
    return 1
}

proc CheckNumber {errproc n} {
    # check that $n is a natural number; may be preceded/followed by spaces;
    # call $errproc on error
    global MESS

    if { [regexp {^ *[0-9]+ *$} $n] } { return 1 }
    $errproc [format $MESS(nan) $n]
    return 0
}

proc CheckFloat {errproc n} {
    # check that $n is floating-point number that may be preceded/followed
    #  by spaces; scientific notation accepted
    # call $errproc on error
    global MESS

    if { [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $n] } {
	return 1
    }
    $errproc [format $MESS(nan) $n]
    return 0
}

proc CheckSignedFloat {errproc n} {
    # check that $n is a floating-point number, that may have a minus sign
    #  and be preceded/followed by spaces; scientific notation accepted
    # call $errproc on error
    global MESS

    if { [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $n] } {
	return 1
    }
    $errproc [format $MESS(nan) $n]
    return 0
}

proc CheckNB {text} {
    # delete empty lines and leading blanks from text

    while { [regsub -all "\n\n+" $text "\n" text] } {}
    return [string trim $text " \t\n"]
}

proc Ignore {args} {
    # to be used as error/checking procedure when ignoring errors

    return 0
}

proc CheckArrayElement {array val} {
    # check that $val is an element of $array
    # return 1 on success, 0 on error
    global $array

    foreach an [array names $array] {
	if { [set [set array]($an)] == $val } { return 1 }
    }
    return 0
}

proc BadAltitude {altlst} {
    # check internal representation of altitude as list
    # also used for depth
    global AltUnit ALSCALE DLUNIT

    if { $altlst == "" || [CheckSignedFloat Ignore $altlst] } { return 0 }
    if { [llength $altlst] != 3 || \
	    [catch {expr [lindex $altlst 0]+[lindex $altlst 1]}] || \
	    [catch {set DLUNIT([lindex $altlst 2],dist)}] } { return 1 }
    return 0
}

proc BadWidth {w} {
    # check value for line width

    if { [regexp {^[1-9][0-9]?$} $w] } { return 0 }
    return 1
}

proc BadColour {c} {
    # check that string describing a colour, either in "#A0B0C0" form or
    #  as an acceptable name

    if { [ColourToDec $c] != -1 } { return 0 }
    return 1
}

proc BadDatumFor {pformt datum errproc} {
    # check whether datum is suitable for use with position format
    # if not call $errproc with appropriate message
    # return 0 if it is, otherwise the required datum
    global POSTYPE TXT MESS

    if { ( [set t $POSTYPE($pformt)] == "nzgrid" || $t == "grid" ) && \
	     [set gd [GridDatum $pformt $datum]] != $datum } {
	$errproc [format $MESS(badgriddatum) $TXT($pformt) $gd]
	return $gd
    }
    return 0
}

proc BadParam {name type value} {
    # check $value for numeric parameter of definition $name
    #  $type as used in MAPPROJDTYPE array (projections.tcl)
    #  $name is used only in the error message
    global MESS GRIDZN

    set e 1
    if { [regexp {zone=(.*)} $type x grname] } {
	if { [regexp $GRIDZN($grname) $value] } { return 0 }
    } elseif { \
	    [regexp {^ *-?[0-9]+(\.[0-9]+)?([eE]-?[1-9][0-9]*)? *$} $value] } {
	switch -glob $type {
	    lat=*,* {
		regexp {lat=([^,]+),(.*)} $type z mn mx
		set e [expr $value<$mn || $value>$mx]
	    }
	    long=*,* {
		regexp {long=([^,]+),(.*)} $type z mn mx
		set e [expr $value<$mn || $value>$mx]
	    }
	    lat {
		set e [expr $value<-90 || $value>90]
	    }
	    long {
		set e [expr $value<-180 || $value>180]
	    }
	    float>* {
		regsub float> $type "" mn
		set e [expr $value<$mn]
	    }
	    list=* -  list:* {
		set l [string range $type 5 end]
		foreach v [split $l ,] {
		    if { $value == $v } { return 0 }
		}
	    }
	    float {
		return 0
	    }
	}
    }
    if { $e } {
	GMMessage [format $MESS(badparam) $name]
	return 1
    }
    return 0
}