view release on metacpan or  search on metacpan

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

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

# $Id: Database.pm 23607 2010-07-30 17:34:25Z cnvandev $
use strict;
use base 'Bio::Graphics::Browser2::UserTracks';
use Bio::Graphics::Browser2;
use Bio::Graphics::Browser2::UserDB;
use Bio::Graphics::Browser2::SendMail;
use DBI;
use Digest::MD5 qw(md5_hex);
use CGI qw(param url header());
use Carp qw(confess cluck);
use File::Path qw(rmtree);

sub _new {
    my $class = shift;
    my $self  = $class->SUPER::_new(@_);
    
    # Attempt to login to the database or die, and access the necessary tables or create them.
    my $globals     = $self->globals;
    my $credentials = $globals->user_account_db or warn "No credentials given to uploads DB in GBrowse.conf";
    my $uploadsdb   = DBI->connect($credentials);
    unless ($uploadsdb) {
        print header();
        print "Error: Could not open user account database. If you are the administrator, run gbrowse_metadb_config.pl";
        die "Could not open user account database with $credentials";
    }
    $self->uploadsdb($uploadsdb);
    
    # Check to see if user accounts are enabled, set some commonly-used variables.
    if ($globals->user_accounts) {
	# BUG: Two copies of UserDB; one here and one in the Render object
        $self->{userdb}   = Bio::Graphics::Browser2::UserDB->new($globals);
        $self->{username} = $self->{userdb}->username_from_sessionid($self->sessionid);
        $self->{userid}   = $self->{userdb}->userid_from_sessionid($self->sessionid);
    }
    
    return $self;
}

sub uploadsdb {
    my $self = shift;
    my $d    = $self->{uploadsdb};
    $self->{uploadsdb} = shift if @_;
    $d;
}

sub userdb   { shift->{userdb}   }
sub userid   { shift->{userid}   }
sub username { shift->{username} }

# Path - Returns the path to a specified file's owner's (or just the logged-in user's) data folder.
sub path {
    my $self = shift;
    my $file = shift;
    my ($userid, $uploadsid);
    if (defined $file) {
        my $userdb = $self->{userdb};
        $userid    = $self->owner($file);
        $uploadsid = $userdb->get_uploads_id($userid);
    }

    $uploadsid ||= $self->uploadsid;
    if ($uploadsid eq $self->uploadsid) {
	return $self->SUPER::path();
    } else {
	return $self->data_source->userdata($uploadsid);
    }
}

# Get File ID (File ID [, Owner ID]) - Returns a file's validated ID from the database.
sub get_file_id {
    my $self = shift;
    my $filename = shift;
    my $uploadsdb = $self->{uploadsdb};
    my $userid = $self->{userid};
    my $data_source = $self->{data_source};
    
    # First, check my files.
    my $uploads = $uploadsdb->selectrow_array("SELECT trackid FROM uploads WHERE path = ? AND userid = ? AND data_source = ?", undef, $filename, $userid, $data_source);
    return $uploads if $uploads;
    
    # Then, check files shared with me.
    my $shared = $uploadsdb->selectrow_array("SELECT DISTINCT uploads.trackid FROM uploads LEFT JOIN sharing ON uploads.trackid = sharing.trackid WHERE sharing.userid = ? AND uploads.path = ? AND (uploads.sharing_policy = ? OR uploads.sharing_policy ...
    return $shared if $shared;