view release on metacpan or  search on metacpan

lib/Bio/Graphics/Browser2.pm  view on Meta::CPAN

sub create_data_source {
  my $self = shift;
  my $dsn  = shift;
  my $path = $self->data_source_path($dsn) or return;
  my ($regex_key) = grep { $dsn =~ /^$_$/ } map { $_ =~ s/^=~//; $_ } grep { $_ =~ /^=~/ } keys(%{$self->{config}});
  my $name = $dsn;
  if ($regex_key) { $dsn = "=~".$regex_key; }
  my $source = Bio::Graphics::Browser2::DataSource->new($path,
							$name,
							$self->data_source_description($dsn),
							$self) or return;
  if (my $adbs = $self->admin_dbs) {
      my $path  = File::Spec->catfile($adbs,$dsn);
      my $expr = "$path/*/*.conf";
      $source->add_conf_files($expr);
  }
  return $source;
}

sub max_features {
    my $self = shift;
    my $max = $self->setting(general => 'maximum features');
    return 5000 unless defined $max;
    return $max;
}

sub default_source {
  my $self    = shift;
  my $source  = $self->setting(general => 'default source');
  return $source if $self->valid_source($source);
  return ($self->data_sources)[0];
}

sub valid_source {
  my $self            = shift;
  my $proposed_source = shift;

  if (!exists($self->{config}{$proposed_source})) {
    my ($regex_key) = grep { $proposed_source =~ /^$_$/ } map { $_ =~ s/^=~//; $_ } grep { $_ =~ /^=~/ } keys(%{$self->{config}});
    return unless $regex_key;
    my $path =  $self->data_source_path("=~" . $regex_key) or return;
    return -e $path || $path =~ /\|\s*$/;
  }

  return unless exists $self->{config}{$proposed_source};
  my $path =  $self->data_source_path($proposed_source) or return;
  return -e $path || $path =~ /\|\s*$/;
}

sub get_source_from_cgi {
    my $self = shift;

    my $source = CGI::param('source') || CGI::param('src') || CGI::path_info();
    $source    =~ s!\#$!!;  # get rid of trailing # left by IE
    $source    =~ s!^/+!!;  # get rid of leading & trailing / from path_info()
    $source    =~ s!/+$!!;

    $source;
}

sub update_data_source {
  my $self    = shift;
  my $session    = shift;
  my $new_source = shift;
  my $old_source = $session->source || $self->default_source;

  $new_source ||= $self->get_source_from_cgi();

  my $source;
  if ($self->valid_source($new_source)) {
    $session->source($new_source);
    $source = $new_source;
  } else {
    my $fallback_source = $self->valid_source($old_source)
	? $old_source
	: $self->default_source;
    $session->source($fallback_source);
    $source = $fallback_source;
  }
  return $source;
}

sub time2sec {
    my $self = shift;
    my $time  = shift;
    $time =~ s/\s*#.*$//; # strip comments

    my(%mult) = ('s'=>1,
                 'm'=>60,
                 'h'=>60*60,
                 'd'=>60*60*24,
                 'w'=>60*60*24*7,
                 'M'=>60*60*24*30,
                 'y'=>60*60*24*365);
    my $offset = $time;
    if (!$time || (lc($time) eq 'now')) {
	$offset = 0;
    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdwMy])/) {
	$offset = ($mult{$2} || 1)*$1;
    }
    return $offset;
}

## methods for dealing with the session
sub session {
  my $self  = shift;
  my ($id,$mode) = @_;

  $id ||= undef;
  my @args       = (driver   => $self->session_driver,
                    args     => $self->session_args,
                    source   => $self->default_source,
                    lockdir  => $self->session_locks,
                    locktype => $self->session_locktype,
		    mode     => $mode || 'exclusive',
                    expires  => $self->remember_settings_time);
  return Bio::Graphics::Browser2::Session->new(@args,id => $id);
}

sub authorized_session {
  my $self                     = shift;