[Bio] / FigKernelPackages / FIG.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/FIG.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.355, Thu Sep 1 09:30:07 2005 UTC revision 1.356, Thu Sep 1 18:14:53 2005 UTC
# Line 22  Line 22 
22  use Tracer;  use Tracer;
23  use GenomeIDMap;  use GenomeIDMap;
24    
25    our $haveDateParse;
26    eval {
27        require Date::Parse;
28        import Date::Parse;
29        $haveDateParse = 1;
30    };
31    
32  eval { require FigGFF; };  eval { require FigGFF; };
33  if ($@ and $ENV{USER} eq "olson") {  if ($@ and $ENV{USER} eq "olson") {
34      warn $@;      warn $@;
# Line 31  Line 38 
38  # Conditionally evaluate this in case its prerequisites are not available.  # Conditionally evaluate this in case its prerequisites are not available.
39  #  #
40    
41  our $ClearinghouseOK = eval {  our $ClearinghouseOK;
42    eval {
43      require Clearinghouse;      require Clearinghouse;
44        $ClearinghouseOK = 1;
45  };  };
46    
47  use IO::Socket;  use IO::Socket;
# Line 6877  Line 6886 
6886      return "$mm-$dd-$yr:$hr:$min:$sec";      return "$mm-$dd-$yr:$hr:$min:$sec";
6887  }  }
6888    
6889    =head3 parse_date
6890    
6891    usage: $date = $fig->parse_date(date-string)
6892    
6893    Parse a date string, returning seconds-since-the-epoch, or undef if the date did not parse.
6894    
6895    Accepted formats include an integer, which is assumed to be seconds-since-the-epoch an
6896    is just returned; MM/DD/YYYY;  or a date that can be parsed by the routines in
6897    the Date::Parse module.
6898    
6899    =cut
6900    
6901    sub parse_date
6902    {
6903        shift if UNIVERSAL::isa($_[0],__PACKAGE__);
6904    
6905        my($date) = @_;
6906    
6907        $date or return undef;
6908    
6909        my $epoch_date;
6910    
6911        if ($date =~ /^(\d{1,2})\/(\d{1,2})\/(\d{4})$/)
6912        {
6913            my($mm,$dd,$yyyy) = ($1,$2,$3);
6914            $epoch_date = &Time::Local::timelocal(0,0,0,$dd,$mm-1,$yyyy-1900,0,0,0);
6915        }
6916        elsif ($date =~ /^\d+$/)
6917        {
6918            $epoch_date = $date;
6919        }
6920        elsif ($haveDateParse)
6921        {
6922            $epoch_date = str2time($date);
6923        }
6924        return $epoch_date;
6925    }
6926    
6927  #  #
6928  # This now calls assignments_made_full and remaps the output.  # This now calls assignments_made_full and remaps the output.
6929  #  #
# Line 7056  Line 7103 
7103    
7104  sub annotations_made_fast  sub annotations_made_fast
7105  {  {
7106      my($self, $genomes, $start_time, $end_time) = @_;      my($self, $genomes, $start_time, $end_time, $anno_by, $replace_master_with_group) = @_;
7107    
7108        if (!defined($anno_by))
7109        {
7110            $anno_by = 'master';
7111        }
7112    
7113        if (!defined($genomes))
7114        {
7115            $genomes = [$self->genomes()];
7116        }
7117    
7118      my $group = $FIG_Config::group;      my $group = $FIG_Config::group;
7119    
# Line 7065  Line 7122 
7122      my $annos;      my $annos;
7123      my $pegs = {};      my $pegs = {};
7124    
7125        if ($start_time !~ /^\d+$/)
7126        {
7127            my $st = parse_date($start_time);
7128            if (!defined($st))
7129            {
7130                confess "annotations_made_fast: unparsable start time '$start_time'";
7131            }
7132            $start_time = $st;
7133        }
7134        if (defined($end_time))
7135        {
7136            if ($end_time !~ /^\d+$/)
7137            {
7138                my $et = parse_date($end_time);
7139                if (!defined($et))
7140                {
7141                    confess "annotations_made_fast: unparsable end time '$end_time'";
7142                }
7143                $end_time = $et;
7144            }
7145        }
7146        else
7147        {
7148            $end_time = time + 60;
7149        }
7150    
7151      #      #
7152      # We originally used a query to get the PEGs that needed to have annotations      # We originally used a query to get the PEGs that needed to have annotations
7153      # sent. Unfortunately, this performed very poorly due to all of the resultant      # sent. Unfortunately, this performed very poorly due to all of the resultant
# Line 7087  Line 7170 
7170      # annotations files searched.      # annotations files searched.
7171      #      #
7172    
7173        my $master_anno = $anno_by eq 'master';
7174    
7175      for my $genome (@$genomes)      for my $genome (@$genomes)
7176      {      {
7177          my $genome_dir = "$FIG_Config::organisms/$genome";          my $genome_dir = "$FIG_Config::organisms/$genome";
# Line 7096  Line 7181 
7181          my $afh;          my $afh;
7182          if (open($afh, "$genome_dir/annotations"))          if (open($afh, "$genome_dir/annotations"))
7183          {          {
7184              my($fid, $anno_time, $who, $anno_text);              my($fid, $anno_time, $who, $anno_text,$anno_who);
7185              local($/);              local($/);
7186              $/ = "//\n";              $/ = "//\n";
7187              while (my $ann = <$afh>)              while (my $ann = <$afh>)
7188              {              {
7189                  chomp $ann;                  chomp $ann;
7190    
7191                  if ((($fid, $anno_time, $who, $anno_text) =                  if ((($fid, $anno_time, $who, $anno_text, $anno_who) =
7192                       ($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\n(.*\S)/s)) and                       ($ann =~ /^(fig\|\d+\.\d+\.peg\.\d+)\n(\d+)\n(\S+)\n(Set\s+(\S+)\s+function\s+to.*)/s)) and
7193                      $anno_time >= $start_time and                      $anno_time >= $start_time and
7194                      $anno_time <= $end_time)                      $anno_time <= $end_time and
7195                        ($anno_by eq 'all' or ($master_anno ? ($anno_who eq 'FIG' or $anno_who eq 'master') : ($who eq $anno_by))))
7196                  {                  {
7197                      #                      #
7198                      # Update users list.                      # Update users list.
7199                      #                      #
7200    
7201                        if ($replace_master_with_group)
7202                        {
7203                      $anno_text =~ s/Set master function to/Set $group function to/;                      $anno_text =~ s/Set master function to/Set $group function to/;
7204                        }
7205    
7206                      my $anno = [$fid, $anno_time, $who, $anno_text];                      my $anno = [$fid, $anno_time, $who, $anno_text];
7207    

Legend:
Removed from v.1.355  
changed lines
  Added in v.1.356

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3