binaries/src/jpred/lib/OC.pm

   1 package OC;
   2
   3 use strict;
   4 use warnings;
   5 use Carp;
   6 use IPC::Open3;
   7
   8 use base qw(Root Read Common);
   9 use Run qw(check);
  10
  11 =head1 NAME
  12
  13 OC - Read OC output
  14
  15 =head1 SYNOPSIS
  16
  17   $oc = OC->new;
  18   $oc->read_file($path);
  19
  20   $oc->get_group(1); # Returns information about cluster 1
  21   $oc->get_groups; # Returns all the groups
  22
  23 =head1 DESCRIPTION
  24
  25 This is a module to read OC output.
  26
  27 =head1 $oc->read($fh);
  28
  29 Reads an OC file from a filehandle.
  30
  31 =cut
  32
  33 sub read {
  34   my ( $self, $fh ) = @_;
  35
  36   local $/ = "\n";
  37
  38   while (<$fh>) {
  39     chomp;
  40     next if /^\s*$/;
  41
  42     if (s/^##\s*//) {
  43       my ( $num, $score, $size ) = split;
  44       my $nl = <$fh>;
  45       $nl =~ s/^\s+//;
  46       my (@labels) = map { chomp; $_ } split / /, $nl;
  47
  48       # Add to self
  49       $self->add_group( $num, $score, $size, @labels );
  50     } elsif (/^UNCLUSTERED ENTITIES$/) {
  51       my (@labels) = map { chomp; $_ } <$fh>;
  52       $self->add_unclustered(@labels);
  53     }
  54   }
  55 }
  56
  57 =head $oc->add_group($number, $score, $size, @labels)
  58
  59 Add information about a group.
  60
  61 =cut
  62
  63 sub add_group {
  64   my ( $self, $num, $score, $size, @labels ) = @_;
  65
  66   for (qw(num score size)) {
  67     croak "No value for $_ passed to add_group" unless eval "defined \$$_";
  68   }
  69
  70   croak "No labels passed to add_group" unless @labels;
  71
  72   $self->{ __PACKAGE__ . "score" }{$num}  = $score;
  73   $self->{ __PACKAGE__ . "size" }{$num}   = $size;
  74   $self->{ __PACKAGE__ . "labels" }{$num} = [@labels];
  75 }
  76
  77 =head2 $oc->add_unclustered(@labels)
  78
  79 Adds those entities that are unclustered.
  80
  81 =cut
  82
  83 sub add_unclustered {
  84   my ( $self, @labels ) = @_;
  85   $self->{ __PACKAGE__ . "unclust" } = \@labels;
  86 }
  87
  88 =head2 $oc->get_unclustered
  89
  90 Returns those unclustered entities as a list.
  91
  92 =cut
  93
  94 sub get_unclustered {
  95   my ($self) = @_;
  96   return @{ $self->{ __PACKAGE__ . "unclust" } } if defined $self->{ __PACKAGE__ . "unclust" };
  97 }
  98
  99 =head2 ($score, $size, @labels) = $oc->get_group($n);
 100
 101 Returns information about a particular group. If the group doesn't exist you get a warning message and undef.
 102
 103 =cut
 104
 105 sub get_group {
 106   my ( $self, $num ) = @_;
 107   if ( defined $num ) {
 108     if ( exists $self->{ __PACKAGE__ . "score" }{$num} ) {
 109       return
 110         $self->{ __PACKAGE__ . "score" }{$num},
 111         $self->{ __PACKAGE__ . "size" }{$num},
 112         @{ $self->{ __PACKAGE__ . "labels" }{$num} };
 113     } else {
 114       carp "No such group '$num'";
 115       return undef;
 116     }
 117   } else {
 118     croak "No value passed to get_group";
 119   }
 120 }
 121
 122 =head1 @info = $oc->get_groups;
 123
 124 Returns information about all of the groups. This is an array of arrays, the second array holds group id and then the information returned by the get_group method.
 125
 126 =cut
 127
 128 sub get_groups {
 129   my ($self) = @_;
 130
 131   map { [ $_, $self->get_group($_) ] } sort keys %{ $self->{ __PACKAGE__ . "score" } };
 132 }
 133
 134 =head1 $oc->run();
 135
 136 =cut
 137
 138 sub run {
 139   my ( $self, $file ) = @_;
 140
 141   local $/ = undef;
 142   local $| = 1;
 143
 144   my $pid = open3( \*WRT, \*RD, \*ERR, $self->path );
 145
 146   print WRT $file;
 147   close WRT;
 148
 149   my @output = join "\n", split "\n", <RD>;
 150   close RD;
 151
 152   waitpid $pid, 0;
 153   check( $self->path, $? ) or die "OC was naughty";
 154
 155   return @output;
 156 }
 157
 158 1;