[Rt-commit] [svn] r801 - in rt: . branches/rt-3.3/html/REST/2.0

[autrijus at pallas.eruditorum.org]

Author: autrijus
Date: Sat May  1 19:14:04 2004
New Revision: 801

Modified:
   rt/   (props changed)
   rt/branches/rt-3.3/html/REST/2.0/index
Log:
 ----------------------------------------------------------------------
 r4365 at not:  autrijus | 2004-05-01T23:14:05.342098Z
 
 * Cross-introspection logic to eliminate subordinate classes from main index.
 ----------------------------------------------------------------------


Modified: rt/branches/rt-3.3/html/REST/2.0/index
==============================================================================
--- rt/branches/rt-3.3/html/REST/2.0/index	(original)
+++ rt/branches/rt-3.3/html/REST/2.0/index	Sat May  1 19:14:04 2004
@@ -19,14 +19,42 @@
   <generator url="http://www.bestpractical.com/rt/" version="<% $RT::VERSION %>">RT</generator>
 </feed>
 <%INIT>
-my @types;
+my %collection_to_obj;
+my %record_to_collection;
 foreach my $key (keys %INC) {
     $key =~ m{^(RTx?(?:/.+)?/([^_/]+)).pm$}i or next;
     my ($class, $type) = ($1, $2);
     $class =~ s{/}{::}g;
-    $class->can('UnLimit') or (undef $class, next);
-    push @types, $type;
+    $class->can('NewItem') or next;
+    my $obj = eval {$class->new($session{CurrentUser})->NewItem} or next;
+    $collection_to_obj{$type} = $obj;
+    $record_to_collection{$1} = $type if ref($obj) =~ /(\w+)$/;
 }
+
+my @collection = sort keys %collection_to_obj;
+my @record = (
+    map {($_, $_."Id")} (qw(Member PrincipalType Object),
+    sort keys %record_to_collection)
+);
+
+my %gone;
+foreach my $type (@collection) {
+    my $obj = $collection_to_obj{$type} or next;
+
+    # First, eliminate collections that can be inferred from other objects
+    foreach my $method (@collection) {
+	$gone{$method}++ if $obj->can($method) or $obj->can("_$method");
+    }
+
+    # Next, eliminate normalization records with multiple parent fields 
+    my $score = 0;
+    foreach my $property (@record) {
+	$score++ if $obj->_Accessible($property, 'read');
+    }
+    $gone{$type}++ if $score > 1;
+}
+
+my @types = sort grep !$gone{$_}, keys %collection_to_obj;
 </%INIT>
 <%ARGS>
 $Path