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                 }
  51                 elsif (/^UNCLUSTERED ENTITIES$/) {
  52                         my (@labels) = map { chomp; $_ } <$fh>;
  53                         $self->add_unclustered(@labels);
  54                 }
  55         }
  56 }
  57
  58 =head $oc->add_group($number, $score, $size, @labels)
  59
  60 Add information about a group.
  61
  62 =cut
  63
  64 sub add_group {
  65         my ($self, $num, $score, $size, @labels) = @_;
  66
  67         for (qw(num score size)) {
  68                 croak "No value for $_ passed to add_group" unless eval "defined \$$_"
  69         }
  70
  71         croak "No labels passed to add_group" unless @labels;
  72
  73         $self->{__PACKAGE__."score"}{$num} = $score;
  74         $self->{__PACKAGE__."size"}{$num} = $size;
  75         $self->{__PACKAGE__."labels"}{$num} = [ @labels ];
  76 }
  77
  78 =head2 $oc->add_unclustered(@labels)
  79
  80 Adds those entities that are unclustered.
  81
  82 =cut
  83
  84 sub add_unclustered {
  85         my ($self, @labels) = @_;
  86         $self->{__PACKAGE__."unclust"} = \@labels;
  87 }
  88
  89 =head2 $oc->get_unclustered
  90
  91 Returns those unclustered entities as a list.
  92
  93 =cut
  94
  95 sub get_unclustered {
  96         my ($self) = @_;
  97         return @{$self->{__PACKAGE__."unclust"}} if defined $self->{__PACKAGE__."unclust"};
  98 }
  99
 100 =head2 ($score, $size, @labels) = $oc->get_group($n);
 101
 102 Returns information about a particular group. If the group doesn't exist you get a warning message and undef.
 103
 104 =cut
 105
 106 sub get_group {
 107         my ($self, $num) = @_;
 108         if (defined $num) {
 109                 if (exists $self->{__PACKAGE__."score"}{$num}) {
 110                         return
 111                                 $self->{__PACKAGE__."score"}{$num},
 112                                 $self->{__PACKAGE__."size"}{$num},
 113                                 @{ $self->{__PACKAGE__."labels"}{$num} };
 114                 }
 115                 else {
 116                         carp "No such group '$num'";
 117                         return undef;
 118                 }
 119         }
 120         else {
 121                 croak "No value passed to get_group";
 122         }
 123 }
 124
 125 =head1 @info = $oc->get_groups;
 126
 127 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.
 128
 129 =cut
 130
 131 sub get_groups {
 132         my ($self) = @_;
 133
 134         map {
 135                 [ $_, $self->get_group($_) ]
 136         } sort keys %{ $self->{__PACKAGE__."score"} };
 137 }
 138
 139 =head1 $oc->run();
 140
 141 =cut
 142
 143 sub run {
 144         my ($self, $file) = @_;
 145
 146         local $/ = undef;
 147         local $| = 1;
 148
 149         my $pid = open3(\*WRT, \*RD, \*ERR, $self->path);
 150
 151         print WRT $file;
 152         close WRT;
 153
 154         my @output = join "\n", split "\n", <RD>;
 155         close RD;
 156
 157         waitpid $pid, 0;
 158         check($self->path, $?) or die "OC was naughty";
 159
 160         return @output;
 161 }
 162
 163 1;