added bin/remove-track.pl, a script to remove tracks from a jbrowse d…

…ata directory. fixes #42

bin/remove-track.pl

@@ -0,0 +1,57 @@
+#!/usr/bin/env perl
+
+use FindBin '$RealBin';
+use lib "$RealBin/../lib";
+use Script::RemoveTrack;
+
+exit Script::RemoveTrack->new(@ARGV)->run;
+
+__END__
+
+=head1 NAME
+
+remove-track.pl - remove a formatted track from a JBrowse data directory
+
+=head1 USAGE
+
+  remove-track.pl --trackLabel MyTrackLabel --dir path/to/data/dir
+
+=head1 DESCRIPTION
+
+Removes a track from a JBrowse data directory.  By default, only
+removes the track configuration entry so that JBrowse will not display
+the track.  If the C<--delete> option is passed, also removes the
+track data.  By default, this tool prints the track configuration JSON
+that it removed.  This can be turned of by passing the C<--quiet>
+option.
+
+=head1 OPTIONS
+
+=over 4
+
+=item --dir path/to/data/dir
+
+Path to the JBrowse data directory to operate on.
+
+=item --trackLabel MyLabel
+
+Track label(s) to delete.  This option may be specified multiple times
+to delete multiple tracks.
+
+=item --delete, -D
+
+In addition to removing the track configuration so that JBrowse will
+not display the track, delete the track data as well.  Be careful!
+
+=item -h, --help, -?
+
+Display an extended help message.
+
+=item -q, --quiet
+
+Do not print any progress messages.
+
+=back
+
+=cut
+

lib/Script/RemoveTrack.pm

@@ -0,0 +1,97 @@
+=head1 NAME
+
+Script::RemoveTrack - implemention of bin/remove-track.pl
+
+=head1 DESCRIPTION
+
+Do C<perldoc bin/remove-track.pl> to see usage documentation.
+
+=cut
+
+package Script::RemoveTrack;
+use strict;
+use warnings;
+
+use JSON 2 ();
+use File::Path ();
+use File::Spec;
+
+use JsonFileStorage;
+use base 'Script';
+
+sub option_defaults {
+    ( dir => 'data/' )
+}
+
+sub option_definitions {
+    (
+        shift->SUPER::option_definitions,
+        'dir|out=s',
+        'quiet|q',
+        'delete|D',
+        'trackLabel|tracklabel=s@',
+    );
+}
+
+sub run {
+    my ( $self ) = @_;
+    for my $label (@{$self->opt('trackLabel')}) {
+        $self->delete_track( $label );
+    }
+}
+
+sub delete_track {
+    my ( $self, $trackLabel ) = @_;
+
+    my $deleted_conf;
+
+    # remove the track configuration and print it
+    JsonFileStorage->new( $self->opt('dir') )
+                   ->modify( 'trackList.json', sub {
+                         my ( $json ) = @_;
+                         $json or die "The trackList.json file in ".$self->opt('dir')." could not be read.\n";
+                         $json->{tracks} = [
+                             map {
+                                 if( $_->{label} eq $trackLabel ) {
+                                     # print the json
+                                     $self->print( "removing track configuration:\n".JSON->new->encode( $_ ) );
+                                     $deleted_conf = $_;
+                                     ()
+                                 } else {
+                                     $_
+                                 }
+                             }
+                             @{$json->{tracks} || []}
+                         ];
+                         return $json;
+                     });
+
+    if( ! $deleted_conf ) {
+        $self->print( "No track found with label $trackLabel" );
+        return;
+    }
+
+    if( $self->opt('delete') ) {
+        # delete the track data
+        $self->print( "deleting track data for $trackLabel" );
+        my @trackdata_paths = (
+            File::Spec->catdir( $self->opt('dir'), 'tracks', $deleted_conf->{label} || die ),
+        );
+        if( !@trackdata_paths ) {
+            $self->print( "Unable to automatically remove track data for $trackLabel (type '$deleted_conf->{type}').  Please remove it manually." );
+        } else {
+            $self->print( "Deleting data for $trackLabel: @trackdata_paths" );
+            File::Path::rmtree( \@trackdata_paths );
+        }
+    } else {
+        $self->print( "--delete not specified; not deleting data directory for $trackLabel" );
+    }
+}
+
+sub print {
+    my $self = shift;
+    print( @_, "\n" ) unless $self->opt('quiet');
+    return;
+}
+
+1;

tests/perl_tests/remove-track.pl.t

@@ -0,0 +1,61 @@
+use strict;
+use warnings;
+
+use File::Temp;
+use Test::More;
+
+use File::Copy::Recursive 'dircopy';
+
+use lib 'tests/perl_tests/lib';
+use FileSlurping 'slurp';
+
+use Script::RemoveTrack;
+
+sub remove_track {
+    Script::RemoveTrack->new( '--quiet',  @_ )->run
+}
+
+{
+    my $tempdir = File::Temp->newdir;
+    dircopy( 'tests/data/volvox_formatted_refseqs', $tempdir );
+    remove_track( '--trackLabel' => 'DNA', '--dir' => $tempdir );
+
+    is_deeply( slurp( $tempdir, 'trackList.json' ),
+               { tracks => [], formatVersion => 1 },
+               'deleted the DNA track' );
+}
+
+{
+    my $tempdir = File::Temp->newdir;
+    dircopy( 'tests/data/hg19_formatted', $tempdir );
+
+    my $before = slurp( $tempdir, 'trackList.json' );
+
+    remove_track( '--trackLabel' => 'nonexistent!', '--dir' => $tempdir );
+
+    my $after = slurp( $tempdir, 'trackList.json' );
+    is_deeply( $before, $after, 'delete on nonexistent track does nothing' );
+
+    remove_track( '--trackLabel' => 'knownGene', '--dir' => $tempdir );
+
+    is_deeply( slurp( $tempdir, 'trackList.json' ),
+               { tracks => [], formatVersion => 1 },
+               'deleted the knownGenes track' );
+
+}
+
+{
+    my $tempdir = File::Temp->newdir;
+    dircopy( 'tests/data/hg19_formatted', $tempdir );
+
+    ok( -d "$tempdir/tracks/knownGene", 'track data dir is there' );
+    remove_track( '--delete', '--trackLabel' => 'knownGene', '--dir' => $tempdir );
+
+    is_deeply( slurp( $tempdir, 'trackList.json' ),
+               { tracks => [], formatVersion => 1 },
+               'deleted the knownGenes track' );
+    ok( ! -d "$tempdir/tracks/knownGene", 'track data dir is no longer there' );
+
+}
+
+done_testing;