cmdr
Check-in [9ab661bcd1]
Not logged in
Bounty program for improvements to Tcl and certain Tcl packages.

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Modified the checks for wfile/wchan to allow non-existing files which can be created (per permissions).
Timelines: family | ancestors | descendants | both | more-vtypes
Files: files | file ages | folders
SHA1: 9ab661bcd1e433c29ef7a61d00b3bfd87a5f1f3e
User & Date: andreask 2014-02-19 19:39:17
Context
2014-03-13
18:34
cmdr::validate::common - Consolidated multiple copies of "OkDir" in cmdr::validate into a single shared helper command "ok-directory". check-in: e7f547d6aa user: andreask tags: more-vtypes
2014-02-19
19:39
Modified the checks for wfile/wchan to allow non-existing files which can be created (per permissions). check-in: 9ab661bcd1 user: andreask tags: more-vtypes
19:11
Draft code for additional vtypes: Paths, with appropriate open channels as internal rep. check-in: 209bf08a86 user: aku tags: more-vtypes
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to validate.tcl.

238
239
240
241
242
243
244
245





246
247
248
249























250
251
252
253
254
255
256
...
455
456
457
458
459
460
461
462





463
464
465
466























467
468
469
470
471
472
473
proc ::cmdr::validate::wfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p WFILE "an existing writable file" $x
}

proc ::cmdr::validate::wfile::Ok {path} {
    if {![file exists   $path]} {return 0}





    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}
























# # ## ### ##### ######## ############# #####################
## File, existing and read/writable

namespace eval ::cmdr::validate::rwfile {
    namespace export default validate complete release
    namespace ensemble create
................................................................................
proc ::cmdr::validate::wchan::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return [open $x w] }
    fail $p WCHAN "an existing writable file" $x
}

proc ::cmdr::validate::wchan::Ok {path} {
    if {![file exists   $path]} {return 0}





    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}
























# # ## ### ##### ######## ############# #####################
## Channel, for existing and read/writable file. No default.

namespace eval ::cmdr::validate::rwchan {
    namespace export default validate complete release
    namespace ensemble create






|
>
>
>
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|
>
>
>
>
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
...
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
proc ::cmdr::validate::wfile::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return $x }
    fail $p WFILE "an existing writable file" $x
}

proc ::cmdr::validate::wfile::Ok {path} {
    if {![file exists $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [OkDir [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

proc ::cmdr::validate::wfile::OkDir {path} {
    if {![file exists $path]} {
	# The directory is allowed to not exist if its parent
	# directory exists and is writable.
	# Note: Block walking up the chain if the directory has no
	# parent.
	# Note: Switch to absolute notation if path is the relative
	# name of the CWD (i.e. ".").
	if {$path eq "."} {
	    set path [pwd]
	}
	set up [file dirname $path]
	if {$up eq $path} {
	    # Reached root (/, x:, x:/), is missing, stop & fail.
	    return 0
	}
	return [OkDir $up]
    }
    if {![file isdirectory $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## File, existing and read/writable

namespace eval ::cmdr::validate::rwfile {
    namespace export default validate complete release
    namespace ensemble create
................................................................................
proc ::cmdr::validate::wchan::validate {p x} {
    debug.cmdr/validate {}
    if {[Ok $x]} { return [open $x w] }
    fail $p WCHAN "an existing writable file" $x
}

proc ::cmdr::validate::wchan::Ok {path} {
    if {![file exists $path]} {
	# The file is allowed to not exist if its directory exists and
	# is writable. This can apply recursively up the chain of
	# directories.
	return [OkDir [file dirname $path]]
    }
    if {![file isfile   $path]} {return 0}
    if {![file writable $path]} {return 0}
    return 1
}

proc ::cmdr::validate::wchan::OkDir {path} {
    if {![file exists $path]} {
	# The directory is allowed to not exist if its parent
	# directory exists and is writable.
	# Note: Block walking up the chain if the directory has no
	# parent.
	# Note: Switch to absolute notation if path is the relative
	# name of the CWD (i.e. ".").
	if {$path eq "."} {
	    set path [pwd]
	}
	set up [file dirname $path]
	if {$up eq $path} {
	    # Reached root (/, x:, x:/), is missing, stop & fail.
	    return 0
	}
	return [OkDir $up]
    }
    if {![file isdirectory $path]} {return 0}
    if {![file writable    $path]} {return 0}
    return 1
}

# # ## ### ##### ######## ############# #####################
## Channel, for existing and read/writable file. No default.

namespace eval ::cmdr::validate::rwchan {
    namespace export default validate complete release
    namespace ensemble create