package Bio::Graphics::Browser2::ExternalData;

# base class for Bio::Graphics::Browser::RemoteSet;

use strict;
use Carp 'croak';
use Bio::Graphics::Browser2::Util 'error';
use Bio::Graphics::Wiggle;

use constant DEBUG => 0;

sub new {
  croak 'virtual base class';
}

sub uploadid      { croak "virtual method" }
sub config        { shift->{config}        }
sub state         { shift->{state}         }

sub readline {
  my $self = shift;
  my $fh   = shift;
  my $line;
  while (<$fh>) {
    chomp;
    next if /^\s*$/; # blank
    next if /^\s*#/; # comment
    s/[\r]//g;       # get rid of carriage returns from Macintosh/DOS systems
    $line .= $_;
    return $line unless $line =~ s/\\$//;
  }
  return $line;
}


# this converts .wig files and other UCSC formats into feature files that we can handle
sub convert_ucsc_file {
  my $self = shift;
  my ($in,$out) = @_;

  eval "require Bio::Graphics::Wiggle::Loader;1" 
    unless Bio::Graphics::Wiggle::Loader->can('new');

  my $dummy_name = $self->name_file('foo');
  $dummy_name    =~ s/foo$//; # get the directory part only!

  eval {
      my $loader = Bio::Graphics::Wiggle::Loader->new($dummy_name);
      $loader->load($in);
      my $featurefile = $loader->featurefile('featurefile');
      print $out $featurefile;
  };
  error($@) if $@;
}

sub convert_feature_file {
  my $self = shift;
  my ($in,$out) = @_;
  while ($_ = <$in>) {
      chomp;
      print $out $_,"\n";
  }
}

sub process_uploaded_file {
  my $self          = shift;
  my ($infh,$outfh) = @_;

  local $/ = $self->_guess_eol($infh);

  my $pos = tell($infh);
  my $first_line = $self->readline($infh);
  return unless defined $first_line;
  seek($infh,$pos,0);
  if ($first_line =~ /^(track|browser)/) {
    $self->convert_ucsc_file($infh,$outfh);
  } else {
    $self->convert_feature_file($infh,$outfh);
  }
}

sub maybe_unzip {
    my $self     = shift;
    my $filename = shift;
    my $fh       = shift;

    # If the file is in gzip format,
    # try to intercept and decompress the file
    if ($filename =~ /^(.+)\.gz$/) {
	$fh ||= IO::File->new($filename);
	$fh->binmode(1) if $fh->can('binmode');
	require File::Temp;
	my $fname = File::Temp->tmpnam;
	my $unzip = IO::File->new("|gunzip -c > $fname") or die $!;
	$unzip->binmode(1);
	my $buffer;
	$unzip->print($buffer) while read($fh,$buffer,1024);
	$unzip->close;
	$fh = IO::File->new($fname);
	$fh->binmode(1);
	unlink $fname;
	return $fh;
    }
    return;
}

sub _guess_eol {
    my $self = shift;
    my $fh   = shift;
    my $buffer;
    my $pos = tell($fh);
    read($fh,$buffer,1024);
    seek($fh,$pos,0);   # back to where we were
    return "\015\012" if $buffer =~ /\015\012/;
    return "\015"     if $buffer =~ /\015/;
    return "\012"     if $buffer =~ /\012/;
}

sub name_file {
  my $self      = shift;
  my $filename  = shift;
  my $strip     = shift;

  my $state     = $self->state;
  my $config    = $self->config;
  my $id        = $self->uploadid || $state->{userid} or return;

  my ($url,$path) = $self->file2path($config,$id,$filename,$strip);
  warn "name_file() returns => ($url,$path)" if DEBUG;
  return ($url,$path);
}

sub file2path {
    my $self  = shift;
    my ($config,$id,$filename,$strip) = @_;
    $strip        = 1 unless defined $strip;    

    # keep last non-[\\\/:] part of name
    my ($name) = $strip ? $filename =~ /([^:\\\/]+)$/ : $filename;
    $name                  =~ tr!-/!__!; # get rid of hyphens and slashes
    my $tmpdir    = $config->userdata($id);
    my $path      = File::Spec->catfile($tmpdir,$name);
    my $url       = "file:$name";
    return wantarray ? ($url,$path) : $path;
}

sub http_proxy {
  my $self   = shift;
  my $config = $self->config;
  my $proxy  = $config->setting('proxy') || '';
  return $config->setting('http proxy') || $proxy || '';

}

sub ftp_proxy {
  my $self   = shift;
  my $config = $self->config;
  my $proxy  = $config->setting('proxy') || '';
  return $config->setting('ftp proxy') || $proxy || '';
}

# ugly hack, but needed for performance gains when looking at really big data sets
sub probe_for_overview_sections {
  my $self = shift;
  my $fh   = shift;
  my $overview;
  my $pos = tell($fh);
  while (<$fh>) {
    next unless /\S/;       # skip blank lines
    last unless /[\#\[=]/;  # not a configuration section
    if (/^section\s*=.*(region|overview)/) {
      $overview++;
      last;
    }
  }
  seek($fh,$pos,0);
  return $overview;
}


1;