view release on metacpan or  search on metacpan

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

    $settings->{favorites}={} if $clear;
    warn "show_favorites($settings->{show_favorites})" if DEBUG;
    $self->session->flush;
    return (204,'text/plain',undef);
}

sub ACTION_show_active_tracks {
    my $self = shift;
    my $q     = shift;
    my $active_only = $q->param('active') eq 'true';
    my $settings    = $self->state;
    $settings->{active_only}=$active_only;
    warn "show_active_tracks($settings->{active_only})" if DEBUG;
    $self->session->flush;
    return (204,'text/plain',undef);
}


# *** The Snapshot actions
sub ACTION_delete_snapshot {
    my $self = shift;
    my $q     = shift;
    my $name = $q->param('name');
    my $snapshots = $self->session->snapshots;
    delete $snapshots->{$name};
    $self->session->flush;
    return (204,'text/plain',undef);
}

sub ACTION_save_snapshot {
    my $self = shift;
    my $q     = shift;
    my $name  = $q->param('name');
    my $snapshots = $self->session->snapshots;
    my $settings  = $self->settings;
    my $imageURL  = $self->render->image_link($settings);

    my $UTCtime = strftime("%Y-%m-%d %H:%M:%S\n", gmtime(time));

    # Creating a deep copy of the snapshot
    my $snapshot = dclone $settings;
    $snapshot->{image_url}            = $imageURL;
    $snapshots->{$name}{data}         = $snapshot;
    $snapshots->{$name}{session_time} = $UTCtime;

    # Each snapshot has a unique snapshot_id (currently just an md5 sum of the unix time it is created
    my $snapshot_id = md5_hex(time);
    $snapshots->{$name}{snapshot_id}  = $snapshot_id;

    $self->session->flush;
    return (204,'text/plain',undef);
}

sub ACTION_set_snapshot {
     my $self = shift; 
     my $q = shift; 
     my $name = $q->param('name');
     my $settings  = $self->settings;
     my $snapshots = $self->session->snapshots;

     warn "[$$] get snapshot $name: $snapshots->{$name}" if DEBUG;

     %{$settings} = %{dclone $snapshots->{$name}{data}};

     my @selected_tracks  = $self->render->visible_tracks;
     my $segment_info     = $self->render->segment_info_object();
     $self->session->flush;

     return(200,'application/json',{tracks=>\@selected_tracks,segment_info=>$segment_info});
 }

sub ACTION_send_snapshot {
     my $self = shift; 
     my $q = shift; 
     my $name = $q->param('name');
     my $url  = $q->param('url');
     my $snapshots = $self->session->snapshots;

     my $settings = $self->state;
     my $id       = $self->session->uploadsid;

     my $globals = $self->render->globals;
     my $dir     = $globals->user_dir;

     my $filename = $snapshots->{$name}{snapshot_id};
     my $source   = $self->session->source;
         
     mkdir File::Spec->catfile($dir,$source,$id);
	
     #Storing the snapshot as a string and saving it to a textfile. Typical directory /var/lib/gbrowse2/userdata/{source}/{uploadid}: 
     my $snapshot = Dumper($snapshots->{$name}{data});
     open SNAPSHOT, ">$dir/$source/$id/$filename.txt" or die "Can't open $dir: $!";
     print SNAPSHOT "$snapshot";
     close SNAPSHOT;

     # The snapshot information is embedded into the URL
     $url = "$url?id=$id&snapname=$name&snapcode=$filename&source=$source";
     $url =~ s/ /%20/g;
     $self->session->flush;

     return(200,'text/plain',$url); 
 }

sub ACTION_mail_snapshot {
     my $self = shift; 
     my $q = shift; 

     my $name     = $q->param('name');
     my $to_email = $q->param('email');
     my $url      = $q->param('url');
     $url         =~ s/\?.+$//;

     my $settings = $self->state;
     my $snapshots = $self->session->snapshots;
     my $id = $self->session->uploadsid;
     my $source   = $self->session->source;

     my $globals = $self->render->globals;
     my $dir     = $globals->user_dir;

     my $filename = $snapshots->{$name}{snapshot_id};