Decided for xorriso as info source about loal filesystem
This commit is contained in:
parent
a033121f6f
commit
b265ed9e7f
@ -738,15 +738,10 @@ proc isofs_filetype {path} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Inspection of hard disk is done via xorriso.
|
||||||
# The xorriso commands have the advantage to be always available and to
|
# The xorriso commands have the advantage to be always available and to
|
||||||
# need no unescaping.
|
# need no unescaping. On the other hand, shell and tcl lstat would be
|
||||||
# On the other hand, shell and tcl lstat are faster with large directories.
|
# faster with large directories.
|
||||||
#
|
|
||||||
set localfs_ls_by_sh 0
|
|
||||||
set localfs_filetype_by_tcl 0
|
|
||||||
|
|
||||||
|
|
||||||
if {$localfs_ls_by_sh == 0} {
|
|
||||||
|
|
||||||
# Parse-by-xorriso handler function for proc localfs_ls
|
# Parse-by-xorriso handler function for proc localfs_ls
|
||||||
#
|
#
|
||||||
@ -775,11 +770,6 @@ proc localfs_ls {dir} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# <<< $localfs_ls_by_sh == 0
|
|
||||||
}
|
|
||||||
if {$localfs_filetype_by_tcl == 0} {
|
|
||||||
|
|
||||||
|
|
||||||
# Tells the file type of an absolute path in the ISO model.
|
# Tells the file type of an absolute path in the ISO model.
|
||||||
# Indicator characters like with ls -l. Empty text means non existing file.
|
# Indicator characters like with ls -l. Empty text means non existing file.
|
||||||
#
|
#
|
||||||
@ -794,10 +784,6 @@ proc localfs_filetype {path} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
# <<< $localfs_filetype_by_tcl == 0
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# Verify that the connected process runs a xorriso program that is modern
|
# Verify that the connected process runs a xorriso program that is modern
|
||||||
# enough. This is done before sending xorriso the setup commands.
|
# enough. This is done before sending xorriso the setup commands.
|
||||||
#
|
#
|
||||||
@ -5549,59 +5535,6 @@ proc yell_xorriso_tcltk {} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
if {$localfs_filetype_by_tcl == 1} {
|
|
||||||
# <<< Now via xorriso -lslx
|
|
||||||
|
|
||||||
|
|
||||||
# Tells whether an absolute path leads to a directory on hard disk
|
|
||||||
#
|
|
||||||
proc localfs_filetype {path_in} {
|
|
||||||
set path [unescape_string $path_in]
|
|
||||||
catch {file lstat $path stbuf}
|
|
||||||
if {[info exists stbuf] == 1} {
|
|
||||||
set t [string range $stbuf(type) 0 0]
|
|
||||||
if {[string first $t "bcdls"] != -1} {return $t}
|
|
||||||
if {$stbuf(type) == "file"} {return "-"}
|
|
||||||
if {$stbuf(type) == "fifo"} {return "p"}
|
|
||||||
return "?"
|
|
||||||
}
|
|
||||||
return ""
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# <<< $localfs_filetype_by_tcl == 1
|
|
||||||
}
|
|
||||||
if {$localfs_ls_by_sh == 1} {
|
|
||||||
|
|
||||||
|
|
||||||
# Return the list of files of a hard disk filesystem directory
|
|
||||||
#
|
|
||||||
proc localfs_ls {dir_in} {
|
|
||||||
set dir [unescape_string $dir_in]
|
|
||||||
set result ""
|
|
||||||
if {[localfs_filetype $dir] != "d"} {return ""}
|
|
||||||
set conn [open "|ls -1b [list $dir]" r]
|
|
||||||
while {1} {
|
|
||||||
set ret [gets $conn line]
|
|
||||||
if {$ret == -1} {
|
|
||||||
break
|
|
||||||
}
|
|
||||||
# ls -b has the habit to escape blanks, xorriso has not.
|
|
||||||
set line [string map [list "\\\\" "\\\\" "\\ " " "] $line]
|
|
||||||
set adr [combine_dir_and_name $dir $line]
|
|
||||||
set filetype [localfs_filetype $adr]
|
|
||||||
if {$filetype == ""} {set filetype "?"}
|
|
||||||
lappend result "$filetype $line"
|
|
||||||
}
|
|
||||||
catch {close $conn}
|
|
||||||
return $result
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# <<< $localfs_ls_by_sh == 1
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# Log a command (if enabled)
|
# Log a command (if enabled)
|
||||||
#
|
#
|
||||||
proc log_command {cmd} {
|
proc log_command {cmd} {
|
||||||
@ -5794,26 +5727,6 @@ proc escape_newline {text backslash_too} {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
if {$localfs_ls_by_sh == 1 || $localfs_filetype_by_tcl == 1} {
|
|
||||||
|
|
||||||
|
|
||||||
proc unescape_string {text} {
|
|
||||||
# The Tcl backslash escaping nearly matches the one of xorriso.
|
|
||||||
# Only code \e is not known to Tcl.
|
|
||||||
# So protect \\e from being converted, convert \e, and escape $[{" (not }])
|
|
||||||
set escpd [string map [list "\\\\" "\\\\" "\\e" "\x1b" "\$" "\\\$" \
|
|
||||||
"\[" "\\\[" "\{" "\\\{" "\"" "\\\""] \
|
|
||||||
$text]
|
|
||||||
# And now let Tcl unescape it
|
|
||||||
eval set escpd \"$escpd\"
|
|
||||||
return $escpd
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# <<< $localfs_ls_by_sh == 1 || $localfs_filetype_by_tcl == 1
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
# -------- start living
|
# -------- start living
|
||||||
|
|
||||||
|
|
||||||
|
@ -1 +1 @@
|
|||||||
#define Xorriso_timestamP "2013.01.06.095957"
|
#define Xorriso_timestamP "2013.01.06.100954"
|
||||||
|
Loading…
Reference in New Issue
Block a user