From: Matt S Trout <mst@shadowcat.co.uk>
Date: Tue, 18 Feb 2014 15:57:28 +0000 (+0000)
Subject: ghetto copy working - see body of commit message
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=97c0c46e84692374cb6aacede35707e09903c1b7;p=scpubgit%2FDKit.git

ghetto copy working - see body of commit message

rule ghetto_copy {FromFileName ToFileName} {
  exists {F T} {
    file_at F FromFileName
    file_at T ToFileName
    foreach L { contains_line F L } { contains_line T L }
  }
}

$ query {} {ghetto_copy 'from' 'to'}

^^ this actually works. I think I am afraid.
---

diff --git a/bin/dx-shell b/bin/dx-shell
index 5a61588..572c9d2 100644
--- a/bin/dx-shell
+++ b/bin/dx-shell
@@ -35,9 +35,14 @@ sub do_query {
 sub expand_def {
   my ($vars, $body) = @_;
   my @varnames = $split->($vars);
+  return (\@varnames, expand_body($body));
+}
+
+sub expand_body {
+  my ($body) = @_;
   local our @Body_Parts;
   $tcl->Eval($body);
-  return (\@varnames, @Body_Parts);
+  return @Body_Parts;
 }
 
 $tcl->CreateCommand(query => sub {
@@ -85,6 +90,14 @@ $tcl->CreateCommand(exists => sub {
   push our @Body_Parts, [ exists => expand_def($vars, $body) ];
   return;
 });
+
+$tcl->CreateCommand(foreach => sub {
+  my (undef, undef, undef, $var, $body, $each_body) = @_;
+  push our @Body_Parts, [
+    foreach => $var => map [ expand_body($_) ], $body, $each_body
+  ];
+  return;
+});
   
 #$tcl->Eval(q{query D {directory_at D 't'; mode D '0755'; }});