See also  edit

Functional programming

aspect's TIP#288 parser module in tcl-hacks

Uses this construct to generate code for parsing $args. One useful property of cmdpipe style for this task is that no extraneous variables are created, and the whole expression can be inlined in the function.

ycl sugar cmdpipe

pipe2 uses a list-based syntax, where each component of the pipline is composed of two lists, and the piped output is concatenated between the. Example: `|

pipethread

Multithreaded pipes with each consumer/producer running in its own thread, similar to how pipes work in Unix shells.

Implementations  edit

iu2's implementation

line1 1 2 3 4 5 end-code1-line
line2 2 2 3 4 5 end-code2-line
line3 3 2 3 4 5 end-code3-line
line4 4 2 3 4 5 end-code4-line
line5 5 2 3 4 5 end-code5-line

file("lines.txt", "r").read()

read [open lines.txt r]

code = file('lines.txt').read().strip().splitlines()[-1].split()[-1].split('-')[1]
print code

code5

# Commands Pipe
proc compi {sep {fns ""} {var ""}} {
    # parse arguments
    if {$var ne ""} {        ;# all three arguments supplied
        foreach {s p} [split $sep ""] {break}
    } elseif {$fns eq ""} {        ;# one argumens supplied
        set s |; set p ~; set fns $sep
    } else {        ;# two arguments supplied
        if {[string length $sep] == 2} {        ;# first argument is separators
            foreach {s p} [split $sep ""] {break}
        } else {        ;# sep is fns and fns is var
            set var $fns; set fns $sep; set s |; set p ~
        }
    }

    # create a valid tcl command
    set commands [split $fns $s]
    set cmd [set curcmd [lindex $commands end]]
    if {[string first $p $curcmd] < 0} {append cmd $p}
    for {set i [expr {[llength $commands] - 2}]}  {$i >= 0} {incr i -1} {
        set curcmd [lindex $commands $i]
        if {[string first $p $curcmd] < 0 && $i > 0} {append curcmd $p}
        set cmd [string map "$p { \[$curcmd\] }" $cmd]
    }

    # perform command
    if {$var eq ""} {return [uplevel 1 $cmd]} else {uplevel 1 [list set $var $cmd]}
}

compi ?sp? commands-pipe ?var?

compi {open lines.txt r|read|string trim|split~\n|lindex~end|lindex~end|split~-|lindex~1|set code}
puts $code

code5

compi ,` {open lines.txt r,read,string trim,split`\n,lindex`end,lindex`end,split`-,lindex`1,set code}
puts $code

compi {open lines.txt r|read|string trim|split~\n|lindex~end|lindex~end|split~-|lindex~1|set code|puts} pipe1

puts $pipe1

puts [set code [lindex [split [lindex [lindex [split [string trim [read [open lines.txt r] ] ] \n] end] end] -] 1] ]

eval $pipe1

code5

compi {open lines.txt r|read|string length|puts}

155

print len(file('lines.txt').read())

file('lines.txt').read().len().print()

{open lines.txt r} {read} {string trim} {split~\n} {lindex~end} {lindex~end} {split~-} {lindex~1} {set code} {puts}

dbohdan's implementation

interactive programming

package require textutil

# Run command pipelines.
proc |> {args} {
    if {[llength $args] == 0} {
        # Print help
        puts {
Command pipelines for interactive programming.

usage:
    |> cmd1 |> cmd2 _ |> cmd3 #0 ?-debug?
or
    |> { cmd1 |> cmd2 $_ |> cmd3 $pipe(0) } ?-debug?

See http://wiki.tcl.tk/17419 for more.}
        # End help
        return
    }

    set splitOn {\|>}
    set output {}
    set i 0
    set debug 0
    # Syntax 1: |> a |> b _ |> c _ |> d #0
    # Syntax 2: |> { a |> b $_ |> c $_ |> d $pipe(0) }
    set syntax 1

    # Options.
    switch -exact -- [lindex $args end] {
        -debug {
            set debug 1
            set args [lrange $args 0 end-1]
        }
    }

    if {[llength $args] == 1} {
        # The |> { ... } syntax was used.
        set args [lindex $args 0]
        set syntax 2
        upvar 1 _ _
    }

    set commands [::textutil::split::splitx $args $splitOn]

    foreach cmd $commands {
        switch -exact -- $syntax {
            1 {
                set cmd [regsub {#([0-9]+)} $cmd {$pipe(\1)}]
                set cmd [string map [list _ [list $output]] $cmd]
            }
            2 {
                set _ $output
            }
            default {
                puts "error: syntax $syntax"
                return
            }
        }

        set output [uplevel 1 $cmd];
        upvar 1 pipe($i) currentResult
        set currentResult $output
        if {$debug} {
            puts [
                format "%s -- %s -- %s" \
                       #$i \
                       [string replace $cmd 120 end {...}] \
                       [string replace $output 120 end {...}]
            ]
        }
        incr i
    }

    return $output
}

Invocation

|> cmd1 |> cmd2 _ |> cmd3 #0 ?-debug?

|> { cmd1 |> cmd2 $_ |> cmd3 $pipe(0) } ?-debug?

% cd /home
% set a 1
% |> cd .. |> set a 2 |> puts "$a [pwd]"
1 /home

% cd /home
% set a 1
% |> { cd .. |> set a 2 |> puts "$a [pwd]" }
2 /

Examples and discussion

# Print the size of all files in megabytes.
% |> fileutil::find |> struct::list mapfor x _ { file size $x } |> struct::list fold _ 0 tcl::mathop::+ |> hformat _
0.54 MB>

% |> { fileutil::find |> struct::list mapfor x $_ { file size $x } |> struct::list fold $_ 0 tcl::mathop::+ |> hformat $_ }
0.54 MB

# Find out file size.
% proc file-size {fn} { |> open $fn r |> read _ |> string length _ |> close #0 |> return #2 }
% file-size eltclshrc
13659
# The same using quoted commands.
% proc file-size {fn} { |> { open $fn r |> read $_ |> string length $_ |> close $pipe(0) |> return $pipe(2) }}
% file-size eltclshrc
13659

See also

Starwer's implementation

proc | {args} { upvar 1 _ _ ; return [set _ [uplevel 1 $args]] }

| open lines.txt r ;| read $_ ;| string trim $_ ;| split $_ \n ;| lindex $_ end ;| lindex $_ end ;| split $_ - ;| lindex $_ 1 ;| set code $_

# normal operations
| cmd1 ;| cmd2 $_ ;| cmd3 $_ args

# file/list operations
< source.txt ;| grep "hello" ;| map {regsub {goodbye} $_ {hello} _} ;> destination.txt

# string operations (regular expressions and substitutions, Perl style...)
|< "Bye World" ;|s bye Hello i ;|~ {^(\w*)\s+(\w+)} ;|< "this says '$1' to '$2'" ;|> destvar

# Numeric operations
|$ 1+2 ;| incr _ ;|> var1 ;|& |< "$var1 different from 0";|| |< "$var1 equal 0"

proc | {args} {
    if {[llength $args] == 0} {
        # Print help
        puts {Unix-style file redirection and pipelining commands for interactive programming.

usage:
    # normal operations
    | cmd1 ;| cmd2 $_ ;| cmd3 $_ args

    # file/list operations
    < source.txt ;| grep "hello" | map {regsub {goodbye} $_ {hello} _} ;> destination.txt

    # string operations
    |< "Bye World" ;|s bye Hello i ;|~ {^(\w*)\s+(\w+)} ;|< "this says '$1' to '$2'" ;|> destvar

    # Numeric operations
    |$ 1+2 ;| incr _ ;|> var1 ;|& |< "different from 0";|| |< "equal 0"

See http://wiki.tcl.tk/17419 for more.}
        # End help
        return
    }

    upvar 1 _ _
    return [set _ [uplevel 1 $args]]
}


proc < {{file ""}} {
    if {[string length $file] == 0} {
        puts {store the content of a file in $_ as a list of its lines.}
        |
        return
    }

    upvar 1 _ _
    set fp [open $file r]
    set _ [split [read $fp] "\n"]
    close $fp

    return $_
}

proc > {{file ""}} {
    if {[string length $file] == 0} {
        puts {Save the list $_ to a file.}
        |
        return
    }
    upvar 1 _ _

    set fileId [open $file w]
    puts -nonewline $fileId [join $_ "\n"]
    close $fileId

    return $_
}

proc >> {{file ""}} {
    if {[string length $file] == 0} {
        puts {Append the list $_ in a file.}
        |
        return
    }

    upvar 1 _ _
    set fileId [open $file w+]
    puts -nonewline $fileId [join $_ "\n"]
    close $fileId

    return $_
}


proc grep {args} {
    if {[llength $args] == 0} {
        puts {grep ?list? expr
    From the list given in argument list (default: $_), keep indices matching the regular expression expr.
        }
        |
        return
    }
    if {[llength $args] > 2} { error "bad number of arguments: grep ?list? regexp"}
    if {[llength $args] == 1} {
        set re [lindex $args 0]
        upvar 1 _ _
    } else {
        set re [lindex $args 1]
        set _ [lindex $args 0]
    }

    foreach line $_ {
        if {[regexp $re $line]} {
            lappend ret $line
        }
    }

    return $ret
}


proc map {args} {
    if {[llength $args] == 0} {
        puts {map ?list? command
    From the list given in argument list (default: $_), apply the command given to every index.
    The value of the index is in $_
        }
        |
        return
    }
    if {[llength $args] > 2} { error "bad number of arguments: map ?list? function"}
    if {[llength $args] == 1} {
        set func [lindex $args 0]
        upvar 1 _ _
        set lines $_
    } else {
        set func [lindex $args 1]
        set lines [lindex $args 0]
    }

    foreach _ $lines  {
        lappend ret [uplevel 1 $func]
    }

    return $ret
}


proc |< {args} {
    if {[llength $args] == 0} {
        puts {Store the arguments to variable $_}
        |
        return
    }
    upvar 1 _ _
    if {[llength $args] == 1} { return [set _ [lindex $args 0]] }
    return [set _ $args]
}

proc |> {{var ""}} {
    if {[string length $var] == 0} {
        puts {Copy the content of variable $_ to the given variable.}
        |
        return
    }
    upvar 1 _ _
    return [set $var $_]
}

proc |$ {args} {
    if {[llength $args] == 0} {
        puts {Evaluate the expression given as arguments (expr) and store the result in $_}
        |
        return
    }
    upvar 1 _ _
    return [set _ [uplevel 1 "expr $args"]]
}

proc |& {args} {
    if {[llength $args] == 0} {
        puts {Execute the command in arguments if the content of $_ is a non-empty string and,
if it is a number, different from 0. If the command is executed, its result goes to $_}
        |
        return
    }
    upvar 1 _ _
    if {[string length $_]>0 && (![string is double $_] || $_!=0) } {
        set _ [uplevel 1 $args]
    }
    return $_
}

proc || {args} {
    if {[llength $args] == 0} {
        puts {Execute the command in arguments if the content of $_ is an empty string or
if it is a number equal to 0. If the command is executed, its result goes to $_}
        |
        return
    }
    upvar 1 _ _
    if {[string length $_]==0 || ([string is double $_] && $_==0) } {
        set _ [uplevel 1 $args]
    }
    return $_
}


proc |~ {{re ""} {opts ""}} {
    if {[string length $re] == 0} {
        puts {|~ expr ?options?
    Apply the regular expression expr to $_
    options is a string which can contain i (case-insensitive) and/or m (multi-line match).}
        |
        return
    }

    lappend lopts
    if {![regexp -expanded {[img]*} $opts]} {
        error "bad option for |~ : $opts"
    }
    if {[string match *i* $opts]} { lappend lopts -nocase }
    if {[string match *m* $opts]} { lappend lopts -line }

    upvar 1 _ _
    upvar 1 0 0
    if { ! [uplevel 1 "regexp -expanded $lopts {$re} \$_ 0 1 2 3 4 5 6 7 8 9"] } {
        for {set i 0} {$i<10} {incr i} { uplevel 1 "set $i \"\"" }
    }
    return [set _ $0]
}

proc |s {{re ""} {subs ""} {opts ""}} {
    if {[string length $re] == 0} {
        puts {|s expr subst ?options?
    Apply the regular expression expr to $_ and replace with subst.
    options is a string which can contain i (case-insensitive), m (multi-line match)
    and/or g (global, replace every occurrence).}
        |
        return
    }

    lappend lopts
    if {![regexp -expanded {[img]*} $opts]} {
        error "bad option for |~ : $opts"
    }
    if {[string match *i* $opts]} { lappend lopts -nocase }
    if {[string match *m* $opts]} { lappend lopts -line }
    if {[string match *g* $opts]} { lappend lopts -all }

    upvar 1 _ _
    if { ! [uplevel 1 "regsub -expanded $lopts {$re} \$_ {$subs} _"] } {
        set _ ""
    }
    return $_
}

Roy Keene's implementation

proc pipe args {
    set input [list]

    while 1 {
        set end [lsearch -exact $args "|"]

        if {$end == -1} {
            set end "end"
            set part [lrange $args 0 end]
        } else {
            set part [lrange $args 0 [expr {$end - 1}]]
        }

        set part [string trim $part]

        set mode list
        if {[string index $part 0] == "{" && [string index $part end] == "}"} {
            set part [lindex $part 0]
            set mode "string"
        }

        switch -- $mode {
            list {
                foreach idx [lsearch -all -exact $part @@INPUT@@] {
                    set part [lreplace $part $idx $idx $input]
                }
            }
            string {
                set part [string map [list @@INPUT@@ [list $input]] $part]
            }
        }

        set input [uplevel $part]

        if {$end eq "end"} {
            break
        }

        set args [lrange $args [expr {$end+1}] end]
    }

    return $input
}

proc procA {} {
    return [list a b c]
}

proc procB {input} {
    return [lreverse $input]
}

set something [list joe bob]

puts [pipe procA | procB @@INPUT@@ | { set x [list]; foreach blah @@INPUT@@ { lappend x $blah.1 }; return $x } ]

c.1 b.1 a.1

proc pipe args {
    set cmd {}
    set newparam {}
    set run 0
    while {[llength $args]} {
        set args [lassign $args[set args {}] arg]
        if {[string match |* $arg]} {
            set run 1
            if {[string length $arg] > 1} {
                set newparam [string range $arg 1 end]
            }
        } else {
            lappend cmd $arg
        }
        if {$run || [llength $args] == 0} {
            if {$cmd eq {}} {
                return -code error [list {empty command} $cmd]
            }
            if {[info exists result]} {
                set cmd [join $cmd[set cmd {}]]
                set cmd [string map [list $param [list $result]] $cmd]
            }
            set result [uplevel $cmd]
            if {$newparam eq {}} {
                set param @@INPUT@@
            } else {
                set param $newparam
            }
            set cmd {}
            set run 0
        }
    }
    return $result
}

puts [pipe procA | procB @@INPUT@@ |@param@ { set x [list]; foreach blah @param@ { lappend x $blah.1 }; return $x } ]

A list-based command pipe  edit

proc | args {
        set args [lassign $args[set args {}] first]
        set result [uplevel 1 $first]
        foreach arg $args {
                lassign $arg one three
                set result [uplevel 1 $one [list $result] $three]
        }
        return $result
}

puts [| {
        lindex {Hello, plato}
} {
        split , 
} {
        lindex end
} {
        {string trim}
} {
        {string totitle}
}]

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References