code_perl/Maasha/BGB/Common.pm

   1 package Maasha::BGB::Common;
   2
   3 # Copyright (C) 2009 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Common routines for manipulating the Biopieces Genome Browser.
  26
  27
  28 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  29
  30
  31 use warnings;
  32 use strict;
  33 use Data::Dumper;
  34 use Maasha::Common;
  35 use Maasha::Filesys;
  36 use Maasha::Biopieces;
  37
  38 use vars qw( @ISA @EXPORT );
  39
  40 @ISA = qw( Exporter );
  41
  42
  43 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  44
  45
  46 sub list_user_dir
  47 {
  48     # Martin A. Hansen, December 2009.
  49
  50     # List all users directories in the ~/Data/Users
  51     # directory with full path.
  52
  53     # Returns a list.
  54
  55     my ( @dirs, @users );
  56
  57     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
  58
  59     @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users" );
  60
  61     @users = grep { $_ !~ /\/\.\.?$/ } @dirs;
  62
  63     return wantarray ? @users : \@users;
  64 }
  65
  66
  67 sub list_users
  68 {
  69     # Martin A. Hansen, December 2009.
  70
  71     # List all users in ~/Data/Users
  72
  73     # Returns a list.
  74
  75     my ( @dirs, $dir, @users );
  76
  77     @dirs = list_user_dir();
  78
  79     foreach $dir ( @dirs ) {
  80         push @users, ( split "/", $dir )[ -1 ];
  81     }
  82
  83     return wantarray ? @users : \@users;
  84 }
  85
  86
  87 sub list_clade_dir
  88 {
  89     # Martin A. Hansen, December 2009.
  90
  91     # List all clades for a given user in ~/Data/Users
  92
  93     my ( $user,   # user for which to return clades
  94        ) = @_;
  95
  96     # Returns a list.
  97
  98     my ( @dirs, @clades );
  99
 100     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 101     Maasha::Common::error( 'no user specified' ) if not $user;
 102
 103     @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user" );
 104
 105     @clades = grep { $_ !~ /\/\.\.?$/ } @dirs;
 106
 107     return wantarray ? @clades : \@clades;
 108 }
 109
 110
 111 sub list_clades
 112 {
 113     # Martin A. Hansen, December 2009.
 114
 115     # List all clades for a given user in ~/Data/Users
 116
 117     my ( $user,   # user for which to return clades
 118        ) = @_;
 119
 120     # Returns a list.
 121
 122     my ( @dirs, $dir, @clades );
 123
 124     @dirs = list_clade_dir( $user );
 125
 126     foreach $dir ( @dirs ) {
 127         push @clades, ( split "/", $dir )[ -1 ];
 128     }
 129
 130     return wantarray ? @clades : \@clades;
 131 }
 132
 133
 134 sub list_genome_dir
 135 {
 136     # Martin A. Hansen, December 2009.
 137
 138     # List all genomes for a given user and clade in ~/Data/Users
 139
 140     my ( $user,    # user for which to return genomes
 141          $clade,   # clade for which to return genomes
 142        ) = @_;
 143
 144     # Returns a list.
 145
 146     my ( @dirs, @genomes );
 147
 148     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 149     Maasha::Common::error( 'no user specified' ) if not $user;
 150     Maasha::Common::error( 'no clade specified' ) if not $clade;
 151
 152     @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade" );
 153
 154     @genomes = grep { $_ !~ /\/\.\.?$/ } @dirs;
 155
 156     return wantarray ? @genomes : \@genomes;
 157 }
 158
 159
 160 sub list_genomes
 161 {
 162     # Martin A. Hansen, December 2009.
 163
 164     # List all genomes for a given user and clade in ~/Data/Users
 165
 166     my ( $user,    # user for which to return genomes
 167          $clade,   # clade for which to return genomes
 168        ) = @_;
 169
 170     # Returns a list.
 171
 172     my ( @dirs, $dir, @genomes );
 173
 174     @dirs = list_genome_dir( $user, $clade );
 175
 176     foreach $dir ( @dirs ) {
 177         push @genomes, ( split "/", $dir )[ -1 ];
 178     }
 179
 180     return wantarray ? @genomes : \@genomes;
 181 }
 182
 183
 184 sub list_assembly_dir
 185 {
 186     # Martin A. Hansen, December 2009.
 187
 188     # List all assemblies for a given user and clade and genome in ~/Data/Users
 189
 190     my ( $user,     # user for which to return assemblies
 191          $clade,    # clade for which to return assemblies
 192          $genome,   # genome for which to return assemblies
 193        ) = @_;
 194
 195     # Returns a list.
 196
 197     my ( @dirs, @assemblies );
 198
 199     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 200     Maasha::Common::error( 'no user specified' ) if not $user;
 201     Maasha::Common::error( 'no clade specified' ) if not $clade;
 202     Maasha::Common::error( 'no genome specified' ) if not $genome;
 203
 204     @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome" );
 205
 206     @assemblies = grep { $_ !~ /\/\.\.?$/ } @dirs;
 207
 208     return wantarray ? @assemblies : \@assemblies;
 209 }
 210
 211
 212 sub list_assemblies
 213 {
 214     # Martin A. Hansen, December 2009.
 215
 216     # List all assemblies for a given user and clade and genome in ~/Data/Users
 217
 218     my ( $user,     # user for which to return assemblies
 219          $clade,    # clade for which to return assemblies
 220          $genome,   # genome for which to return assemblies
 221        ) = @_;
 222
 223     # Returns a list.
 224
 225     my ( @dirs, $dir, @assemblies );
 226
 227     @dirs = list_assembly_dir( $user, $clade, $genome );
 228
 229     foreach $dir ( @dirs ) {
 230         push @assemblies, ( split "/", $dir )[ -1 ];
 231     }
 232
 233     return wantarray ? @assemblies : \@assemblies;
 234 }
 235
 236
 237 sub list_contig_dir
 238 {
 239     # Martin A. Hansen, December 2009.
 240
 241     # List all assemblies for a given user->clade->genome->assembly in ~/Data/Users
 242
 243     my ( $user,       # user for which to return contigs
 244          $clade,      # clade for which to return contigs
 245          $genome,     # genome for which to return contigs
 246          $assembly,   # assembly for which to return contigs
 247        ) = @_;
 248
 249     # Returns a list.
 250
 251     my ( @dirs, @contigs );
 252
 253     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 254     Maasha::Common::error( 'no user specified' ) if not $user;
 255     Maasha::Common::error( 'no clade specified' ) if not $clade;
 256     Maasha::Common::error( 'no genome specified' ) if not $genome;
 257     Maasha::Common::error( 'no assembly specified' ) if not $assembly;
 258
 259     @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly" );
 260
 261     @contigs = grep { $_ !~ /\/\.\.?$/ } @dirs;
 262
 263     return wantarray ? @contigs : \@contigs;
 264 }
 265
 266
 267 sub list_contigs
 268 {
 269     # Martin A. Hansen, December 2009.
 270
 271     # List all contigs for a given user->clade->genome->assembly in ~/Data/Users
 272
 273     my ( $user,       # user for which to return contigs
 274          $clade,      # clade for which to return contigs
 275          $genome,     # genome for which to return contigs
 276          $assembly,   # assembly for which to return contigs
 277        ) = @_;
 278
 279     # Returns a list.
 280
 281     my ( @dirs, $dir, @contigs );
 282
 283     @dirs = list_contig_dir( $user, $clade, $genome, $assembly );
 284
 285     foreach $dir ( @dirs ) {
 286         push @contigs, ( split "/", $dir )[ -1 ];
 287     }
 288
 289     return wantarray ? @contigs : \@contigs;
 290 }
 291
 292
 293 sub list_track_dir
 294 {
 295     # Martin A. Hansen, December 2009.
 296
 297     # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
 298
 299     my ( $user,       # user for which to return tracks
 300          $clade,      # clade for which to return tracks
 301          $genome,     # genome for which to return tracks
 302          $assembly,   # assembly for which to return tracks
 303          $contig,     # contig for which to return tracks
 304        ) = @_;
 305
 306     # Returns a list.
 307
 308     my ( @dirs, @tracks );
 309
 310     Maasha::Common::error( 'BP_WWW not set in environment' ) if not $ENV{ 'BP_WWW' };
 311     Maasha::Common::error( 'no user specified' ) if not $user;
 312     Maasha::Common::error( 'no clade specified' ) if not $clade;
 313     Maasha::Common::error( 'no genome specified' ) if not $genome;
 314     Maasha::Common::error( 'no assembly specified' ) if not $assembly;
 315     Maasha::Common::error( 'no contig specified' ) if not $contig;
 316
 317     if ( -d "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" ) {
 318         @dirs = Maasha::Filesys::ls_dirs( "$ENV{ 'BP_WWW' }/Data/Users/$user/$clade/$genome/$assembly/$contig/Tracks" );
 319     }
 320
 321     @tracks = grep { $_ !~ /\/\.\.?$/ } @dirs;
 322
 323     return wantarray ? @tracks : \@tracks;
 324 }
 325
 326
 327 sub list_tracks
 328 {
 329     # Martin A. Hansen, December 2009.
 330
 331     # List all tracks for a given user->clade->genome->assembly->contig in ~/Data/Users
 332
 333     my ( $user,       # user for which to return tracks
 334          $clade,      # clade for which to return tracks
 335          $genome,     # genome for which to return tracks
 336          $assembly,   # assembly for which to return tracks
 337          $contig,     # contig for which to return tracks
 338        ) = @_;
 339
 340     # Returns a list.
 341
 342     my ( @dirs, $dir, @tracks );
 343
 344     @dirs = list_track_dir( $user, $clade, $genome, $assembly, $contig );
 345
 346     foreach $dir ( @dirs ) {
 347         push @tracks, ( split "/", $dir )[ -1 ];
 348     }
 349
 350     return wantarray ? @tracks : \@tracks;
 351 }
 352
 353
 354 sub max_track
 355 {
 356     # Martin A. Hansen, December 2009.
 357
 358     # Traverses all contigs for a given user->clade->genome->assembly and
 359     # returns the maximum track's prefix value eg. 20 for 20_Genbank.
 360
 361     my ( $user,
 362          $clade,
 363          $genome,
 364          $assembly
 365        ) = @_;
 366
 367     # Returns an integer
 368
 369     my ( @contigs, $contig, @tracks, $max );
 370
 371     @contigs = list_contigs( $user, $clade, $genome, $assembly );
 372
 373     foreach $contig ( @contigs ) {
 374         push @tracks, list_tracks( $user, $clade, $genome, $assembly, $contig );
 375     }
 376
 377     @tracks = sort @tracks;
 378
 379     if ( scalar @tracks > 0 and $tracks[ -1 ] =~ /^(\d+)/ ) {
 380         $max = $1;
 381     } else {
 382         $max = 0;
 383     }
 384
 385     return $max;
 386 }
 387
 388
 389 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 390
 391
 392 1;