File Coverage

blib/lib/DBIx/Class/TopoSort.pm
Criterion Covered Total %
statement 11 34 32.3
branch 0 6 0.0
condition 0 3 0.0
subroutine 4 6 66.6
pod 2 2 100.0
total 17 51 33.3


line stmt bran cond sub pod time code
1             package DBIx::Class::TopoSort;
2              
3 7     7   1025742 use 5.008_004;
  7         20  
4              
5 7     7   21 use strict;
  7         8  
  7         138  
6 7     7   21 use warnings FATAL => 'all';
  7         12  
  7         336  
7              
8             our $VERSION = '0.050002';
9              
10 7     7   4053 use Graph;
  7         523058  
  7         1571  
11              
12             sub toposort_graph {
13 0     0 1   my $self = shift;
14 0           my ($schema, %opts) = @_;
15              
16 0           my $g = Graph->new;
17              
18 0           my @source_names = $schema->sources;
19              
20             my %table_source = map {
21 0           $schema->source($_)->name => $_
  0            
22             } @source_names;
23              
24 0           foreach my $name ( @source_names ) {
25 0           my $source = $schema->source($name);
26 0           $g->add_vertex($name);
27              
28 0           foreach my $rel_name ( $source->relationships ) {
29 0 0         next if grep { $_ eq $rel_name } @{$opts{skip}{$name}};
  0            
  0            
30 0           my $rel_info = $source->relationship_info($rel_name);
31              
32 0 0         if ( $rel_info->{attrs}{is_foreign_key_constraint} ) {
33             $g->add_edge(
34 0           $table_source{$schema->source($rel_info->{source})->name},
35             $name,
36             );
37             }
38             }
39             }
40              
41 0           return $g;
42             }
43              
44             sub toposort {
45 0     0 1   my $self = shift;
46 0           my $schema;
47 0 0 0       if (ref($self) && $self->isa('DBIx::Class::Schema')) {
48 0           $schema = $self;
49             }
50             else {
51 0           $schema = shift(@_);
52             }
53 0           return $self->toposort_graph($schema, @_)->toposort();
54             }
55              
56             1;
57             __END__
58              
59             =head1 NAME
60              
61             DBIx::Class::TopoSort - The addition of topological sorting to DBIx::Class
62              
63             =head1 SYNOPSIS
64              
65             Within your schema class:
66              
67             __PACKAGE__->load_components('TopoSort');
68              
69             Later:
70              
71             my $schema = Your::App::Schema->connect(...);
72             my @toposorted_sourcenames = $schema->toposort();
73              
74             If you have a cycle in your relationships
75              
76             my @toposorted_sourcenames = $schema->toposort(
77             skip => {
78             Artist => [qw/ first_album /],
79             },
80             );
81              
82             Alternately:
83              
84             my @toposorted_sourcenames = DBIx::Class::TopoSort->toposort($schema);
85              
86             =head1 DESCRIPTION
87              
88             This adds a method to L<DBIx::Class::Schema> which returns the full list of
89             sources (similar to L<DBIx::Class::Schema/sources>) in topological-sorted order.
90              
91             =head2 TOPOLOGICAL SORT
92              
93             A topological sort of the tables returns the list of tables such that any table
94             with a foreign key relationship appears after any table it has a foreign key
95             relationship to.
96              
97             =head1 METHODS
98              
99             This class is not instantiable nor does it provide any methods of its own. All
100             methods are added to the L<DBIx::Class::Schema> class and are callable on
101             objects instantiated of that class.
102              
103             =head2 toposort
104              
105             This is sugar for:
106              
107             $self->toposort_graph(@_)->toposort();
108              
109             Calling this method multiple times may return the list of source names in
110             different order. Each order will conform to the gurantee described in the
111             section on TOPOLOGICAL SORT.
112              
113             This method will throw an error if there are any cycles in your tables. You will
114             need to specify the skip parameter (described below) to break those cycles.
115              
116             =head2 toposort (Class method)
117              
118             Alternately, if you do not wish to use TopoSort as a component, you can call it
119             as a class method on this class. The toposort() method is smart enough to
120             distinguish.
121              
122             Note: toposort_graph() does B<not> distinguish - it assumes it will be called
123             with the C<$schema> object passed in.
124              
125             =head2 toposort_graph
126              
127             This returns a L<Graph> object with a vertex for every source and an edge for
128             every foreign key relationship.
129              
130             It takes the following parameters.
131              
132             =over 4
133              
134             =item skip
135              
136             This describes the list of relationships that should be ignored by the toposort
137             algorithm. This is generally used if you have cycles in your schema (though it
138             could possibly be useful in other ways, I guess). The value is a hashref. The
139             keys of this hashref are source names and the values are arrays of relationship
140             names.
141              
142             skip => {
143             Artist => [ qw/ first_album / ],
144             },
145              
146             =back
147              
148             =head1 SEE ALSO
149              
150             L<Graph/toposort>
151              
152             =head1 AUTHOR
153              
154             =over 4
155              
156             =item * Rob Kinyon <rob.kinyon@gmail.com>
157              
158             =back
159              
160             =head1 LICENSE
161              
162             Copyright (c) 2013 Rob Kinyon. All Rights Reserved.
163             This is free software, you may use it and distribute it under the same terms
164             as Perl itself.
165              
166             =cut