Introduce the describe_class_methods() utility function
authorPeter Rabbitson <ribasushi@cpan.org>
Wed, 1 Jun 2016 08:46:28 +0000 (10:46 +0200)
committerPeter Rabbitson <ribasushi@cpan.org>
Tue, 7 Jun 2016 13:27:16 +0000 (15:27 +0200)
commit296248c321e75da7fd912ed80b8644aa3cdcccd6
tree1731aebd295c0969380eb6d82848ff790712abe0
parent5ab7259324b6e3d0feea533239b6d77db0b28c9c
Introduce the describe_class_methods() utility function

This code will be needed several commits later to tie together the hierarchy
validation work.

Returns a comprehensive list of methods and related trivia. This required
way more code than one would hope, this part of perl is *really* hateful.

Read test changes under -w

Everything is implemented on "bare metal" (no Package::Stash, very aggressive
caching) as this needs to be as efficient as possible. Currently timings on
old and new MRO are roughly such on a downclocked X201 / M540:

~/devel/dbic$ perlbrew exec --with 5.8.5,5.16.2,5.24.0_rc1 \
  perl -T -Ilib -It/lib -MDBICTest -MTime::HiRes=time -e '
    my $t0 = time;
    sub tstamp {
      printf "%.6f\n", time - $t0;
      $t0 = time;
    }

    tstamp();

    for ( (qw(
      DBICTest::Schema::Artist
      DBICTest::Schema::CD
      DBICTest::Schema::Track
      main
    )) x 2 ) {
      print "describing $_\n";
      DBIx::Class::_Util::describe_class_methods($_);
      tstamp();
    }
  '

5.8.5
==========
0.000005
describing DBICTest::Schema::Artist
0.224748
describing DBICTest::Schema::CD
0.066118
describing DBICTest::Schema::Track
0.090433
describing main
0.003152
describing DBICTest::Schema::Artist
0.038846
describing DBICTest::Schema::CD
0.038390
describing DBICTest::Schema::Track
0.043453
describing main
0.002128

5.16.2
==========
0.000005
describing DBICTest::Schema::Artist
0.077804
describing DBICTest::Schema::CD
0.007684
describing DBICTest::Schema::Track
0.013071
describing main
0.001073
describing DBICTest::Schema::Artist
0.000109
describing DBICTest::Schema::CD
0.000096
describing DBICTest::Schema::Track
0.000098
describing main
0.000041

5.24.0_rc1
==========
0.000005
describing DBICTest::Schema::Artist
0.044058
describing DBICTest::Schema::CD
0.006093
describing DBICTest::Schema::Track
0.011004
describing main
0.000735
describing DBICTest::Schema::Artist
0.000118
describing DBICTest::Schema::CD
0.000114
describing DBICTest::Schema::Track
0.000113
describing main
0.000059

Additional sanity-checking of this deceptively simple code was performed by
sad brute-forcing of the entire test schema set ( at the time of this commit
the cumulative sum output was 0x1a65e78e316348104ab9cdc3e474c79096 )

perlbrew exec --with 5.8.5,5.10.0,5.16.2,5.18.0,5.20.0,5.24.0_rc1 \
perl -T -Ilib -It/lib -MDBICTest -e '
  use Math::BigInt;
  use Digest::MD5 "md5_hex";
  use List::Util 'shuffle';
  use Data::Dumper::Concise;
  use DBIx::Class::_Util qw( describe_class_methods uniq );

  my $sum = Math::BigInt->new(0);

  for ( shuffle uniq sort map { ( defined Scalar::Util::blessed $_ ) ? ref $_ : $_ } (
    qw(
      DBIx::Class::ResultSource
      DBIx::Class::Core
      DBIx::Class::ResultSet
      DBICTest::Schema
    ),
    ( map {
      $_,
      $_->result_class,
      $_->resultset_class,
    } map { DBICTest::Schema->source($_) } DBICTest::Schema->sources ),
  ) ) {
    my $desc = describe_class_methods($_);

    # unstable between invocations
    delete $desc->{cumulative_gen};

    # only available on 5.10+
    delete $desc->{methods}{DOES};

    # only available on 5.18+
    delete $desc->{methods}{"(("};

    $sum += Math::BigInt->new( "0x" . md5_hex(Dumper($desc)) );
  }

  print $sum->as_hex;
'
lib/DBIx/Class/MethodAttributes.pm
lib/DBIx/Class/_Util.pm
t/52leaks.t
xt/extra/internals/attributes.t