- map { $_ -= $entries->[ 0 ]->{ "CHR_BEG" } } @new_q_begs;
-
- %new_entry = (
- CHR => $entries->[ 0 ]->{ "CHR" },
- CHR_BEG => $entries->[ 0 ]->{ "CHR_BEG" },
- CHR_END => $entries->[ -1 ]->{ "CHR_END" },
- REC_TYPE => "BED",
- BED_LEN => $entries->[ -1 ]->{ "CHR_END" } - $entries->[ 0 ]->{ "CHR_BEG" } + 1,
- BED_COLS => 12,
- Q_ID => join( ":", @q_ids ),
- SCORE => 999,
- STRAND => $entries->[ 0 ]->{ "STRAND" } || "+",
- THICK_BEG => $entries->[ 0 ]->{ "THICK_BEG" } || $entries->[ 0 ]->{ "CHR_BEG" },
- THICK_END => $entries->[ -1 ]->{ "THICK_END" } || $entries->[ -1 ]->{ "CHR_END" },
- ITEMRGB => "0,0,0",
- BLOCKCOUNT => scalar @new_q_begs,
- BLOCKSIZES => join( ",", @new_blocksizes ),
- Q_BEGS => join( ",", @new_q_begs ),
- );
-
- return wantarray ? %new_entry : \%new_entry;
-}
-
-
-sub bed_split_entry
-{
- # Martin A. Hansen, February 2008.
-
- # Splits a given BED entry into a list of blocks,
- # which are returned. A list of 6 column BED entry is returned.
-
- my ( $entry, # BED entry hashref
- ) = @_;
-
- # Returns a list.
-
- my ( @q_begs, @blocksizes, $block, @blocks, $i );
-
- if ( exists $entry->{ "BLOCKCOUNT" } )
- {
- @q_begs = split ",", $entry->{ "Q_BEGS" };
- @blocksizes = split ",", $entry->{ "BLOCKSIZES" };
-
- for ( $i = 0; $i < @q_begs; $i++ )
- {
- undef $block;
-
- $block->{ "CHR" } = $entry->{ "CHR" };
- $block->{ "CHR_BEG" } = $entry->{ "CHR_BEG" } + $q_begs[ $i ];
- $block->{ "CHR_END" } = $entry->{ "CHR_BEG" } + $q_begs[ $i ] + $blocksizes[ $i ] - 1;
- $block->{ "Q_ID" } = $entry->{ "Q_ID" } . sprintf( "_%03d", $i );
- $block->{ "SCORE" } = $entry->{ "SCORE" };
- $block->{ "STRAND" } = $entry->{ "STRAND" };
- $block->{ "BED_LEN" } = $block->{ "CHR_END" } - $block->{ "CHR_BEG" } + 1,
- $block->{ "BED_COLS" } = 6;
- $block->{ "REC_TYPE" } = "BED";
-
- push @blocks, $block;
- }
- }
- else
- {
- @blocks = @{ $entry };
- }
-
- return wantarray ? @blocks : \@blocks;
-}
-
-
-
-sub bed_overlap
-{
- # Martin A. Hansen, February 2008.
-
- # Checks if two BED entries overlap and
- # return 1 if so - else 0;
-
- my ( $entry1, # hashref
- $entry2, # hashref
- $no_strand, # don't check strand flag - OPTIONAL
- ) = @_;
-
- # Return bolean.
-
- return 0 if $entry1->{ "CHR" } ne $entry2->{ "CHR" };
- return 0 if $entry1->{ "STRAND" } ne $entry2->{ "STRAND" };
-
- if ( $entry1->{ "CHR_END" } < $entry2->{ "CHR_BEG" } or $entry1->{ "CHR_BEG" } > $entry2->{ "CHR_END" } ) {
- return 0;
- } else {
- return 1;
- }
-}
-
-
-sub bed_upload_to_ucsc
-{
- # Martin A. Hansen, September 2007.
-
- # Upload a BED file to the UCSC database.
-
- my ( $tmp_dir, # temporary directory
- $file, # file to upload,
- $options, # argument hashref
- $append, # flag indicating table should be appended
- ) = @_;
-
- # Returns nothing.
-
- my ( $args, $table, $sql_file, $fh_out, $fh_in );
-
- if ( $append ) {
- $args = join " ", $options->{ "database" }, $options->{ "table" }, "-tmpDir=$tmp_dir", "-oldTable", $file;
- } else {
- $args = join " ", $options->{ "database" }, $options->{ "table" }, "-tmpDir=$tmp_dir", $file;
- }
-
- if ( $options->{ "sec_struct" } )
- {
- $table = $options->{ "table" };
-
- Maasha::Common::error( "Attempt to load secondary structure track without 'rnaSecStr' in table name" ) if not $table =~ /rnaSecStr/;
-
- $sql_file = "$tmp_dir/upload_RNA_SS.sql";
-
- $fh_out = Maasha::Common::write_open( $sql_file );
-
- print $fh_out qq(
-CREATE TABLE $table (
- bin smallint not null, # Bin number for browser speedup
- chrom varchar(255) not null, # Chromosome or FPC contig
- chromStart int unsigned not null, # Start position in chromosome
- chromEnd int unsigned not null, # End position in chromosome
- name varchar(255) not null, # Name of item
- score int unsigned not null, # Score from 0-1000
- strand char(1) not null, # + or -
- size int unsigned not null, # Size of element.
- secStr longblob not null, # Parentheses and '.'s which define the secondary structure
- conf longblob not null, # Confidence of secondary-structure annotation per position (0.0-1.0).
- #Indices
- INDEX(name(16)),
- INDEX(chrom(8), bin),
- INDEX(chrom(8), chromStart)
-);
- );
-
- close $fh_out;
-
- Maasha::Common::run( "hgLoadBed", "-notItemRgb -sqlTable=$sql_file $options->{ 'database' } $options->{ 'table' } -tmpDir=$tmp_dir $file > /dev/null 2>&1" );
-
- unlink $sql_file;
- }
- else
- {
- Maasha::Common::run( "hgLoadBed", "$args > /dev/null 2>&1" );
- }
-}
-
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> PSL format <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-sub psl_get_entries
-{
- # Martin A. Hansen, February 2008.
-
- # Reads PSL entries and returns a record.
-
- my ( $path, # full path to PSL file
- ) = @_;
-
- # Returns hashref.
-
- my ( $fh, @lines, @fields, $i, %record, @records );
-
- $fh = Maasha::Common::read_open( $path );
-
- @lines = <$fh>;
-
- close $fh;
-
- chomp @lines;
-
- for ( $i = 5; $i < @lines; $i++ )
- {
- @fields = split "\t", $lines[ $i ];
-
- Maasha::Common::error( qq(Bad PSL format in file "$path") ) if not @fields == 21;
-
- undef %record;
-
- %record = (
- REC_TYPE => "PSL",
- MATCHES => $fields[ 0 ],
- MISMATCHES => $fields[ 1 ],
- REPMATCHES => $fields[ 2 ],
- NCOUNT => $fields[ 3 ],
- QNUMINSERT => $fields[ 4 ],
- QBASEINSERT => $fields[ 5 ],
- SNUMINSERT => $fields[ 6 ],
- SBASEINSERT => $fields[ 7 ],
- STRAND => $fields[ 8 ],
- Q_ID => $fields[ 9 ],
- Q_LEN => $fields[ 10 ],
- Q_BEG => $fields[ 11 ],
- Q_END => $fields[ 12 ] - 1,
- S_ID => $fields[ 13 ],
- S_LEN => $fields[ 14 ],
- S_BEG => $fields[ 15 ],
- S_END => $fields[ 16 ] - 1,
- BLOCKCOUNT => $fields[ 17 ],
- BLOCKSIZES => $fields[ 18 ],
- Q_BEGS => $fields[ 19 ],
- S_BEGS => $fields[ 20 ],
- );
-
- $record{ "SCORE" } = $record{ "MATCHES" } + int( $record{ "REPMATCHES" } / 2 ) - $record{ "MISMATCHES" } - $record{ "QNUMINSERT" } - $record{ "SNUMINSERT" };
-
- push @records, { %record };
- }
-
- return wantarray ? @records : \@records;
-}
-
-
-sub psl_put_header
-{
- # Martin A. Hansen, September 2007.
-
- # Write a PSL header to file.
-
- my ( $fh, # file handle - OPTIONAL
- ) = @_;
-
- # Returns nothing.
-
- $fh = \*STDOUT if not $fh;
-
- print $fh qq(psLayout version 3
-match mis- rep. N's Q gap Q gap T gap T gap strand Q Q Q Q T T T T block blockSizes qStart match match count bases count bases name size start end name size start end count
----------------------------------------------------------------------------------------------------------------------------------------------------------------
-);
-}
-
-
-sub psl_put_entry
-{
- # Martin A. Hansen, September 2007.
-
- # Write a PSL entry to file.
-
- my ( $record, # hashref
- $fh, # file handle - OPTIONAL
- ) = @_;
-
- # Returns nothing.
-
- $fh = \*STDOUT if not $fh;
-
- my @output;
-
- push @output, $record->{ "MATCHES" };
- push @output, $record->{ "MISMATCHES" };
- push @output, $record->{ "REPMATCHES" };
- push @output, $record->{ "NCOUNT" };
- push @output, $record->{ "QNUMINSERT" };
- push @output, $record->{ "QBASEINSERT" };
- push @output, $record->{ "SNUMINSERT" };
- push @output, $record->{ "SBASEINSERT" };
- push @output, $record->{ "STRAND" };
- push @output, $record->{ "Q_ID" };
- push @output, $record->{ "Q_LEN" };
- push @output, $record->{ "Q_BEG" };
- push @output, $record->{ "Q_END" } + 1;
- push @output, $record->{ "S_ID" };
- push @output, $record->{ "S_LEN" };
- push @output, $record->{ "S_BEG" };
- push @output, $record->{ "S_END" } + 1;
- push @output, $record->{ "BLOCKCOUNT" };
- push @output, $record->{ "BLOCKSIZES" };
- push @output, $record->{ "Q_BEGS" };
- push @output, $record->{ "S_BEGS" };
-
- print $fh join( "\t", @output ), "\n";
-}
-
-
-sub psl_upload_to_ucsc
-{
- # Martin A. Hansen, September 2007.
-
- # Upload a PSL file to the UCSC database.
-
- my ( $file, # file to upload,
- $options, # argument hashref
- $append, # flag indicating table should be appended
- ) = @_;
-
- # Returns nothing.
-
- my ( $args );
-
- if ( $append ) {
- $args = join " ", $options->{ "database" }, "-table=$options->{ 'table' }", "-clientLoad", "-append", $file;
- } else {
- $args = join " ", $options->{ "database" }, "-table=$options->{ 'table' }", "-clientLoad", $file;
- }
-
- Maasha::Common::run( "hgLoadPsl", "$args > /dev/null 2>&1" );
-}
-
-
-# >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> TRACK FILE <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-
-
-sub update_my_tracks
-{
- # Martin A. Hansen, September 2007.
-
- # Update the /home/user/ucsc/my_tracks.ra file and executes makeCustomTracks.pl
-
- my ( $options, # hashref
- $type, # track type
- ) = @_;
-
- # Returns nothing.
-
- my ( $file, $fh_in, $fh_out, $line, $time );
-
- $file = $ENV{ "HOME" } . "/ucsc/my_tracks.ra";
-
- # ---- create a backup ----
-
- $fh_in = Maasha::Common::read_open( $file );
- $fh_out = Maasha::Common::write_open( "$file~" );
-
- while ( $line = <$fh_in> ) {
- print $fh_out $line;
- }