view release on metacpan or  search on metacpan

lib/Bio/EnsEMBL/Utils/URI.pm  view on Meta::CPAN

                The code takes a path, looks for the full path & if it cannot
                be found looks for the file a directory back. In the above
                example it would have looked for C</my/path.sqlite/table>,
                found it to be non-existant, looked for C</my/path.sqlite>
                and found it. 
                
                If the path splitting procdure resulted in just 1 file after
                the first existence check e.g. C<sqlite://db.sqlite> it assumes
                that should be the name. If no file can be found we default to
                the full length path.
  Caller      : internal

=cut

sub _decode_sqlite {
  my ($self) = @_;
  my $dbname;
  my $table;
  my $path = $self->path();
  if(-f $path) {
    $dbname = $path;
  }
  else {
    my ($volume, $directories, $file) = File::Spec->splitpath($path);
    my @splitdirs = File::Spec->splitdir($directories);
    if(@splitdirs == 1) {
      $dbname = $path;
    }
    else {
      my $new_file = pop(@splitdirs);
      $new_file ||= q{};
      my $new_path = File::Spec->catpath($volume, File::Spec->catdir(@splitdirs), $new_file);
      if($new_path ne File::Spec->rootdir() && -f $new_path) {
        $dbname = $new_path;
        $table = $file;
      }
      else {
        $dbname = $path;
      }
    }
  }
  
  $self->db_params()->{dbname} = $dbname if $dbname;
  $self->db_params()->{table} = $table if $table;
  
  return ($dbname, $table);
}

=head2 generate_uri()

  Description : Generates a URI string from the paramaters in this object
  Returntype  : String
  Exceptions  : None
  Status      : Stable

=cut

sub generate_uri {
  my ($self) = @_;
  my $scheme = sprintf('%s://', ($URI_ESCAPE) ? uri_escape($self->scheme()) : $self->scheme());
  my $user_credentials = q{};
  my $host_credentials = q{};
  my $location = q{};

  if($self->user() || $self->pass()) {
    my $user = $self->user();
    my $pass = $self->pass();
    if($URI_ESCAPE) {
      $user = uri_escape($user) if $user;
      $pass = uri_escape($pass) if $pass;
    }
    $user_credentials = sprintf('%s%s@',
      ( $user ? $user : q{} ),
      ( $pass ? q{:}.$pass : q{} )
    );
  }

  if($self->host() || $self->port()) {
    my $host = $self->host();
    my $port = $self->port();
    if($URI_ESCAPE) {
      $host = uri_escape($host) if $host;
      $port = uri_escape($port) if $port;
    }
    $host_credentials = sprintf('%s%s',
      ( $host ? $host : q{} ),
      ( $port ? q{:}.$port : q{} )
    );
  }

  if($self->is_db_scheme() || $self->scheme() eq '') {
    if($self->scheme() eq 'sqlite') {
      if(! $self->path()) {
        my $tmp_loc = $self->db_params()->{dbname};
        throw "There is no dbname available" unless $tmp_loc;
        $tmp_loc .= q{/}.$self->db_params()->{table} if $self->db_params()->{table};
        $self->path($tmp_loc);
      }
      $location = $self->path();
    }
    else {
      my $dbname = $self->db_params()->{dbname};
      my $table = $self->db_params()->{table};
      if($dbname || $table) {
        if($URI_ESCAPE) {
          $dbname = uri_escape($dbname) if $dbname;
          $table = uri_escape($table) if $table;
        }
        $location = sprintf('/%s%s',
          ($dbname ? $dbname : q{}),
          ($table ? q{/}.$table : q{})
        );
      }
    }
  }
  else {
    $location = $self->path() if $self->path();
  }

  my $param_string = q{};
  if(@{$self->param_keys()}) {
    $param_string = q{?};
    my @params;
    foreach my $key (@{$self->param_keys}) {
      my $values_array = $self->get_params($key);
      foreach my $value (@{$values_array}) {
        my $encoded_key = ($URI_ESCAPE) ? uri_escape($key) : $key;
        my $encoded_value = ($URI_ESCAPE) ? uri_escape($value) : $value;
        push(@params, ($encoded_value) ? "$encoded_key=$encoded_value" : $encoded_key);
      }
    }
    $param_string .= join(q{;}, @params);
  }

  return join(q{}, $scheme, $user_credentials, $host_credentials, $location, $param_string);
}

1;