lib/Class/MOP/Deprecated.pm

   1 package Class::MOP::Deprecated;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp qw( cluck );
   7 use Scalar::Util qw( blessed );
   8
   9 our $VERSION = '0.96';
  10 $VERSION = eval $VERSION;
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 my %DeprecatedAt = (
  14
  15     # features deprecated before 0.93
  16     'Class::MOP::HAVE_ISAREV'           => 0.93,
  17     'Class::MOP::subname'               => 0.93,
  18     'Class::MOP::in_global_destruction' => 0.93,
  19
  20     'Class::MOP::Package::get_method_map' => 0.93,
  21
  22     'Class::MOP::Class::construct_class_instance'          => 0.93,
  23     'Class::MOP::Class::check_metaclass_compatibility'     => 0.93,
  24     'Class::MOP::Class::create_meta_instance'              => 0.93,
  25     'Class::MOP::Class::clone_instance'                    => 0.93,
  26     'Class::MOP::Class::alias_method'                      => 0.93,
  27     'Class::MOP::Class::compute_all_applicable_methods'    => 0.93,
  28     'Class::MOP::Class::compute_all_applicable_attributes' => 0.93,
  29     'Class::MOP::Class::get_attribute_map' => 0.95,
  30
  31     'Class::MOP::Instance::bless_instance_structure' => 0.93,
  32
  33     'Class::MOP::Attribute::process_accessors' => 0.93,
  34
  35     'Class::MOP::Method::Accessor::initialize_body'                  => 0.93,
  36     'Class::MOP::Method::Accessor::generate_accessor_method'         => 0.93,
  37     'Class::MOP::Method::Accessor::generate_reader_method'           => 0.93,
  38     'Class::MOP::Method::Accessor::generate_writer_method'           => 0.93,
  39     'Class::MOP::Method::Accessor::generate_predicate_method'        => 0.93,
  40     'Class::MOP::Method::Accessor::generate_clearer_method'          => 0.93,
  41     'Class::MOP::Method::Accessor::generate_accessor_method_inline'  => 0.93,
  42     'Class::MOP::Method::Accessor::generate_reader_method_inline'    => 0.93,
  43     'Class::MOP::Method::Accessor::generate_writer_method_inline'    => 0.93,
  44     'Class::MOP::Method::Accessor::generate_clearer_method_inline'   => 0.93,
  45     'Class::MOP::Method::Accessor::generate_predicate_method_inline' => 0.93,
  46
  47     'Class::MOP::Method::Constructor::meta_instance'               => 0.93,
  48     'Class::MOP::Method::Constructor::attributes'                  => 0.93,
  49     'Class::MOP::Method::Constructor::initialize_body'             => 0.93,
  50     'Class::MOP::Method::Constructor::generate_constructor_method' => 0.93,
  51     'Class::MOP::Method::Constructor::generate_constructor_method_inline' =>
  52         0.93,
  53
  54     # features deprecated after 0.93
  55     # ...
  56 );
  57
  58 my %Registry;
  59
  60 sub import {
  61     my ( $class, %args ) = @_;
  62
  63     if ( defined( my $compat_version = delete $args{-compatible} ) ) {
  64         $Registry{ (caller) } = $compat_version;
  65     }
  66
  67     if (%args) {
  68         my $unknowns = join q{ }, keys %args;
  69         cluck "Unknown argument(s) for $class->import: $unknowns.\n";
  70     }
  71     return;
  72 }
  73
  74 sub warn {
  75     my ( $package, undef, undef, $feature ) = caller(1);
  76
  77     my $compat_version;
  78     while ( $package && !defined( $compat_version = $Registry{$package} ) ) {
  79         $package =~ s/ :: \w+ \z//xms or last;
  80     }
  81
  82     my $deprecated_at = $DeprecatedAt{$feature}
  83         or die "Unregistered deprecated feature: $feature";
  84
  85     if ( !defined($compat_version)
  86         || $compat_version >= $DeprecatedAt{$feature} ) {
  87         goto &cluck;
  88     }
  89 }
  90
  91 package
  92     Class::MOP;
  93
  94 sub HAVE_ISAREV () {
  95     Class::MOP::Deprecated::warn(
  96         "Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway."
  97     );
  98     return 1;
  99 }
 100
 101 sub subname {
 102     Class::MOP::Deprecated::warn(
 103         "Class::MOP::subname is deprecated. Please use Sub::Name directly.");
 104     require Sub::Name;
 105     goto \&Sub::Name::subname;
 106 }
 107
 108 sub in_global_destruction {
 109     Class::MOP::Deprecated::warn(
 110         "Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly."
 111     );
 112     require Devel::GlobalDestruction;
 113     goto \&Devel::GlobalDestruction::in_global_destruction;
 114 }
 115
 116 package
 117     Class::MOP::Package;
 118
 119 sub get_method_map {
 120     Class::MOP::Deprecated::warn(
 121               'The get_method_map method has been made private.'
 122             . " The public version is deprecated and will be removed in a future release.\n"
 123     );
 124     my $self = shift;
 125
 126     my $map = $self->_full_method_map;
 127
 128     $map->{$_} = $self->get_method($_)
 129         for grep { !blessed( $map->{$_} ) } keys %{$map};
 130
 131     return $map;
 132 }
 133
 134 package
 135     Class::MOP::Module;
 136
 137 package
 138     Class::MOP::Class;
 139
 140 sub construct_class_instance {
 141     Class::MOP::Deprecated::warn(
 142               'The construct_class_instance method has been made private.'
 143             . " The public version is deprecated and will be removed in a future release.\n"
 144     );
 145     shift->_construct_class_instance(@_);
 146 }
 147
 148 sub check_metaclass_compatibility {
 149     Class::MOP::Deprecated::warn(
 150         'The check_metaclass_compatibility method has been made private.'
 151             . " The public version is deprecated and will be removed in a future release.\n"
 152     );
 153     shift->_check_metaclass_compatibility(@_);
 154 }
 155
 156 sub construct_instance {
 157     Class::MOP::Deprecated::warn(
 158               'The construct_instance method has been made private.'
 159             . " The public version is deprecated and will be removed in a future release.\n"
 160     );
 161     shift->_construct_instance(@_);
 162 }
 163
 164 sub create_meta_instance {
 165     Class::MOP::Deprecated::warn(
 166               'The create_meta_instance method has been made private.'
 167             . " The public version is deprecated and will be removed in a future release.\n"
 168     );
 169     shift->_create_meta_instance(@_);
 170 }
 171
 172 sub clone_instance {
 173     Class::MOP::Deprecated::warn(
 174               'The clone_instance method has been made private.'
 175             . " The public version is deprecated and will be removed in a future release.\n"
 176     );
 177     shift->_clone_instance(@_);
 178 }
 179
 180 sub alias_method {
 181     Class::MOP::Deprecated::warn(
 182         "The alias_method method is deprecated. Use add_method instead.\n");
 183
 184     shift->add_method(@_);
 185 }
 186
 187 sub compute_all_applicable_methods {
 188     Class::MOP::Deprecated::warn(
 189               'The compute_all_applicable_methods method is deprecated.'
 190             . " Use get_all_methods instead.\n" );
 191
 192     return map {
 193         {
 194             name  => $_->name,
 195             class => $_->package_name,
 196             code  => $_,                 # sigh, overloading
 197         },
 198     } shift->get_all_methods(@_);
 199 }
 200
 201 sub compute_all_applicable_attributes {
 202     Class::MOP::Deprecated::warn(
 203         'The compute_all_applicable_attributes method has been deprecated.'
 204             . " Use get_all_attributes instead.\n" );
 205
 206     shift->get_all_attributes(@_);
 207 }
 208
 209 sub get_attribute_map {
 210     Class::MOP::Deprecated::warn(
 211         "The get_attribute_map method has been deprecated.\n");
 212
 213     shift->_attribute_map(@_);
 214 }
 215
 216 package
 217     Class::MOP::Instance;
 218
 219 sub bless_instance_structure {
 220     Class::MOP::Deprecated::warn(
 221               'The bless_instance_structure method is deprecated.'
 222             . " It will be removed in a future release.\n" );
 223
 224     my ( $self, $instance_structure ) = @_;
 225     bless $instance_structure, $self->_class_name;
 226 }
 227
 228 package
 229     Class::MOP::Attribute;
 230
 231 sub process_accessors {
 232     Class::MOP::Deprecated::warn(
 233               'The process_accessors method has been made private.'
 234             . " The public version is deprecated and will be removed in a future release.\n"
 235     );
 236     shift->_process_accessors(@_);
 237 }
 238
 239 package
 240     Class::MOP::Method::Accessor;
 241
 242 sub initialize_body {
 243     Class::MOP::Deprecated::warn(
 244               'The initialize_body method has been made private.'
 245             . " The public version is deprecated and will be removed in a future release.\n"
 246     );
 247     shift->_initialize_body;
 248 }
 249
 250 sub generate_accessor_method {
 251     Class::MOP::Deprecated::warn(
 252               'The generate_accessor_method method has been made private.'
 253             . " The public version is deprecated and will be removed in a future release.\n"
 254     );
 255     shift->_generate_accessor_method;
 256 }
 257
 258 sub generate_reader_method {
 259     Class::MOP::Deprecated::warn(
 260               'The generate_reader_method method has been made private.'
 261             . " The public version is deprecated and will be removed in a future release.\n"
 262     );
 263     shift->_generate_reader_method;
 264 }
 265
 266 sub generate_writer_method {
 267     Class::MOP::Deprecated::warn(
 268               'The generate_writer_method method has been made private.'
 269             . " The public version is deprecated and will be removed in a future release.\n"
 270     );
 271     shift->_generate_writer_method;
 272 }
 273
 274 sub generate_predicate_method {
 275     Class::MOP::Deprecated::warn(
 276               'The generate_predicate_method method has been made private.'
 277             . " The public version is deprecated and will be removed in a future release.\n"
 278     );
 279     shift->_generate_predicate_method;
 280 }
 281
 282 sub generate_clearer_method {
 283     Class::MOP::Deprecated::warn(
 284               'The generate_clearer_method method has been made private.'
 285             . " The public version is deprecated and will be removed in a future release.\n"
 286     );
 287     shift->_generate_clearer_method;
 288 }
 289
 290 sub generate_accessor_method_inline {
 291     Class::MOP::Deprecated::warn(
 292         'The generate_accessor_method_inline method has been made private.'
 293             . " The public version is deprecated and will be removed in a future release.\n"
 294     );
 295     shift->_generate_accessor_method_inline;
 296 }
 297
 298 sub generate_reader_method_inline {
 299     Class::MOP::Deprecated::warn(
 300         'The generate_reader_method_inline method has been made private.'
 301             . " The public version is deprecated and will be removed in a future release.\n"
 302     );
 303     shift->_generate_reader_method_inline;
 304 }
 305
 306 sub generate_writer_method_inline {
 307     Class::MOP::Deprecated::warn(
 308         'The generate_writer_method_inline method has been made private.'
 309             . " The public version is deprecated and will be removed in a future release.\n"
 310     );
 311     shift->_generate_writer_method_inline;
 312 }
 313
 314 sub generate_predicate_method_inline {
 315     Class::MOP::Deprecated::warn(
 316         'The generate_predicate_method_inline method has been made private.'
 317             . " The public version is deprecated and will be removed in a future release.\n"
 318     );
 319     shift->_generate_predicate_method_inline;
 320 }
 321
 322 sub generate_clearer_method_inline {
 323     Class::MOP::Deprecated::warn(
 324         'The generate_clearer_method_inline method has been made private.'
 325             . " The public version is deprecated and will be removed in a future release.\n"
 326     );
 327     shift->_generate_clearer_method_inline;
 328 }
 329
 330 package
 331     Class::MOP::Method::Constructor;
 332
 333 sub meta_instance {
 334     Class::MOP::Deprecated::warn(
 335               'The meta_instance method has been made private.'
 336             . " The public version is deprecated and will be removed in a future release.\n"
 337     );
 338     shift->_meta_instance;
 339 }
 340
 341 sub attributes {
 342     Class::MOP::Deprecated::warn(
 343               'The attributes method has been made private.'
 344             . " The public version is deprecated and will be removed in a future release.\n"
 345     );
 346
 347     return shift->_attributes;
 348 }
 349
 350 sub initialize_body {
 351     Class::MOP::Deprecated::warn(
 352               'The initialize_body method has been made private.'
 353             . " The public version is deprecated and will be removed in a future release.\n"
 354     );
 355     shift->_initialize_body;
 356 }
 357
 358 sub generate_constructor_method {
 359     Class::MOP::Deprecated::warn(
 360               'The generate_constructor_method method has been made private.'
 361             . " The public version is deprecated and will be removed in a future release.\n"
 362     );
 363     shift->_generate_constructor_method;
 364 }
 365
 366 sub generate_constructor_method_inline {
 367     Class::MOP::Deprecated::warn(
 368         'The generate_constructor_method_inline method has been made private.'
 369             . " The public version is deprecated and will be removed in a future release.\n"
 370     );
 371     shift->_generate_constructor_method_inline;
 372 }
 373
 374 1;
 375
 376 __END__
 377
 378 =pod
 379
 380 =head1 NAME
 381
 382 Class::MOP::Deprecated - List of deprecated methods
 383
 384 =head1 DESCRIPTION
 385
 386     use Class::MOP::Deprecated -compatible => $version;
 387
 388 =head1 FUNCTIONS
 389
 390 This class provides methods that have been deprecated but remain for backward
 391 compatibility.
 392
 393 If you specify C<< -compatible => $version >>, you can use deprecated features
 394 without warnings. Note that this special treatment is limited to the package
 395 that loads C<Class::MOP::Deprecated>.
 396
 397 =head1 AUTHORS
 398
 399 Goro Fuji E<lt>gfuji@cpan.orgE<gt>
 400
 401 =head1 COPYRIGHT AND LICENSE
 402
 403 Copyright 2006-2009 by Infinity Interactive, Inc.
 404
 405 L<http://www.iinteractive.com>
 406
 407 This library is free software; you can redistribute it and/or modify
 408 it under the same terms as Perl itself.
 409
 410 =cut