view release on metacpan or  search on metacpan

lib/Legacy/Graphics/Browser/Util.pm  view on Meta::CPAN

   "maintainer (".a({-href=>"mailto:$ENV{SERVER_ADMIN}"},$ENV{SERVER_ADMIN}).')'
     : 'maintainer';
  print p("Please contact this site's $webmaster for assistance.");
  print_bottom($CONFIG);
  exit 0;
}


sub early_error {
  my $lang = shift;
  my $msg  = shift;
  $msg     = $lang->tr($msg);
  warn "@_" if DEBUG;
  local $^W = 0;  # to avoid a warning from CGI.pm
  print_header(-expires=>'+1m');
  my @args = (-title  => 'GBrowse Error');
  push @args,(-lang=>$lang->language);
  print start_html();
  print b($msg);
  print end_html;
  exit 0;
}

sub set_language {
  my ($config,$lang) = @_;
  my $default_language   = $config->setting('language');
  my $accept         = http('Accept-language') || '';
  my @languages    = $accept =~ /([a-z]{2}-?[a-z]*)/ig;
  push @languages,$default_language if $default_language;
  warn "languages = ",join(',',@languages) if DEBUG;
  return unless @languages;
  $lang->language(@languages);
}

sub html_frag {
  my $fragname = shift;
  my $a = $CONFIG->config->setting(general => $fragname);
  return $a->(@_) if ref $a eq 'CODE';
  return $a || '';
}

sub patch_old_versions_of_bioperl {
  my $adaptor = shift;
  my %argv    = @_;
  local $^W = 0;
  require Bio::Perl;
  if ($adaptor eq 'Bio::DB::GFF' && $Bio::Perl::VERSION == 1.5) {
  eval <<'END';
use Bio::DB::GFF;
sub Bio::DB::GFF::load_gff {
  my $self              = shift;
  my $file_or_directory = shift || '.';
  my $verbose           = shift;

  local $self->{__verbose__} = $verbose;
  return $self->do_load_gff($file_or_directory) if ref($file_or_directory) 
                                                   && tied *$file_or_directory;

  my $tied_stdin = tied(*STDIN);
  open SAVEIN,"<&STDIN" unless $tied_stdin;
  local @ARGV = $self->setup_argv($file_or_directory,'gff','gff3') or return;  # to play tricks with reader
  my $result = $self->do_load_gff('ARGV');
  open STDIN,"<&SAVEIN" unless $tied_stdin;  # restore STDIN
  return $result;
}
sub Bio::DB::GFF::_load_gff_line {
  my $self = shift;
  my $line = shift;
  my $lineend = $self->{load_data}{lineend};

  $self->{load_data}{gff3_flag}++           if $line =~ /^\#\#\s*gff-version\s+3/;
  $self->preferred_groups(split(/\s+/,$1))  if $line =~ /^\#\#\s*group-tags?\s+(.+)/;

  if ($line =~ /^\#\#\s*sequence-region\s+(\S+)\s+(\d+)\s+(\d+)/i) { # header line
    $self->load_gff_line(
			 {
			  ref    => $1,
			  class  => 'Sequence',
			  source => 'reference',
			  method => 'Component',
			  start  => $2,
			  stop   => $3,
			  score  => undef,
			  strand => undef,
			  phase  => undef,
			  gclass => 'Sequence',
			  gname  => $1,
			  tstart => undef,
			  tstop  => undef,
			  attributes  => [],
			 }
			);
    return $self->{load_data}{count}++;
  }

  return if /^#/;

  my ($ref,$source,$method,$start,$stop,$score,$strand,$phase,$group) = split "\t",$line;
  return unless defined($ref) && defined($method) && defined($start) && defined($stop);
  foreach (\$score,\$strand,\$phase) {
    undef $$_ if $$_ eq '.';
  }

  print STDERR $self->{load_data}{count}," records$lineend" 
    if $self->{__verbose__} && $self->{load_data}{count} % 1000 == 0;

  my ($gclass,$gname,$tstart,$tstop,$attributes) = $self->split_group($group,$self->{load_data}{gff3_flag});

  # no standard way in the GFF file to denote the class of the reference sequence -- drat!
  # so we invoke the factory to do it
  my $class = $self->refclass($ref);

  # call subclass to do the dirty work
  if ($start > $stop) {
    ($start,$stop) = ($stop,$start);
    if ($strand eq '+') {
      $strand = '-';
    } elsif ($strand eq '-') {
      $strand = '+';
    }
  }