lib/Bio/Graphics/Browser2/UserTracks.pm

package Bio::Graphics::Browser2::UserTracks;

# $Id$
use strict;
use Bio::Graphics::Browser2::DataSource;
use Bio::Graphics::Browser2::DataLoader;
use Bio::Graphics::Browser2::UserTracks::Filesystem;
use Bio::Graphics::Browser2::UserTracks::Database;
use File::Spec;
use File::Basename 'basename';
use File::Path 'mkpath','rmtree';
use File::Copy 'move';
use IO::File;
use IO::String;
use File::Temp 'tempdir';
use POSIX ();
use Carp qw(croak cluck);
use CGI 'param';
use Data::Dumper;

use constant DEBUG => 0;
my $HASBIGWIG;

# The intent of this is to provide a single unified interface for 
# managing a user's uploaded and shared tracks.

# BUG: It's still kind of screwy: there seem to be filesystem
# traversal methods in the parent class which should not be here.

# class methods
sub busy_file_name     { 'BUSY'      }
sub status_file_name   { 'STATUS'    }
sub imported_file_name { 'IMPORTED'  }
sub mirrored_file_name { 'MIRRORED'  }
sub sources_dir_name   { 'SOURCES'   }

sub new {
    my $class = shift;
    my ($data_source,$session) = @_;

    my $globals       = $data_source->globals;
    my $uploadsid     = $session->uploadsid;
    my $backend       = $globals->user_account_db;
    my $user_accounts = $globals->user_accounts;
    
    my $implementer;

    if ($backend && $backend =~ /db/i && $user_accounts) {
	$implementer = 'Bio::Graphics::Browser2::UserTracks::Database';
    } else {
	$implementer = 'Bio::Graphics::Browser2::UserTracks::Filesystem';
    }

    my $self = $implementer->_new($data_source, $globals, $uploadsid, $session);
    $self->is_admin(1) if $class->admin;
    $self->create_track_lookup;
    return $self;
}

sub _new {
    my $class = shift;
    my ($data_source, $globals, $uploadsid, $session) = @_;
	
    my $self = bless {
		config	    => $data_source,
		uploadsid   => $uploadsid,
		globals	    => $globals,
		session     => $session,
		data_source => $data_source->name,
    }, ref $class || $class;
    return $self;
}

##### CLASS METHOD #####
sub admin     {0}
########################

sub uploadsid       {shift->{uploadsid}}
sub session         {shift->{session}}
sub sessionid       {shift->session->id}
sub page_settings        {
    my $self = shift;
    return $self->{'.page_settings'} ||= $self->session->page_settings;
}
sub database        {
    my $self = shift;
    return $self->isa('Bio::Graphics::Browser2::UserTracks::Database');
}
sub globals         {shift->{globals}       }
sub data_source     {shift->{config}        }
sub datasource_name {shift->{data_source}   }
sub is_admin {
    my $self = shift;
    my $d    = $self->{is_admin};
    $self->{is_admin} = shift if @_;
    $d;
}

# Tracks - Returns an array of paths to a user's tracks.
sub tracks {
    my $self = shift;	
    my @tracks;
    push @tracks, $self->get_uploaded_files,     $self->get_imported_files;
    push @tracks, $self->get_added_public_files, $self->get_shared_files;
    return @tracks;
}

# Track Lookup - Returns a hash of tracks showing the files they originate from.
sub track_lookup {
    my $self = shift;
    return %{$self->{track_lookup}};
}

# Create Track Lookup - Populate the track lookup hash.
sub create_track_lookup {
    my $self = shift;
    my @tracks = $self->tracks;
    
    my $track_lookup = {};
    foreach my $track (@tracks) {
        $track_lookup->{$_} = $track foreach $self->labels($track);
    }
    
    $self->{track_lookup} = $track_lookup;
}

# Get Track Upload ID - Returns the upload ID of the original file the track came from.
sub get_track_upload_id {
    my $self = shift;
    my $track = shift;
    my %track_lookup = $self->track_lookup;
    return $track_lookup{$track};
}

# Is Mirrored - Returns the URL if a specific file is mirrored.
sub is_mirrored {
    my $self  = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $mirror_flag = $self->mirror_flag($file);
    return unless -e $mirror_flag;
    open(my $i, $mirror_flag);
    my $url = <$i>;
    close $i;
    return $url;
}

# Set Mirrored - Sets the mirror flag.
sub set_mirrored {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $url = shift;
    my $flagfile = $self->mirror_flag($file);
    open my $i,">", $flagfile or warn "can't open mirror file: $!";
    print $i $url;
    close $i;
}

# Conf Files (File) - Returns the paths to all tracks' conf files.
sub conf_files {
    my $self = shift;
    my $file = shift;
    return grep {-e $_} map { $self->track_conf($file) } $self->tracks;
}

sub path {
    my $self = shift;
    my $uploadsid = $self->uploadsid;
    my $source    = $self->data_source;
    my $path = $self->is_admin ? $source->admindata() : $source->userdata($uploadsid);
    return $path;
}

# Track Path (File) - Returns a verified path to the folder holding a track.
sub track_path {
    my $self  = shift;
    my $track       = shift;
    my $filename    = $self->filename($track);
    if ($filename =~ m!/!) {
	my ($uploadsid,$base) = split '/',$filename;
	return File::Spec->catfile($self->data_source->userdata($uploadsid),$self->escape_url($base));
    } else {
	my $folder_name = $self->escape_url($filename);
	return File::Spec->catfile($self->path($track), $folder_name);
    }
}

# Blind Track Path (Filename) - Blindly attaches the userdata path to whatever filename you give it.
sub blind_track_path {
    my $self = shift;
    my $filename = shift;
    return File::Spec->catfile($self->path, $filename);
}

# Data Path (File, Data File) - Returns the full path to a track's original data file.
sub data_path {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $datafile = shift;
    return File::Spec->catfile($self->track_path($file), $self->sources_dir_name, $datafile);
}

# Track Conf (File) - Returns the full path to the track's configuration file.
sub track_conf {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $conf_file = $self->escape_url($filename) . ".conf";
    return File::Spec->catfile($self->track_path($file), $conf_file);
}

# Conf FH (File) - Returns a file handle to a track's configuration file.
sub conf_fh {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    return Bio::Graphics::Browser2::UserConf->fh($self->track_conf($file));
}

# Import Flag (File) - Returns a track's import flag file.
sub import_flag {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    return File::Spec->catfile($self->track_path($file), $self->imported_file_name);
}

# Mirror Flag (File) - Returns the location of the mirror flag file.
sub mirror_flag {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    return File::Spec->catfile($self->track_path($file), $self->mirrored_file_name);
}

# Conf Metadata (File) - Returns the modified time and size of a track's configuration file.
sub conf_metadata {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $conf = $self->track_conf($file);
    my $name = basename($conf);
    return ($name, (stat($conf))[9, 7]);
}

# Source Files (File) - Returns an array of source files (with details) associated with a specified track.
sub source_files {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $path = File::Spec->catfile($self->track_path($file), $self->sources_dir_name);
    
    my @files;
    if (opendir my $dir, $path) {
		while (my $f = readdir($dir)) {
			my $path = File::Spec->catfile($path, $f);
			next unless -f $path;
			my ($size, $mtime) = (stat(_))[7,9];
			push @files, [$f, $size, $mtime, $path];
		}
    }
    return @files;
}

# Escape URL (URL[, Uniquefy]) - Gets an escaped name from a given URL.
sub escape_url {
    my $self     = shift;
    my $url      = shift;
    my $uniquefy = shift;

    my $filename;

    # Remove any illegal chars
    # hack here: if the URL looks like a "uploadid/filename", then we
    # leave the slash there.
    if ($url =~ m!^[a-f0-9]{32}/!) { # treat as a path to another userid
	my ($dir,$rest) = split '/',$url;
	$rest           =~ tr/a-zA-Z0-9_%^@.-/_/cs;
	$filename       = $rest;
    } else {
	($filename = $url) =~ tr/a-zA-Z0-9_%^@.-/_/cs;
    }
	
    # Cut the length at the maximum filename.
    if (length $filename > $self->max_filename) {
	$filename = substr($filename, 0, $self->max_filename);
    }
	
    # If the file isn't unique, add a number on the end.
    my $unique = 0;
    while ($uniquefy && !$unique) {
	my $path = $self->blind_track_path($filename);
	if (-e $path) {
	    $filename .= "-0" unless $filename =~ /-\d+$/;
	    $filename  =~ s/-(\d+)$/'-'.($1+1)/e; # add +1 to the trackname
	} else {
	    $unique++;
	}
    }
    return $filename;
}

# Trackname from URL (URL[, Uniquefy]) - Gets a track name from a given URL and creates the folder to hold it.
sub trackname_from_url {
    my $self     = shift;
    my $url      = shift;
    my $uniquefy = shift;

    warn "trackname_from_url($url)" if DEBUG;
    
    my $filename = $self->escape_url($url, $uniquefy);
    my $path = $self->blind_track_path($filename);
    
    rmtree($path) if -e $path;  # only happens if uniquefy = 0
    mkpath $path;
    return $filename;
}

# Max filename () - Returns the maximum possible length for a file name.
sub max_filename {
    my $self = shift;
    my $length = POSIX::pathconf($self->path, &POSIX::_PC_NAME_MAX) || 255;
    return $length - 4; # give enough room for the suffix
}

# Import URL (URL, Overwrite[, Privacy Policy]) - Imports a URL for use in the database.
sub import_url {
    my $self = shift;
    my $url       = shift;
    my $overwrite = shift;
    my $privacy_policy = shift || "private";
    my $username = $self->{username};

    my $key;
    if ($url =~ m!http://([^/]+).+/(\w+)/\?.*t=([^+;]+)!) {
		my @tracks = split /\+/,$3;
		$key = "Shared track from $1 (@tracks)";
    } else {
    	$key  = "Shared track from $url";
    }

    my $filename = $self->trackname_from_url($url, !$overwrite);
    my $file = $self->add_file($filename, 1);
    
    my $loader = Bio::Graphics::Browser2::DataLoader->new($filename,
							  $self->track_path($file),
							  $self->track_conf($file),
							  $self->{config},
							  $self->uploadsid);
    $loader->strip_prefix($self->{config}->seqid_prefix);
    $loader->set_status('starting import');

    my $conf = $self->track_conf($file);
    open (my $f, "+>", $conf) or croak "Couldn't open $conf: $!";
    my @data = $f;

    if ($url =~ /\.bam$/) {
		print $f $self->remote_bam_conf($file, $url, $key);
    } 
    elsif ($url =~ /\.bw$/) {
		print $f $self->remote_bigwig_conf($file, $url, $key);
    }
    else {
		print $f $self->remote_mirror_conf($file, $url, $key);# Conf Metadata (File) - Returns the modified time and size of a track's configuration file.
    }

    close $f;
    open my $i, ">", $self->import_flag($file);
    close $i;

    $loader->set_processing_complete;
	
    return (1, '', [$filename], $file);
}

# Reload File (File) - Attempts to reload a file into the database.
sub reload_file {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my @sources = $self->source_files($file);
    for my $s (@sources) {
		my ($name, $size, $mtime, $path) = @$s;
		rename $path, "$path.bak" or next;
		my $io = IO::File->new("$path.bak") or next;
		my ($result) = $self->upload_file($name, $io,'',1);
		if ($result) {
			unlink "$path.bak";
		} else {
			rename "$path.bak", $path;
		}
    }
}

# Mirror URL (Filename, URL, Overwrite?) - Attempts to "mirror" a file on a URL, to avoid fetching it every time.
sub mirror_url {
    my $self = shift;
    my ($filename,$url,$overwrite,$render) = @_;
    
    warn "mirroring..." if DEBUG;

    if ($url =~ /\.(bam|bw)$/ or $url =~ /\b(gbgff|das)\b/) {
		return $self->import_url($url, $overwrite);
    }

    # first we do a HEAD to validate that the thing exists
    eval "require LWP::UserAgent" unless LWP::UserAgent->can('new');
    my $agent  = LWP::UserAgent->new();
    my $result = $agent->head($url);
    unless ($result->is_success) {
		my $msg = $url.': '.$result->status_line;
		warn $msg if DEBUG;
		return (0,$msg,[]);
    }

    # fetch in one process, process in another
    eval "use IO::Pipe" unless IO::Pipe->can('new');
    my $fh  = IO::Pipe->new;
    my $child = $render->fork();
    die "Couldn't fork" unless defined $child;

    unless ($child) {
		warn "printing from child..." if DEBUG;
		$fh->writer();
		$self->_print_url($agent, $url, $fh);
		CORE::exit 0;
    }
    $fh->reader;

    $filename = $self->trackname_from_url($filename, !$overwrite);
    
    my $content_type = $result->header('Content-Type') || 'text/plain';

    if ($content_type eq 'application/gzip' or $filename =~ /\.gz$/) {
		$fh = $self->install_filter($fh,'gunzip -c');
    } elsif ($content_type eq 'application/bzip2' or $filename =~ /\.bz2$/) {
		$fh = $self->install_filter($fh,'bunzip2 -c');
    }
    
    my $file = $self->add_file($filename, 1);
    
    # guess the file type from the first non-blank line
    my ($type, $lines, $eol) = $self->guess_upload_type($file, $fh);
    $lines ||= [];
    my (@tracks, $fcgi);

    my $mirror_result = eval {
		local $SIG{TERM} = sub { die "cancelled" };
		croak "Could not guess the type of the file $filename"	unless $type;

		my $load = $self->get_loader($type, $file);
		$load->eol_char($eol);
		@tracks = $load->load($lines, $fh);
		1;
    };

    if ($@ =~ /cancelled/) {
	$self->delete_file($file);
	return (0,'Upload process terminated',[]);
    }

    my $msg = $@;
    warn "UPLOAD ERROR: ", $msg if $msg;
    $self->delete_file($file) unless $mirror_result;
    $self->set_mirrored($file, $url);
    return ($mirror_result, $msg, \@tracks);
}

# Upload Data (Filename, Data, Content Type, Overwrite?) - Uploads a string of data entered as text (on the Upload & Share Tracks tab).
sub upload_data {
    my $self = shift;
    my ($file_name, $data, $content_type, $overwrite) = @_;
    my $io = IO::String->new($data);
    $self->upload_file($file_name, $io, $content_type, $overwrite);
}

# Upload URL (URL) - Uploads a file at a specified URL to the database.
sub upload_url {
    my $self  = shift;
    my $url   = shift;
    my $dir   = tempdir(CLEANUP=>1);
    my $path  = File::Spec->catfile($dir, basename($url));
    eval "require LWP::UserAgent" unless LWP::UserAgent->can('new');
    my $agent = LWP::UserAgent->new();
    my $response = $agent->mirror($url, $path);
    $response->is_success or die $response->status_line;
    my $mime = $response->header('Content-type');
    open my $fh,"<",$path;
    my @args = $self->upload_file(basename($url),$fh,$mime,1);
    unlink $path;
    File::Temp::cleanup();
    return @args;
}

# Upload File (Filename, File Handle, Content Type, Overwrite?) - Uploads a user's file, as called by the AJAX upload system (on the Upload & Share Tracks tab) via Action.pm.
sub upload_file {
    my $self = shift;
    my ($file_name, $fh, $content_type, $overwrite) = @_;

    my $original_name = $file_name;
    $file_name    =~ s/\.(gz|bz2)$//;  # to indicate that it is decompressed

    warn "$file_name: OVERWRITE = $overwrite" if DEBUG;

    my $filename = $self->trackname_from_url($file_name, !$overwrite);
    
    $content_type ||= '';
    
    if ($original_name =~ /\.sam\.gz/) { # special case compressed sam files - do not uncompress!
#	$filename = $original_name;
    } elsif ($content_type eq 'application/gzip' or $original_name =~ /\.gz$/) {
	$fh = $self->install_filter($fh,'gunzip -c');
    } elsif ($content_type eq 'application/bzip2' or $original_name =~ /\.bz2$/) {
	$fh = $self->install_filter($fh,'bunzip2 -c');
    }
    
    my $fileid = $self->get_file_id($filename) if $self->database;
    my $file   = $self->database ? $fileid ? $fileid : $self->add_file($filename) : $filename;
    
    # guess the file type from the first non-blank line
    my ($type, $lines, $eol) = $self->guess_upload_type($file, $fh);
    $lines ||= [];
    my (@tracks, $fcgi);

    my $result = eval {
		local $SIG{TERM} = sub { die "cancelled" };
		croak "Could not guess the type of the file $file_name"	unless $type;
		croak "This server does not support BigWig upload" if $type =~ /bigwig/ && !$self->has_bigwig;
		my $load = $self->get_loader($type, $file);
		$load->eol_char($eol);
		@tracks = $load->load($lines, $fh);
		1;
    };

    if ($@ =~ /cancelled/) {
		$self->delete_file($file);
		return (0,'Cancelled by user',[]);
    }

    my $msg = $@;
    warn "UPLOAD ERROR: ", $msg if $msg;
    if ($result) {
	$self->title($file,$filename);
    } else {
	$self->delete_file($file);
    }
    return ($result, $msg, \@tracks);
}

# set title of upload- implemented in subclasses
sub title { } 

# set the key of a labeled track - this involves rewriting the track config
sub set_key {
    my $self = shift;
    my ($file,$label,$new_key) = @_;
    my $old_path = $self->track_conf($file);
    my $new_path = "$old_path.bak";
    open my $in,$old_path      or croak "$old_path: $!";
    open my $out,'>',$new_path or croak "$new_path: $!";
    my $in_stanza;
    while (<$in>) {
	$in_stanza = undef if /^\[.+\]/; 
	$in_stanza ||= /^\[$label\]/;
	next unless $in_stanza;
	$_ = "key = $new_key\n" if /^key/;
    } continue {
	print $out $_;
    }
    close $in; close $out;
    rename $new_path,$old_path;
    return $new_key; # in case we want to change it later
}

# Merge Conf (File, New Data) - Merges new data into a track's configuration file.
sub merge_conf {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $new_data = shift;

    my $path = $self->track_conf($file) or return;

    my @lines = split /\r\n|\r|\n/,$new_data;
    my (%stanzas, $current_stanza);
    for (@lines) {
		if (/^\[(.+)\]/) {
			$current_stanza = $1;
			$stanzas{$current_stanza} = '';
		} elsif ($current_stanza) {
			$stanzas{$current_stanza} .= "$_\n";
		}
    }

    open my $fh, $path or croak "$path: $!";
    my $merged = '';
    my @database;
    # read header with the [database] definition
    while (<$fh>) {
		$merged .= $_;
		push @database,$1 if /^\[(.+):database/;
		last if /cut here/;
    }

    $merged .= "\n";

    # read the rest
    while (<$fh>) {
	if (/^\[/) {
	    (my $stanza = $_) =~ s/\[(\w+?)_.+_(\d+)(:\d+)?\]\s*\n/$1_$2$3/;
	    $stanza =~ s/^\[//; # just in case
	    $stanza =~ s/\]\n//;
	    if (my $body = $stanzas{$stanza}) {
		$merged .= $_;
		$merged .= $body;
		delete $stanzas{$stanza};
	    }
	}
    }

    # anything that's left (new stuff)
    for my $stanza (keys %stanzas) {
	$merged .= "\n[$stanza]\n";
	$merged .= $stanzas{$stanza};
    }

    $merged =~ s/database_(\d+).+/$database[$1]/g;

    open $fh,'>',$path or croak "Can't open $path for writing: $!";
    print $fh $merged;
    close $fh;
}

#Labels (File) - Returns the track labels for a specified uploaded file.
sub labels {
    my $self = shift;
    my $file = shift;
    my $conf = $self->track_conf($file);
    
    return grep {!/:(database|\d+)/} eval{ Bio::Graphics::FeatureFile->new(-file=>$conf)->labels };
}

sub file_from_label {
    my $self = shift;
    my $label = shift;
    my %track_lookup = $self->track_lookup;
    return $track_lookup{$label};
}

# Status (File) - Returns the status of a DataLoader object for a specific file.
sub status {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $loader = 'Bio::Graphics::Browser2::DataLoader';
    my $load = $loader->new($filename,
			      $self->track_path($file),
			      $self->track_conf($file),
			      $self->{config},
			      $self->uploadsid,
	);
    return $load->get_status();
}

# Get Loader (Type, File) - Returns the loader of the appropriate DataLoader package type for a specific file.
sub get_loader {
    my $self = shift;
    my $type = shift;
    my $file = shift;
    my $filename = $self->filename($file);
	
    my $module = "Bio::Graphics::Browser2::DataLoader::$type";
    eval "require $module";
    die $@ if $@;
    
    my $loader = $module->new($filename,
			      $self->track_path($file),
			      $self->track_conf($file),
			      $self->{config},
			      $self->uploadsid,
	);
    $loader->strip_prefix($self->{config}->seqid_prefix);
    $loader->force_category('General') if $self->is_admin;
    return $loader;
}

# guess the file type and eol based on its name and the first 1024 bytes
# of the file. The @$lines will contain the lines that were consumed
# during this operation so that the info isn't lost.
sub guess_upload_type {
    my $self = shift;
    my ($type, $lines, $eol) = $self->_guess_upload_type(@_);
    $type = 'wig2bigwig' if $type eq 'wiggle' && $self->has_bigwig;
    return ($type, $lines, $eol);
}

sub _guess_upload_type {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my $fh = shift;

    my $buffer;
    read($fh,$buffer,1024);

    # first check for binary upload; currently only BAM & bigwig
    return ('bam',[$buffer],undef)
	if substr($buffer,0,6) eq "\x1f\x8b\x08\x04\x00\x00";
    return('bigwig',[$buffer],undef)
	if substr($buffer,0,4) eq "\x26\xfc\x8f\x88";
    
    # everything else is text (for now)
    my $eol = $buffer =~ /\015\012/ ? "\015\012"  # MS-DOS
	     :$buffer =~ /\015/     ? "\015"      # Macintosh
	     :$buffer =~ /\012/     ? "\012"      # Unix
	     :"\012";  # default to Unix

    local $/ = $eol;
    my @lines     = map {$_.$eol} split $eol,$buffer;
    $lines[-1]    =~ s/$eol$// unless $buffer =~ /$eol$/;
    my $remainder = <$fh>;
    $remainder   ||= '';
    $lines[-1]   .= $remainder;

    # first guess based on file names
    my $ftype = $filename =~ /\.gff(\.(gz|bz2|Z))?$/i  ? 'gff'
	       :$filename =~ /\.gff3(\.(gz|bz2|Z))?$/i ? 'gff3'
	       :$filename =~ /\.bed(\.(gz|bz2|Z))?$/i  ? 'bed'
	       :$filename =~ /\.bw$/i                  ? 'bigwig'
	       :$filename =~ /\.wig(\.(gz|bz2|Z))?$/i  ? 'wiggle'
	       :$filename =~ /\.fff(\.(gz|bz2|Z))?$/i  ? 'featurefile'
	       :$filename =~ /\.bam(\.gz)?$/i          ? 'bam'
	       :$filename =~ /\.sam(\.gz)?$/i          ? 'sam'
	       :undef;
    
    return ($ftype,\@lines,$eol) if $ftype;

    # otherwise scan the thing until we find a pattern we know about
    # or hit the end of the file. Extra lines that we read are 
    # accumulated into the @lines array.
    my $i = 0;
    while (1) {
	my $line;
	if ($i <= $#lines) {
	    $line = $lines[$i++];
	} else {
	    my $line = <$fh>;
	    last unless $line;
	    push @lines,$line;
	}
	return ('featurefile',\@lines,$eol) if $line =~ /^reference/i;
	return ('featurefile',\@lines,$eol) if $line =~ /\w+:\d+\.\.\d+/i;
	return ('gff2',\@lines,$eol)        if $line =~ /^\#\#gff-version\s+2/;
	return ('gff3',\@lines,$eol)        if $line =~ /^\#\#gff-version\s+3/;
	return ('wiggle',\@lines,$eol)      if $line =~ /type=wiggle/;
	return ('bed',\@lines,$eol)         if $line =~ /^track type/;
	return ('bed',\@lines,$eol)         if $line =~ /^\w+\s+\d+\s+\d+/;
	return ('sam',\@lines,$eol)         if $line =~ /^\@[A-Z]{2}/;
	return ('sam',\@lines,$eol)         if $line =~ /^[^ \t\n\r]+\t[0-9]+\t[^ \t\n\r@=]+\t[0-9]+\t[0-9]+\t(?:[0-9]+[MIDNSHP])+|\*/;
    }
    return;
}

sub has_bigwig {
    my $self = shift;
    return $HASBIGWIG if defined $HASBIGWIG;
    return $HASBIGWIG = 1 if Bio::DB::BigWig->can('new');
    my $result = eval "require Bio::DB::BigWig; 1";
    return $HASBIGWIG = $result || 0;
}

# Install Filter (File Handle, Command) - Attaches a filter (such as GUNZIP or BUNZIP2) to a file handle.
sub install_filter {
    my $self = shift;
    my ($in_fh, $command) = @_;

    my $child = open(my $out_fh,"-|");
    defined $child or die "Couldn't fork for pipe: $!";
    return $out_fh if $child;

    # we are in child now
    Bio::Graphics::Browser2::Render->prepare_fcgi_for_fork('child');
    my $unzip = IO::File->new("| $command") or die "Can't open $command: $!";
    my $buffer;
    while ((my $bytes = read($in_fh,$buffer,8192))>0) {
	$unzip->print($buffer);
    }
    close $unzip;
    CORE::exit 0;
}

sub remote_mirror_conf {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my ($url, $key) = @_;

    return <<END;
>>>>>>>>>>>>>> cut here <<<<<<<<<<<<
[$filename]
remote feature = $url
category = My Tracks:Remote Tracks
key      = $key
END
    ;
}

sub remote_bam_conf {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my ($url, $key) = @_;

    my $id = rand(1000);
    my $dbname = "remotebam_$id";
    my $track_id = $filename;# . "_1";

    eval "require Bio::Graphics::Browser2::DataLoader::bam"
	unless Bio::Graphics::Browser2::DataLoader::bam->can('new');
    my $loader = Bio::Graphics::Browser2::DataLoader::bam->new(
	$filename,
	$self->track_path($file),
	$self->track_conf($file),
	$self->{config},
	$self->uploadsid);
    my $fasta  = $loader->get_fasta_file;

    return <<END;
[$dbname:database]
db_adaptor = Bio::DB::Sam
db_args    = -bam           $url
             -split_splices 1
             -fasta         $fasta
search options = none

>>>>>>>>>>>>>> cut here <<<<<<<<<<<<

[$track_id:2001]
feature   = coverage:2000
min_score    = 0
glyph        = wiggle_xyplot
height       = 50
fgcolor      = black
bgcolor      = black
autoscale    = local

[$track_id]
database     = $dbname
feature      = read_pair
glyph        = segments
feature_limit = 500
draw_target   = 1
show_mismatch = 1
mismatch_color = red
bgcolor      = blue
fgcolor      = blue
height       = 3
label        = 1
label density = 50
stranded     = 1
bump         = fast
key          = $key
END
    ;
}

sub remote_bigwig_conf {
    my $self = shift;
    my $file = shift;
    my $filename = $self->filename($file);
    my ($url, $key) = @_;
    my $id = rand(1000);
    my $dbname = "remotebw_$id";
    my $track_id = $filename;
    warn "remote_bigwig_conf";
    return <<END;
[$dbname:database]
db_adaptor = Bio::DB::BigWig
db_args    = -bigwig $url
search options = none

>>>>>>>>>>>>>> cut here <<<<<<<<<<<<
[$track_id]
database        = $dbname
feature         = summary
glyph           = wiggle_whiskers
max_color       = lightgrey
min_color       = lightgrey
mean_color      = black
stdev_color     = grey
stdev_color_neg = grey
height          = 20

END
}

sub _print_url {
    my $self = shift;
    my ($agent, $url, $fh) = @_;
    $agent->get($url,':content_cb' => sub { print $fh shift; });
}

# Sharing Link (File ID) - Generates the sharing link for a specific file.
sub sharing_link {
    my $self = shift;
    my $file = shift or return;
    return CGI::url(-full => 1, -path_info => 1) . "?share_link=" . $file;
}

# These methods are replaced by methods in Filesystem.pm and Database.pm
# Many of these functions are called asynchronously, if you want to connect an AJAX call to one of these functions add a hook in Action.pm
sub get_file_id { warn "get_file_id() has been called, without properly inheriting subclass Database.pm"; }
sub filename { warn "filename() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub nowfun { warn "nowfun() has been called, without properly inheriting subclass Database.pm"; }
sub get_uploaded_files { warn "get_uploaded_files() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub get_public_files { warn "get_public_files() has been called, without properly inheriting subclass Database.pm"; }
sub get_imported_files { warn "get_imported_files() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub get_shared_files { warn "get_shared_files() has been called, without properly inheriting subclass Database.pm"; }
sub share { warn "share() has been called, without properly inheriting subclass Database.pm"; }
sub unshare { warn "unshare() has been called, without properly inheriting subclass Database.pm"; }
sub field { warn "field() has been called, without properly inheriting subclass Database.pm"; }
sub update_modified { warn "update_modified() has been called, without properly inheriting subclass Database.pm"; }
sub created { warn "created() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub modified { warn "modified() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub description { warn "description() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub add_file { warn "add_file() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub delete_file { warn "delete_file() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub is_imported { warn "is_imported() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub permissions { warn "permissions() has been called, without properly inheriting subclass Database.pm"; }
sub is_mine { warn "is_mine() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub owner { warn "owner() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub is_shared_with_me { warn "is_shared_with_me() has been called, without properly inheriting subclass Database.pm"; }
sub file_type { warn "file_type() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub shared_with { warn "shared_with() has been called, without properly inheriting subclass Database.pm"; }
sub file_exists { warn "file_exists() has been called, without properly inheriting subclass Filesystem.pm"; }
sub change_userid { warn "change_userid() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub change_uploadsid { warn "change_uploadsid() has been called, without properly inheriting a subclass (like Filesystem.pm or Database.pm)"; }
sub close_database { }  # do nothing

package Bio::Graphics::Browser2::UserConf;

use base 'Tie::Handle';
use Symbol;

sub fh {
    my $class = shift;
    my $path  = shift;
    my $g = gensym;
    tie(*$g,$class,$path);
    return $g;
}

sub TIEHANDLE {
    my $class = shift;
    my $path  = shift;
    open my $f,$path or die "$path:$!";
    return bless {
	fh       => $f,
	seen_cut => 0,
	_db      => {},  # remember db names
	-didx    => 0,   # db indexes
    },$class;
}

sub READLINE {
    my $self = shift;
    my $fh   = $self->{fh};

    while (my $line = <$fh>) {
	$self->{_db}{$1} = $self->{_didx}++ if $line =~ /^\[(.+):database/;
	if ($line =~ /cut here/i) {
	    $self->{seen_cut}++;
	    next;
	}
	next unless $self->{seen_cut};
	$line =~ s/database\s*=\s*(.+)/database = database_$self->{_db}{$1} # do not change this!/;
	$line =~ s/\[(\w+?)_.+_(\d+)(:\d+)?\]/[$1_$2$3]/;
	return $line;
    }
    return;
}

sub CLOSE { close shift->{fh} } 

# this is for the administrator-uploaded tracks.
# we simply change the location of the uploads
package Bio::Graphics::Browser2::AdminTracks;
use base 'Bio::Graphics::Browser2::UserTracks';

sub admin {1}

1;
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)