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];