view release on metacpan or  search on metacpan

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

    my $globals    = $self->globals;

    my $description = $self->description($file);
    my $title       = $self->title($file);
    my $upload_name = $self->filename($file);
    my @labels      = $self->labels($file);
    my ($from_fullname,$from_email) = $userdb->accountinfo_from_username($self->username);
    $from_fullname                ||= $self->username;
    $from_fullname               .= " ($from_email)" if $from_email;
    my ($to_fullname,$to_email)     = $self->userdb->accountinfo_from_username($self->userdb->username_from_userid($recipient));
    return unless $to_email;

    my $gbrowse_link       = $globals->gbrowse_url.'/';
    my $gbrowse_show_link  = $gbrowse_link."?show=".Bio::Graphics::Browser2::Render->join_tracks(\@labels);
    my $gbrowse_readd_link = $gbrowse_link."?share_link=$file";

    my $source   = $self->data_source;

    my $subject  = Bio::Graphics::Browser2::Util->translate('SHARE_GROUP_EMAIL_SUBJECT',$source->description);
    my $contents = Bio::Graphics::Browser2::Util->translate('SHARE_GROUP_EMAIL',
							    $from_fullname,
							    $gbrowse_link,
							    $gbrowse_show_link,
							    $title,
							    $description,
							    join(',',map {$source->setting($_=>'key')||$_} @labels),
							    $gbrowse_readd_link);
    $contents = CGI::unescapeHTML($contents);
    $subject = CGI::unescapeHTML($subject);
    $self->Bio::Graphics::Browser2::SendMail::do_sendmail({
	from       => $globals->email_address,
	from_title => $globals->application_name,
	to         => $to_email,
	subject    => $subject,
	msg        => $contents},$globals);
}

# Field (Field, File ID[, Value]) - Returns (or, if defined, sets to the new value) the specified field of a file.
# This function is dangerous as it has direct access to the database and doesn't do any permissions checks (that's done at the individual field functions like title() and description().
# Make sure you set your permissions at the function level, and never put this into Action.pm or you'll be able to corrupt your database from a URL request!
sub field {
    my $self = shift;
    my $field = shift or return;
    my $file = shift or return;
    my $value = shift;
    my $uploadsdb = $self->{uploadsdb};
    
    if (defined $value) {
        #Clean up the string
        $value =~ s/^\s+//;
        $value =~ s/\s+$//; 
        my $result = $uploadsdb->do("UPDATE uploads SET $field = ? WHERE trackid = ?", undef, $value, $file);
        $self->update_modified($file);
        return $result;
    } else {
        return $uploadsdb->selectrow_array("SELECT $field FROM uploads WHERE trackid = ?", undef, $file);
    }
}

# Update Modified (File ID[, User ID]) - Updates the modification date/time of the specified file to right now.
sub update_modified {
    my $self = shift;
    my $uploadsdb = $self->{uploadsdb};
    my $file = shift or return;
    my $now = $self->nowfun;
    # Do not swap out this line for a field() call, since it's used inside field().
    return $uploadsdb->do("UPDATE uploads SET modification_date = $now WHERE trackid = " . $uploadsdb->quote($file));
}

# Created (File ID) - Returns creation date of $file, cannot be set.
sub created {
    my $self  = shift;
    my $file = shift or return;
    return $self->field("creation_date", $file);
}

# Modified (File ID) - Returns date modified of $file, cannot be set (except by update_modified()).
sub modified {
    my $self  = shift;
    my $file = shift or return;
       return $self->field("modification_date", $file);
}

# Description (File ID[, Value]) - Returns a file's description, or changes the current description if defined.
sub description {
    my $self  = shift;
    my $file = shift or return;
    my $value = shift;
    my $userid = $self->{userid};
    if ($value) {
        if ($self->is_mine($file)) {
            return $self->field("description", $file, $value)
        } else {
            warn "Change Description requested on $file by user #$userid, a non-owner.";
        }
    } else {
        return $self->field("description", $file)
    }
}

# Title (File ID[, Value]) - Returns a file's title, or changes the current title if defined.
sub title {
    my $self  = shift;
    my $file  = shift or return;
    my $value = shift;
    my $userid = $self->{userid};
    if ($value) {
        if ($self->is_mine($file)) {
            return $self->field("title", $file, $value)
        } else {
            warn "Change title requested on $file by user #$userid, a non-owner.";
        }
    } else {
        return $self->field("title", $file) || $self->field("path", $file);
    }
}

# Add File (Full Path[, Imported, Description, Sharing Policy, Owner's Uploads ID]) - Adds $file to the database under the current (or specified) owner.
sub add_file {
    my $self = shift;
    my $uploadsdb = $self->{uploadsdb};