my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`:

my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`;
[download]

my $object=test_element;

my $object = 'test_element';
[download]

• Show the exact errors messages you get.
• Show us a few lines of useful_dat.tab

    my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`:
    foreach (@a){
        my @b=split(/\t/,$_);
        if($b[1] eq 'Activation'){
[download]

You don't chomp the lines from useful_dat.tab so "Activation\n" will never be equal to 'Activation'.

You should probably store the contents of useful_dat.tab in a hash instead of using an external process to read the same file multiple times.

object_1    object_2   active
object_2    object_3   active
[download]

You need to first identify which of the two columns (1 or 2) represents the parent in the relationship. Next, you need to identify the root(s), and build the tree in memory (assuming the file will fit in memory). Once you have done that, you just need to find the node you want to deactivate and walk the tree below that point deactivating all attached nodes.

Thanks monks, I think I have a piece of working code. I still get a few errors, but I think it is from inconsistencies in the datafile. I will post the final code below, and if someone finds more errors I will check back periodically.

#!/usr/bin/perl
use strict;
use warnings;

# prints out inhibited object, directly activated ohjects, directly de
+activated objects, indirectly activated objects, indirectly deacivate
+d objects
print "Modified Object\tActivated Objects\tDeactivated Objects\n";
open(DAT,'<',"./useful_dat.tab")||die "Canot open file\n";
my @file=<DAT>;
close DAT;
shift @file;##remove header
    my @activated;
    my @inhibited;

my %true;
foreach my $line(@file){
    my @line=split(/\t/,$line);
    if($true{$line[0]}){
        next;#if element has already come up, skip it
    }
    else{
        $true{$line[0]}=1;#if object has already come up, store true
    }
    print "$line[0]\t";#inhibited object
    &inhibited_rec($line[0]);    


    foreach(@activated){
        print "$_,";
    }
    print "\t";
    foreach(@inhibited){
        print "$_,";
    }
    print "\n";
}


sub inhibited_rec{
    my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`;
    foreach (@a){
        my @b=split(/\t/,$_);
        chomp $b[1];
        if($b[1] eq 'Activation'){
        }
        else{
            push (@activated,$b[0]);
            if($true{$b[0]}){
                next;
            }
            else{
                $true{$b[0]}=1;
                &activated_rec($b[0]);
            }
        }
    }
}
sub activated_rec{
    my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`;
    foreach (@a){
        my @b=split(/\t/,$_);
        chomp $b[1];
        if($b[1] eq 'Activation'){
            push (@activated,$b[0]);
            if($true{$b[0]}){
                next;
            }
            else{
                $true{$b[0]}=1;
                &activated_rec($b[0]);
            }
        }
        else{
            push (@inhibited,$b[0]);    
            if($true{$b[0]}){
                next;
            }
            else{
                $true{$b[0]}=1;
                &inhibited_rec($b[0]);
            }
        }
    }
}
[download]

Yes, this is a tab delimited version of a tree. However, the tree is, at some points, circular. So object A might activate object A.

I am sorry if I did not include enough of the code, I was trying to make it simpler. Yes the line my $object=test_element; should read my $object='test_element';

The errors are as follows:

"my" variable @b masks earlier declaration in same scope at interact_p
+erturb.pl line 56.
"my" variable @b masks earlier declaration in same scope at interact_p
+erturb.pl line 60.
Global symbol "@activated" requires explicit package name at interact_
+perturb.pl line 45.
syntax error at interact_perturb.pl line 51, near "`awk '\$1 ~ /$_[0]/
+' useful_dat.tab |cut -f 2,3|sort|uniq`:"
Global symbol "@a" requires explicit package name at interact_perturb.
+pl line 52.
Missing right curly or square bracket at interact_perturb.pl line 64, 
+at end of line
Execution of interact_perturb.pl aborted due to compilation errors.
[download]

Perhaps it would be better to include the actual version of the code I am using. I apologize if it is difficult to read. Thanks for your help

#!/usr/bin/perl
use strict;
use warnings;

# prints out inhibited object, directly activated ohjects, directly de
+activated objects, indirectly activated objects, indirectly deacivate
+d objects
print "Modified Object\tActivated Objects\tDeactivated Objects\n";
open(DAT,'<',"./useful_dat.tab")||die "Canot open file\n";
my @file=<DAT>;
close DAT;
shift @file;##remove header

my %true;
foreach my $line(@file){
    my @line=split(/\t/,$line);
    if($true{$line[0]}){
        next;#if element has already come up, skip it
    }
    else{
        $true{$line[0]}=1;#if object has already come up, store true
    }
    my @activated;
    my @inhibited;
    print "$line[0]\t";#inhibited object
    &inhibited_rec($line[0]);    


    foreach(@activated){
        print "$_,";
    }
    print "\t";
    foreach(@inhibited){
        print "$_,";
    }
    print "\n";
}


sub inhibited_rec{
    my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`;
    foreach (@a){
        my @b=split(/\t/,$_);
        if($b[1] eq 'Activation'){
        }
        else{
            push (@activated,$b[0]);
            &activated_rec($b[0]);
        }
    }
}
sub activated_rec{
    my @a=`awk '\$1 ~ /$_[0]/' useful_dat.tab |cut -f 2,3|sort|uniq`:
    foreach (@a){
        my @b=split(/\t/,$_);
        if($b[1] eq 'Activation'){
            push (@activated,$b[0]);
            &activated_rec($b[0]);
        }
        else{
            push (@inhibited,$b[0]);
            &inhibited_rec($b[0]);
        }
    }
[download]

Change the colon to a semicolon, like I already told you. That will get rid some of the compile errors. Moving these out of the foreach will get rid of the other compile errors:

    my @activated;
    my @inhibited;
[download]

Sorry I did not see that. Thank you.

First thing I noticed: there's no need to slurp the entire file into an array if you're going to loop through it line-by-line anyway, so this:

open(DAT,'<',"./useful_dat.tab")||die "Canot open file\n";
my @file=<DAT>;
close DAT;
shift @file;##remove header
foreach my $line(@file){
[download]

would be better:

open(DAT,'<',"./useful_dat.tab")||die "Canot open file\n";
<DAT>;                     # discard a line
while(my $line = <DAT>){   #loop through the rest
[download]

As for the rest: Ok, you're looping through the file, and for each line, you call inhibited_rec(), which calls awk to loop through the same file again, looking for a match on the first fields, then for each line, if the second field isn't 'Activation', you call activated_rec() which uses awk to loop through the same file again, perhaps recursively..... Ouch. It seems to me you could end up running your file through that pipeline at least as many times as the number of lines in the file squared, if not cubed or more.

Loop through the file once, and save the data into a structure that'll allow you to compare fields as you like. Perhaps an array of arrays, or a hash of hashes, or whatever makes sense for your data. If necessary, make a couple copies of it in different variables, so you can compare them to each other to find your circular connections (maybe not necessary, but might make it easier to understand what you're doing).

You are absolutely correct. In fact, an array of arrays was exactly how I started. However, since the size of the file is not large (and my computer is really awesome), the additional time required to code such a data structure would not be worth it, at least for someone who codes on the side like me. Yes, I coped out, I admit it. :-)