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

Diff of /FigKernelPackages/P2Pupdate.pm

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

revision 1.39, Mon Dec 6 18:26:56 2004 UTC revision 1.40, Fri Dec 17 21:33:11 2004 UTC
# Line 1319  Line 1319 
1319    
1320      my(@conflict, $minor_conflict, $missing);      my(@conflict, $minor_conflict, $missing);
1321    
1322        #
1323        # Hashes for accumulating aggregate counts of conflicts.
1324        #
1325    
1326        my(%subs_in, %subs_out, %roles_in, %roles_out);
1327    
1328      $missing = [];      $missing = [];
1329    
1330      print "Determining conflicts...<p>\n";      print "Determining conflicts...<p>\n";
# Line 1397  Line 1403 
1403                  # such warnings (if I'm updating a subsystem, I can expect that the pegs in that                  # such warnings (if I'm updating a subsystem, I can expect that the pegs in that
1404                  # subsystem will change).                  # subsystem will change).
1405                  #                  #
1406                    # subsystems_for_peg returns a list of pairs [subsystem, role].
1407                    #
1408                    # There might be somethign of a discrepancy here. This only
1409                    # measures the subsystems the peg is actually currently part of, not
1410                    # the number of subsystems that have a role corresponding to the peg's
1411                    # current assignment.
1412                    #
1413    
1414                  my @removed = $fig->subsystems_for_peg($loc_peg);                  my @removed = $fig->subsystems_for_peg($loc_peg);
1415                  push(@$subs_removed, grep { $_->[0] ne $sub_name } @removed);  
1416                    for my $r (@removed)
1417                    {
1418                        my($rsub, $rrole) = @$r;
1419    
1420                        #
1421                        # Skip the numbers for an existing subsystem.
1422                        #
1423                        next if $rsub eq $sub_name;
1424    
1425                        $roles_out{$rrole}++;
1426                        $subs_out{$rsub}++;
1427    
1428                        push(@$subs_removed, $r);
1429                    }
1430    
1431                  #                  #
1432                  # We also check to see if the new function is present                  # We also check to see if the new function is present
1433                  # as a role in any local subsystem. If it is, then when that subsystem                  # as a role in any local subsystem. If it is, then when that subsystem
1434                  # is refilled, this peg will appear in it.                  # is refilled, this peg will appear in it.
1435                  #                  #
1436                  # This is also                  # $subsystem_)roles is a hash keyed on role name with each value
1437                    # a list of subsystem names.
1438                  #                  #
1439    
1440                  if (my $loc_ss = $subsystem_roles->{$ss_func})                  if (my $loc_ss = $subsystem_roles->{$ss_func})
1441                  {                  {
1442                        #
1443                        # $loc_ss is the set of subsystems that have the new
1444                        # function assignment as a role name.
1445                        #
1446                      push(@$subs_added, @$loc_ss);                      push(@$subs_added, @$loc_ss);
1447    
1448                        map { $subs_in{$_++} } @$loc_ss;
1449                        $roles_in{$ss_func}++;
1450                  }                  }
1451    
1452                  push(@conflict, [$ss_peg, $ss_func, $loc_peg, $loc_func, $subs_removed, $subs_added]);                  push(@conflict, [$ss_peg, $ss_func, $loc_peg, $loc_func, $subs_removed, $subs_added]);
# Line 1426  Line 1461 
1461    
1462      my $conflict = [sort { @{$b->[4]} + @{$b->[5]} <=> @{$a->[4]} + @{$a->[5]}  } @conflict];      my $conflict = [sort { @{$b->[4]} + @{$b->[5]} <=> @{$a->[4]} + @{$a->[5]}  } @conflict];
1463    
1464      return ($conflict, $missing);      my $aggreg = {
1465            roles_in => [keys(%roles_in)],
1466            roles_out => [keys(%roles_out)],
1467            subs_in => [keys(%subs_in)],
1468            subs_out => [keys(%subs_out)],
1469        };
1470    
1471        return ($conflict, $missing, $aggreg);
1472  }  }
1473    
1474  sub read_cached_analysis  sub read_cached_analysis

Legend:
Removed from v.1.39  
changed lines
  Added in v.1.40

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3