Skip error/warn frames within CAG - saner callsite error messages this way
[dbsrgits/DBIx-Class.git] / maint / joint_deps.pl
1 #!/usr/bin/env perl
2
3 use warnings;
4 use strict;
5
6 use CPANDB;
7 use DBIx::Class::Schema::Loader 0.05;
8 use Data::Dumper::Concise;
9
10 {
11   package CPANDB::Schema;
12   use base qw/DBIx::Class::Schema::Loader/;
13
14   __PACKAGE__->loader_options (
15     naming => 'v5',
16   );
17 }
18
19 my $s = CPANDB::Schema->connect (sub { CPANDB->dbh } );
20
21 # reference names are unstable - just create rels manually
22 my $distrsrc = $s->source('Distribution');
23
24 # the has_many helper is a class-only method (why?), thus
25 # manual add_rel
26 $distrsrc->add_relationship (
27   'deps',
28   $s->class('Dependency'),
29   { 'foreign.distribution' => 'self.' . ($distrsrc->primary_columns)[0] },
30   { accessor => 'multi', join_type => 'left' },
31 );
32
33 # here is how one could use the helper currently:
34 #
35 #my $distresult = $s->class('Distribution');
36 #$distresult->has_many (
37 #  'deps',
38 #  $s->class('Dependency'),
39 #  'distribution',
40 #);
41 #$s->unregister_source ('Distribution');
42 #$s->register_class ('Distribution', $distresult);
43
44
45 # a proof of concept how to find out who uses us *AND* SQLT
46 my $us_and_sqlt = $s->resultset('Distribution')->search (
47   {
48     'deps.dependency' => 'DBIx-Class',
49     'deps_2.dependency' => 'SQL-Translator',
50   },
51   {
52     join => [qw/deps deps/],
53     order_by => 'me.author',
54     select => [ 'me.distribution', 'me.author', map { "$_.phase" } (qw/deps deps_2/)],
55     as => [qw/dist_name dist_author req_dbic_at req_sqlt_at/],
56     result_class => 'DBIx::Class::ResultClass::HashRefInflator',
57   },
58 );
59
60 print Dumper [$us_and_sqlt->all];