view release on metacpan or  search on metacpan

Ace/Object.pm  view on Meta::CPAN

### Return the pretty-printed HTML table representation ###
### may pass a code reference to add additional formatting to cells ###
sub asHTML {
    my $self = shift;
    my ($modify_code) = rearrange(['MODIFY'],@_);
    return unless defined($self->right);
    my $string = "<TABLE BORDER>\n<TR ALIGN=LEFT VALIGN=TOP><TH>$self</TH>";
    $modify_code = \&_default_makeHTML unless $modify_code;
    $self->right->_asHTML(\$string,1,2,$modify_code);
    $string .= "</TR>\n</TABLE>\n";
    return $string;
}

### Get the FASTA-format DNA/Peptide representation for this object ###
### (if appropriate) ###
sub asDNA {
  return shift()->_special_dump('dna');
}

sub asPeptide {
  return shift()->_special_dump('peptide');
}

sub _special_dump {
  my $self = shift;
  my $dump_format = shift;
  return unless $self->db->count($self->class,$self->name);
  my $result = $self->db->raw_query($dump_format);
  $result =~ s!^//.*!!ms;
  $result;
}

#### As tab-delimited table ####
sub asTable {
    my $self = shift;
    my $string = "$self\t";
    my $right = $self->right;
    $right->_asTable(\$string,1,2) if defined($right);
    return $string . "\n";
}

#### In "ace" format ####
sub asAce {
  my $self = shift;
  my $string = $self->isRoot ? join(' ',$self->class,':',$self->escape) . "\n" : '';
  $self->right->_asAce(\$string,0,[]);
  return "$string\n\n";
}

### Pretty-printed version ###
sub asString {
  my $self = shift;
  my $MAXWIDTH = shift || $DEFAULT_WIDTH;
  my $tabs = $self->asTable;
  return "$self" unless $tabs;
  my(@lines) = split("\n",$tabs);
  my($result,@max);
  foreach (@lines) {
    my(@fields) = split("\t");
    for (my $i=0;$i<@fields;$i++) {
      $max[$i] = length($fields[$i]) if
	!defined($max[$i]) or $max[$i] < length($fields[$i]);
    }
  }
  foreach (@max) { $_ = $MAXWIDTH if $_ > $MAXWIDTH; } # crunch long lines
  my $format1 = join(' ',map { "^"."<"x $max[$_] } (0..$#max)) . "\n";
  my $format2 =   ' ' . join('  ',map { "^"."<"x ($max[$_]-1) } (0..$#max)) . "~~\n";
  $^A = '';
  foreach (@lines) {
    my @data = split("\t");
    push(@data,('')x(@max-@data));
    formline ($format1,@data);
    formline ($format2,@data);
  }
  return ($result = $^A,$^A='')[0];
}

# run a series of GIF commands and return the Gif and the semi-parsed
# "boxes" structure.  Commands is typically a series of mouseclicks
# ($gif,$boxes) = $aceObject->asGif(-clicks=>[[$x1,$y1],[$x2,$y2]...],
#                                   -dimensions=>[$x,$y]);
sub asGif {
  my $self = shift;
  my ($clicks,$dimensions,$display,$view,$coords,$getcoords) = rearrange(['CLICKS',
									  ['DIMENSIONS','DIM'],
									  'DISPLAY',
									  'VIEW',
									  'COORDS',
									  'GETCOORDS',
									  ],@_);
  $display = "-D $display" if $display;
  $view    = "-view $view" if $view;
  my $c;
  if ($coords) {
    $c    =  ref($coords) ? "-coords @$coords" : "-coords $coords";
  }
  my @commands;
  if ($view || $c || $self->class =~ /Map/i) {
      @commands = "gif map \"@{[$self->name]}\" $view $c";
  } else {
      @commands = "gif display $display $view @{[$self->class]} \"@{[$self->name]}\"";
  }
  push(@commands,"Dimensions @$dimensions") if ref($dimensions);
  push(@commands,map { "mouseclick @{$_}" } @$clicks) if ref($clicks);

  if ($getcoords) { # just want the coordinates
    my ($start,$stop);
    my $data = $self->db->raw_query(join(' ; ',@commands));    
    return unless $data =~ /\"[^\"]+\" ([\d.-]+) ([\d.-]+)/;
    ($start,$stop) = ($1,$2);
    return ($start,$stop);
  }

  push(@commands,"gifdump -");

  # do the query
  my $data = $self->db->raw_query(join(' ; ',@commands));

  # A $' has been removed here to improve speed -- tim.cutts@incyte.com 2 Sep 1999

  # did this query succeed?
  my ($bytes, $trim);