[gitmo/Class-MOP.git] / lib / Class / MOP / Deprecated.pm

package Class::MOP::Deprecated;

use strict;
use warnings;
use Carp qw(cluck);

our $VERSION = '0.92_01';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';

my %DeprecatedAt = (

    # features deprecated before 0.93
    'Class::MOP::HAVE_ISAREV'           => 0.93,
    'Class::MOP::subname'               => 0.93,
    'Class::MOP::in_global_destruction' => 0.93,

    'Class::MOP::Package::get_method_map' => 0.93,

    'Class::MOP::Class::construct_class_instance'          => 0.93,
    'Class::MOP::Class::check_metaclass_compatibility'     => 0.93,
    'Class::MOP::Class::create_meta_instance'              => 0.93,
    'Class::MOP::Class::clone_instance'                    => 0.93,
    'Class::MOP::Class::alias_method'                      => 0.93,
    'Class::MOP::Class::compute_all_applicable_methods'    => 0.93,
    'Class::MOP::Class::compute_all_applicable_attributes' => 0.93,

    'Class::MOP::Instance::bless_instance_structure' => 0.93,

    'Class::MOP::Attribute::process_accessors' => 0.93,

    'Class::MOP::Method::Accessor::initialize_body'                  => 0.93,
    'Class::MOP::Method::Accessor::generate_accessor_method'         => 0.93,
    'Class::MOP::Method::Accessor::generate_reader_method'           => 0.93,
    'Class::MOP::Method::Accessor::generate_writer_method'           => 0.93,
    'Class::MOP::Method::Accessor::generate_predicate_method'        => 0.93,
    'Class::MOP::Method::Accessor::generate_clearer_method'          => 0.93,
    'Class::MOP::Method::Accessor::generate_accessor_method_inline'  => 0.93,
    'Class::MOP::Method::Accessor::generate_reader_method_inline'    => 0.93,
    'Class::MOP::Method::Accessor::generate_writer_method_inline'    => 0.93,
    'Class::MOP::Method::Accessor::generate_clearer_method_inline'   => 0.93,
    'Class::MOP::Method::Accessor::generate_predicate_method_inline' => 0.93,

    'Class::MOP::Method::Constructor::meta_instance'               => 0.93,
    'Class::MOP::Method::Constructor::attributes'                  => 0.93,
    'Class::MOP::Method::Constructor::initialize_body'             => 0.93,
    'Class::MOP::Method::Constructor::generate_constructor_method' => 0.93,
    'Class::MOP::Method::Constructor::generate_constructor_method_inline' =>
        0.93,

    # features deprecated after 0.93
    # ...
);

my %Registry;

sub import {
    my ( $class, %args ) = @_;

    if ( defined( my $compat_version = delete $args{-compatible} ) ) {
        $Registry{ (caller) } = $compat_version;
    }

    if (%args) {
        my $unknowns = join q{ }, keys %args;
        cluck "Unknown argument(s) for $class->import: $unknowns.\n";
    }
    return;
}

sub warn {
    my ( $package, undef, undef, $feature ) = caller(1);

    my $compat_version;
    while ( $package && !defined( $compat_version = $Registry{$package} ) ) {
        $package =~ s/ :: \w+ \z//xms or last;
    }

    my $deprecated_at = $DeprecatedAt{$feature}
        or die "Unregistered deprecated feature: $feature";

    if ( !defined($compat_version)
        || $compat_version >= $DeprecatedAt{$feature} ) {
        goto &cluck;
    }
}

package
    Class::MOP;

sub HAVE_ISAREV () {
    Class::MOP::Deprecated::warn(
        "Class::MOP::HAVE_ISAREV is deprecated and will be removed in a future release. It has always returned 1 anyway."
    );
    return 1;
}

sub subname {
    Class::MOP::Deprecated::warn(
        "Class::MOP::subname is deprecated. Please use Sub::Name directly.");
    require Sub::Name;
    goto \&Sub::Name::subname;
}

sub in_global_destruction {
    Class::MOP::Deprecated::warn(
        "Class::MOP::in_global_destruction is deprecated. Please use Devel::GlobalDestruction directly."
    );
    require Devel::GlobalDestruction;
    goto \&Devel::GlobalDestruction::in_global_destruction;
}

package
    Class::MOP::Package;

package
    Class::MOP::Module;

package
    Class::MOP::Class;

sub construct_class_instance {
    Class::MOP::Deprecated::warn(
              'The construct_class_instance method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_construct_class_instance(@_);
}

sub check_metaclass_compatibility {
    Class::MOP::Deprecated::warn(
        'The check_metaclass_compatibility method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_check_metaclass_compatibility(@_);
}

sub construct_instance {
    Class::MOP::Deprecated::warn(
              'The construct_instance method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_construct_instance(@_);
}

sub create_meta_instance {
    Class::MOP::Deprecated::warn(
              'The create_meta_instance method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_create_meta_instance(@_);
}

sub clone_instance {
    Class::MOP::Deprecated::warn(
              'The clone_instance method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_clone_instance(@_);
}

sub alias_method {
    Class::MOP::Deprecated::warn(
        "The alias_method method is deprecated. Use add_method instead.\n");

    shift->add_method(@_);
}

sub compute_all_applicable_methods {
    Class::MOP::Deprecated::warn(
              'The compute_all_applicable_methods method is deprecated.'
            . " Use get_all_methods instead.\n" );

    return map {
        {
            name  => $_->name,
            class => $_->package_name,
            code  => $_,                 # sigh, overloading
        },
    } shift->get_all_methods(@_);
}

sub compute_all_applicable_attributes {
    Class::MOP::Deprecated::warn(
        'The compute_all_applicable_attributes method has been deprecated.'
            . " Use get_all_attributes instead.\n" );

    shift->get_all_attributes(@_);
}

package
    Class::MOP::Instance;

sub bless_instance_structure {
    Class::MOP::Deprecated::warn(
              'The bless_instance_structure method is deprecated.'
            . " It will be removed in a future release.\n" );

    my ( $self, $instance_structure ) = @_;
    bless $instance_structure, $self->_class_name;
}

package
    Class::MOP::Attribute;

sub process_accessors {
    Class::MOP::Deprecated::warn(
              'The process_accessors method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_process_accessors(@_);
}

package
    Class::MOP::Method::Accessor;

sub initialize_body {
    Class::MOP::Deprecated::warn(
              'The initialize_body method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_initialize_body;
}

sub generate_accessor_method {
    Class::MOP::Deprecated::warn(
              'The generate_accessor_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_accessor_method;
}

sub generate_reader_method {
    Class::MOP::Deprecated::warn(
              'The generate_reader_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_reader_method;
}

sub generate_writer_method {
    Class::MOP::Deprecated::warn(
              'The generate_writer_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_writer_method;
}

sub generate_predicate_method {
    Class::MOP::Deprecated::warn(
              'The generate_predicate_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_predicate_method;
}

sub generate_clearer_method {
    Class::MOP::Deprecated::warn(
              'The generate_clearer_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_clearer_method;
}

sub generate_accessor_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_accessor_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_accessor_method_inline;
}

sub generate_reader_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_reader_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_reader_method_inline;
}

sub generate_writer_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_writer_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_writer_method_inline;
}

sub generate_predicate_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_predicate_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_predicate_method_inline;
}

sub generate_clearer_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_clearer_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_clearer_method_inline;
}

package
    Class::MOP::Method::Constructor;

sub meta_instance {
    Class::MOP::Deprecated::warn(
              'The meta_instance method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_meta_instance;
}

sub attributes {
    Class::MOP::Deprecated::warn(
              'The attributes method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );

    return shift->_attributes;
}

sub initialize_body {
    Class::MOP::Deprecated::warn(
              'The initialize_body method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_initialize_body;
}

sub generate_constructor_method {
    Class::MOP::Deprecated::warn(
              'The generate_constructor_method method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_constructor_method;
}

sub generate_constructor_method_inline {
    Class::MOP::Deprecated::warn(
        'The generate_constructor_method_inline method has been made private.'
            . " The public version is deprecated and will be removed in a future release.\n"
    );
    shift->_generate_constructor_method_inline;
}

1;

__END__

=pod

=head1 NAME 

Class::MOP::Deprecated - List of deprecated methods

=head1 DESCRIPTION

    use Class::MOP::Deprecated -compatible => $version;

=head1 FUNCTIONS

This class provides methods that have been deprecated but remain for backward compatibility.

If you specify C<< -compatible => $version >>, you can use deprecated features without warnings.
Note that this special treatment is package-scoped.

=over 4

=item B<Class::MOP::Deprecated::warn($message)>

Checks compatibility for the caller feature, and produces warnings if needed.

This function is used in internals.

=back

=head1 AUTHORS

Goro Fuji E<lt>gfuji@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006-2009 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

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