File Coverage

blib/lib/BioX/SeqUtils/Promoter/Annotations/Consensus.pm

Criterion	Covered	Total	%
statement	3	3	100.0
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	4	4	100.0

package BioX::SeqUtils::Promoter::Annotations::Consensus;
####################################################################
#	               Charles Stephen Embry			   #
#	            MidSouth Bioinformatics Center		   #
#	        University of Arkansas Little Rock	           #
####################################################################
use base qw(BioX::SeqUtils::Promoter::Annotations::Base);
use Class::Std;
use Class::Std::Utils;

use BioX::SeqUtils::Promoter::Sequence;
use BioX::SeqUtils::Promoter::Sequences;
use DBIx::MySperql qw(DBConnect SQLExec $dbh);
use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.1.1');

{
        my %motifs_of  :ATTR( :get   :set   :default<[]>    :init_arg );

        sub BUILD {
                my ($self, $ident, $arg_ref) = @_;

                return;
        }

        sub START {
                my ($self, $ident, $arg_ref) = @_;

                return;
        }
        sub print_motifs {
                my ($self, $arg_ref) = @_;
		my $motifs = $self->get_motifs();
		print join(', ', @$motifs ), "\n";
                return;
        }

	sub set_reg {
		my ($self, $arg_ref) = @_;
		#takes a Sequences object as a parameter
		my $bases = defined $arg_ref->{bases} ?  $arg_ref->{bases} : '';
		my $num = 0;
		my $database = 'stephen';
		my $host     = 'localhost';
		my $user     = 'root';
		my $pass     = '2020.mbc';
		my @sequences = $bases->get_objects();
		my $id_seq;

		foreach my $seqobj(@sequences) {

			my $DNA = $seqobj->get_sequence();
			my $test     = $DNA;
			my $label = $sequences[$num]->get_label();
			#print "$label\n";
			my $seqlength = $self->length({ string => $sequences[$num]->get_sequence( label => $label) });
			#print "$seqlength\n";
			$num++;

			#my $colors = $seqobj->get_color_list();
			my $colors;

			#print "$colors->[0]\n";

			#my $base = $seqobj->get_base_list();
			my $base;

			#create a default list of colors the correct length and a list of ascending numberical value
			for(my $k =0; $k <= $seqlength; $k++){
				$base->[$k] = $k;
				$colors->[$k] = 'black';
			}


			$id_seq .= "$label\n";

			#connect to MySql database
			$dbh = DBConnect(database => $database, host => $host, user => $user, pass => $pass);

			my $sql = "select consensus_id, consensus_name, motif, length, color from consensus";
			my $rowsref = SQLExec( $sql, '\@@' );
			foreach my $rowref ( @$rowsref ) {
				my ( $id, $name, $motif, $length, $color ) = @$rowref;
				my $pattern = "(.*)($motif)";
				my $position;
				my $first = 1;
				#match database sequences against user data
				while ( $test =~ m/(.*?)$motif/g ) {
					if ( $first ) {
						 $position = scalar( split( '', $1 ) ) + 1;
					} else {
						 $position += scalar( split( '', $1 ) ) + $length;
					}

					#print "$id, $name, $motif, $position, $length, $color \n";
					$id_seq .= "$id, $name, $motif, $position, $length, $color \n";
					$first = 0;
					for (my $i = 0 ; $i <= $length - 1; $i++ ) {

						$colors->[$position -1 + $i] = $color;
					}
				#print "test space\n";
				#$bases->set_color({bases => $base, colors => $colors, label => $label});

				}

			}

				$bases->set_color({bases => $base, colors => $colors, label => $label});
		}

		open (MYFILE, '>out_consensus');
		#write a file that list in which sequence object matches where found
	        print MYFILE $id_seq;
	        close (MYFILE);

		return;
        }

}

1; # Magic true value required at end of module
__END__