[Bio] / FigKernelPackages / SeedUtils.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/SeedUtils.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.37, Wed Jun 9 20:14:26 2010 UTC revision 1.38, Wed Jun 16 20:21:50 2010 UTC
# Line 20  Line 20 
20  #  #
21    
22  package SeedUtils;  package SeedUtils;
23    use BerkTable;
24    use DB_File;
25    
26  #  #
27  # In case we are running in a SEED, pull in the FIG_Config  # In case we are running in a SEED, pull in the FIG_Config
# Line 1559  Line 1561 
1561      }      }
1562  }  }
1563    
1564    #
1565    # Some berkeley-db building utilities.
1566    #
1567    
1568    sub create_berk_table
1569    {
1570        my($input_file, $key_columns, $value_columns, $db_file, %opts) = @_;
1571    
1572        local $DB_BTREE->{flags};
1573        if ($opts{-multiple_values})
1574        {
1575            $DB_BTREE->{flags} = R_DUP;
1576        }
1577    
1578        my $ifh;
1579    
1580        if ($opts{-sort})
1581        {
1582            my $sk = join(" ", map { "-k " . ($_ + 1) } @$key_columns);
1583            my $cmd = "sort $sk $input_file";
1584            print "Run $cmd\n";
1585    
1586            open($ifh, "$cmd |") or die "Cannot open sort $sk $input_file for reading: $!";
1587        }
1588        else
1589        {
1590            open($ifh, "<", $input_file) or die "Cannot open $input_file for reading: $!";
1591        }
1592    
1593        my $hash = {};
1594        my $tie = tie %$hash, "DB_File", $db_file, O_RDWR | O_CREAT, 0666, $DB_BTREE;
1595        $tie or die "Cannot create $db_file: $!";
1596    
1597        while (<$ifh>)
1598        {
1599            chomp;
1600            my @a = split(/\t/);
1601            my $k = join($;, @a[@$key_columns]);
1602            my $v = join($;, @a[@$value_columns]);
1603    
1604            $hash->{$k} = $v;
1605        }
1606        close($ifh);
1607        undef $hash;
1608        untie $tie;
1609    }
1610    
1611    sub open_berk_table
1612    {
1613        my($table, %opts) = @_;
1614    
1615        if (! -f $table)
1616        {
1617            warn "Cannot read table file $table\n";
1618            return undef;
1619        }
1620        my $h = {};
1621        tie %$h, 'BerkTable', $table, %opts;
1622        return $h;
1623    }
1624    
1625  1;  1;

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3