/contrib/gls.pl
https://bitbucket.org/cistrome/cistrome-harvard/ · Perl · 204 lines · 170 code · 30 blank · 4 comment · 8 complexity · 86442bf296dbea9b13c65eea468a0e43 MD5 · raw file
- #/!/usr/bin/env perl -w
- =head1 NAME
- gls
- =head1 DESCRIPTION
- Display the files generated by the current user within the local instance of Galaxy.
- Information is grouped by user's Galaxy histories and ordered by date/time
-
- =head1 OPTIONS
- - i|info = show more info about file [default = no]
- - e|error = show error files [default = no]
- - d|dirname = show files from this dirname (ie, history name) only (NOTE. if history name contains spaces, it should be quoted)
- - n|nocontent = show empty files [default = no]
- - a|altuser = supply an alternative username (nb, admin only)
- - h|help = help
- - m|man = man
- =head1 AUTHOR
- Simon McGowan, CBRG [Computational Biology Research Group, Oxford University, UK]
- =head1 Update Record
- 23/09/2010 001 S.McGowan first written
- =cut
- use strict;
- use Data::Dumper;
- use DBI;
- use Getopt::Long;
- use Pod::Usage;
- my $show_file_info = 0;
- my $show_error_files = 0;
- my $show_empty_files = 0;
- my $help = 0;
- my $man = 0;
- my $alt_user;
- my $selected_dir;
- GetOptions(
- 'h|help'=>\$help,
- 'm|man'=>\$man,
- 'i|info'=>\$show_file_info,
- 'e|error'=>\$show_error_files,
- 'a|altuser=s'=>\$alt_user,
- 'n|nocontent'=>\$show_empty_files,
- 'd|dirname=s'=>\$selected_dir
- );
- pod2usage(1) if $help;
- pod2usage(-verbose=>2) if $man;
- my %history_data;
- my %file_data;
- ############ CONFIG ########################################
- # list of admin usernames:
- my %admin;
- $admin{simonmcg} = '';
- $admin{stevetay} = '';
- # institute email domain
- my $email_domain = '@molbiol.ox.ac.uk';
- # mysql db
- my $mysql_database = 'galaxy';
- my $mysql_host = 'xxxxxxxx';
- my $mysql_username = 'xxxxxxxx';
- my $mysql_password = 'xxxxxxxx';
- # file path
- my $db_root_dir = '/wwwdata/galaxy-prod/database/files/';
- ##############################################################
- #-----------------------------------------------------------------------------------
- my $current_user = getlogin();
- # allow admin to list any user's galaxy files:
- if (exists($admin{$current_user}))
- {
- if ($alt_user) {$current_user = $alt_user;}
- }
- &get_data;
- &print_galaxy_data;
- exit();
- #-----------------------------------------------------------------------------------
- sub get_data
- {
- my $dbh = DBI->connect("DBI:mysql:database=$mysql_database;host=" . $mysql_host, $mysql_username, $mysql_password, {'RaiseError' => 1});
-
- my $sql = "SELECT h.id, h.name, h.create_time, hda.dataset_id, hda.update_time, hda.name, hda.info, hda.blurb, hda.extension, d.file_size
- FROM history h, history_dataset_association hda, galaxy_user g, dataset d
- WHERE g.email = '$current_user$email_domain'
- AND g.id = h.user_id
- AND h.id = hda.history_id
- AND hda.dataset_id = d.id";
-
- my $sth = $dbh->prepare($sql) or die("Failed to prepare statement $sql\n");
- $sth->execute() or die("Can't perform SQL $sql : $DBI::errstr\n");
- while (my $ref = $sth->fetch)
- {
- my ($history_id, $history_name, $create_time, $dataset_id, $dataset_time, $dataset_name, $info, $blurb, $ext, $file_size) = @{$ref};
-
- #print "$history_id, $history_name, $create_time, $dataset_id, $dataset_time, $dataset_name, $info, $blurb, $ext, $file_size\n\n";
-
- $history_data{$history_id}{create_time} = $create_time;
- $history_data{$history_id}{history_name} = $history_name;
-
- $file_data{$history_id}{$dataset_id}{dataset_update_time} = $dataset_time;
- $file_data{$history_id}{$dataset_id}{dataset_name} = $dataset_name;
- $file_data{$history_id}{$dataset_id}{info} = $info;
- $file_data{$history_id}{$dataset_id}{blurb} = $blurb;
- $file_data{$history_id}{$dataset_id}{file_size} = $file_size;
- $file_data{$history_id}{$dataset_id}{ext} = $ext;
- }
- $sth->finish;
- }
- sub print_galaxy_data
- {
- foreach my $hist_id (sort numerically keys %history_data)
- {
- my $hist_name = $history_data{$hist_id}{history_name};
- if ($selected_dir)
- {
- # if the user has opted to see just one dir...
- unless($hist_name eq $selected_dir) {next;}
- }
-
- my $hist_date = $history_data{$hist_id}{create_time};
-
- print "\n";
- print "$hist_date - $hist_name\n";
-
- foreach my $dataset_id (sort numerically keys %{$file_data{$hist_id}})
- {
- my $dataset_time = $file_data{$hist_id}{$dataset_id}{dataset_update_time};
- my $dataset_name = $file_data{$hist_id}{$dataset_id}{dataset_name};
- my $info = $file_data{$hist_id}{$dataset_id}{info};
- my $blurb = $file_data{$hist_id}{$dataset_id}{blurb};
- my $file_size = $file_data{$hist_id}{$dataset_id}{file_size};
- my $ext = $file_data{$hist_id}{$dataset_id}{ext};
- my $file_path = &derive_file_path($dataset_id);
-
- if (($blurb) and ($blurb eq 'empty'))
- {
- unless ($show_empty_files) {next;}
- }
- if (($blurb) and ($blurb eq 'error'))
- {
- unless ($show_error_files) {next;}
- }
-
- print "\t$dataset_time - $dataset_name";
- print " $file_path";
- if ($show_file_info)
- {
- print " [size:$file_size; type:$ext;";
- if (($info) and ($blurb)) { print " $info; $blurb"; }
- elsif ($info) { print " $info"; }
- elsif ($blurb) { print " $blurb"; }
- print ']';
- }
- print "\n";
- }
- }
- }
- sub derive_file_path
- {
- my ($dataset_id) = @_;
- my $dir = sprintf("%06d", $dataset_id);
- $dir =~ s/\d\d\d$//;
- my $full_path = $db_root_dir . $dir . '/dataset_' . $dataset_id . '.dat';
- return ($full_path);
- }
- sub numerically
- {
- $a <=> $b;
- }