added experimental use_next_version ・ 73f5463 ・ Gitprep

- added experimental use_next_version;
- Browse files
- Yuki Kimoto commited on 2011-11-16
- 1 parent e038c37
  
  commit 73f5463d359d8edc46da29289e9d9469f6bc740d

Showing 3 changed files with 691 additions and 0 deletions

Changes

...	...	@@ -1,4 +1,5 @@
1	1	0.1748
	2	+ - added EXPERIMETNAL use_next_version method
2	3	- DBIx::Custom::Query is DEPRECATED!
3	4	0.1747
4	5	- fixed bug DBIx::Custom::Result fetch_hash_multi throw warnings

+52

lib/DBIx/Custom.pm

View

...	...	@@ -18,6 +18,8 @@ use DBIx::Custom::Mapper;
18	18	use DBIx::Custom::NotExists;
19	19	use Encode qw/encode encode_utf8 decode_utf8/;
20	20	use Scalar::Util qw/weaken/;
	21	+use DBIx::Custom::Class::Inspector;
	22	+
21	23
22	24	has [qw/connector dsn password quote user exclude_table user_table_info
23	25	user_column_info/],
...	...	@@ -1181,6 +1183,49 @@ sub update_timestamp {
1181	1183	return $self->{update_timestamp};
1182	1184	}
1183	1185
	1186	+sub use_next_version {
	1187	+ my $self = shift;
	1188	+
	1189	+ my @modules = ('', qw/::Where ::Util ::Result ::Order ::NotExists ::Model ::Mapper/);
	1190	+
	1191	+ # Replace
	1192	+ for my $module (@modules) {
	1193	+ my $old = 'DBIx::Custom' . $module;
	1194	+ my $new = 'DBIx::Custom::Next' . $module;
	1195	+
	1196	+ no strict 'refs';
	1197	+ no warnings 'redefine';
	1198	+ eval "require $old";
	1199	+ die $@ if $@;
	1200	+ eval "require $new";
	1201	+ die $@ if $@;
	1202	+ for my $method (@{DBIx::Custom::Class::Inspector->methods( $old, 'full', 'public' )}) {
	1203	+ next unless $method =~ /^DBIx::Custom/;
	1204	+ undef &{"$method"};
	1205	+ *{"$method"} = sub { die "$method method is removed" };
	1206	+ }
	1207	+
	1208	+ for my $new_method (@{DBIx::Custom::Class::Inspector->methods( $new, 'full', 'public' )}) {
	1209	+ next unless $new_method =~ /^DBIx::Custom/;
	1210	+ my $old_method = $new_method;
	1211	+ $old_method =~ s/::Next//;
	1212	+ *{"$old_method"} = \&{"$new_method"};
	1213	+ }
	1214	+ }
	1215	+
	1216	+ # Remove
	1217	+ for my $module (qw/DBIx::Custom::Tag DBIx::Custom::QueryBuilder/) {
	1218	+ no strict 'refs';
	1219	+ eval "require $module";
	1220	+ die $@ if $@;
	1221	+ for my $method (@{DBIx::Custom::Class::Inspector->methods( $module, 'full', 'public' )}) {
	1222	+ next unless $method =~ /^DBIx::Custom/;
	1223	+ undef &{"$method"};
	1224	+ *{"$method"} = sub { die "$method method is removed" };
	1225	+ }
	1226	+ }
	1227	+}
	1228	+
1184	1229	sub values_clause {
1185	1230	my ($self, $param, $opts) = @_;
1186	1231
...	...	@@ -3368,6 +3413,13 @@ Show type name of the columns of specified table.
3368	3413
3369	3414	This type name is used in C<type_rule>'s C<into1> and C<into2>.
3370	3415
	3416	+=head2 C<use_next_version EXPERIMENTAL>
	3417	+
	3418	+ DBIx::Custom->use_next_version;
	3419	+
	3420	+Upgrade next major version L<DBIx::Custom>.
	3421	+You can't use DEPRECATED method no more and method performance is improved.
	3422	+
3371	3423	=head2 C<values_clause>
3372	3424
3373	3425	my $values_clause = $dbi->values_clause({title => 'a', age => 2});

+638

lib/DBIx/Custom/Class/Inspector.pm

View

...	...	@@ -0,0 +1,638 @@
	1	+package DBIx::Custom::Class::Inspector;
	2	+
	3	+=pod
	4	+
	5	+=head1 NAME
	6	+
	7	+DBIx::Custom::Class::Inspector - Internal use (Same as Class::Inspector)
	8	+
	9	+=head1 SYNOPSIS
	10	+
	11	+ use Class::Inspector;
	12	+
	13	+ # Is a class installed and/or loaded
	14	+ Class::Inspector->installed( 'Foo::Class' );
	15	+ Class::Inspector->loaded( 'Foo::Class' );
	16	+
	17	+ # Filename related information
	18	+ Class::Inspector->filename( 'Foo::Class' );
	19	+ Class::Inspector->resolved_filename( 'Foo::Class' );
	20	+
	21	+ # Get subroutine related information
	22	+ Class::Inspector->functions( 'Foo::Class' );
	23	+ Class::Inspector->function_refs( 'Foo::Class' );
	24	+ Class::Inspector->function_exists( 'Foo::Class', 'bar' );
	25	+ Class::Inspector->methods( 'Foo::Class', 'full', 'public' );
	26	+
	27	+ # Find all loaded subclasses or something
	28	+ Class::Inspector->subclasses( 'Foo::Class' );
	29	+
	30	+=head1 DESCRIPTION
	31	+
	32	+Class::Inspector allows you to get information about a loaded class. Most or
	33	+all of this information can be found in other ways, but they aren't always
	34	+very friendly, and usually involve a relatively high level of Perl wizardry,
	35	+or strange and unusual looking code. Class::Inspector attempts to provide
	36	+an easier, more friendly interface to this information.
	37	+
	38	+=head1 METHODS
	39	+
	40	+=cut
	41	+
	42	+use 5.006;
	43	+# We don't want to use strict refs anywhere in this module, since we do a
	44	+# lot of things in here that aren't strict refs friendly.
	45	+use strict qw{vars subs};
	46	+use warnings;
	47	+use File::Spec ();
	48	+
	49	+# Globals
	50	+use vars qw{$VERSION $RE_IDENTIFIER $RE_CLASS $UNIX};
	51	+BEGIN {
	52	+ $VERSION = '1.25';
	53	+
	54	+ # If Unicode is available, enable it so that the
	55	+ # pattern matches below match unicode method names.
	56	+ # We can safely ignore any failure here.
	57	+ SCOPE: {
	58	+ local $@;
	59	+ eval "require utf8; utf8->import";
	60	+ }
	61	+
	62	+ # Predefine some regexs
	63	+ $RE_IDENTIFIER = qr/\A[^\W\d]\w*\z/s;
	64	+ $RE_CLASS = qr/\A[^\W\d]\w(?:(?:\'\|::)\w+)\z/s;
	65	+
	66	+ # Are we on something Unix-like?
	67	+ $UNIX = !! ( $File::Spec::ISA[0] eq 'File::Spec::Unix' );
	68	+}
	69	+
	70	+
	71	+
	72	+
	73	+
	74	+#####################################################################
	75	+# Basic Methods
	76	+
	77	+=pod
	78	+
	79	+=head2 installed $class
	80	+
	81	+The C<installed> static method tries to determine if a class is installed
	82	+on the machine, or at least available to Perl. It does this by wrapping
	83	+around C<resolved_filename>.
	84	+
	85	+Returns true if installed/available, false if the class is not installed,
	86	+or C<undef> if the class name is invalid.
	87	+
	88	+=cut
	89	+
	90	+sub installed {
	91	+ my $class = shift;
	92	+ !! ($class->loaded_filename($_[0]) or $class->resolved_filename($_[0]));
	93	+}
	94	+
	95	+=pod
	96	+
	97	+=head2 loaded $class
	98	+
	99	+The C<loaded> static method tries to determine if a class is loaded by
	100	+looking for symbol table entries.
	101	+
	102	+This method it uses to determine this will work even if the class does not
	103	+have its own file, but is contained inside a single file with multiple
	104	+classes in it. Even in the case of some sort of run-time loading class
	105	+being used, these typically leave some trace in the symbol table, so an
	106	+L<Autoload> or L<Class::Autouse>-based class should correctly appear
	107	+loaded.
	108	+
	109	+Returns true if the class is loaded, false if not, or C<undef> if the
	110	+class name is invalid.
	111	+
	112	+=cut
	113	+
	114	+sub loaded {
	115	+ my $class = shift;
	116	+ my $name = $class->_class(shift) or return undef;
	117	+ $class->_loaded($name);
	118	+}
	119	+
	120	+sub _loaded {
	121	+ my $class = shift;
	122	+ my $name = shift;
	123	+
	124	+ # Handle by far the two most common cases
	125	+ # This is very fast and handles 99% of cases.
	126	+ return 1 if defined ${"${name}::VERSION"};
	127	+ return 1 if defined @{"${name}::ISA"};
	128	+
	129	+ # Are there any symbol table entries other than other namespaces
	130	+ foreach ( keys %{"${name}::"} ) {
	131	+ next if substr($_, -2, 2) eq '::';
	132	+ return 1 if defined &{"${name}::$_"};
	133	+ }
	134	+
	135	+ # No functions, and it doesn't have a version, and isn't anything.
	136	+ # As an absolute last resort, check for an entry in %INC
	137	+ my $filename = $class->_inc_filename($name);
	138	+ return 1 if defined $INC{$filename};
	139	+
	140	+ '';
	141	+}
	142	+
	143	+=pod
	144	+
	145	+=head2 filename $class
	146	+
	147	+For a given class, returns the base filename for the class. This will NOT
	148	+be a fully resolved filename, just the part of the filename BELOW the
	149	+C<@INC> entry.
	150	+
	151	+ print Class->filename( 'Foo::Bar' );
	152	+ > Foo/Bar.pm
	153	+
	154	+This filename will be returned with the right seperator for the local
	155	+platform, and should work on all platforms.
	156	+
	157	+Returns the filename on success or C<undef> if the class name is invalid.
	158	+
	159	+=cut
	160	+
	161	+sub filename {
	162	+ my $class = shift;
	163	+ my $name = $class->_class(shift) or return undef;
	164	+ File::Spec->catfile( split /(?:\'\|::)/, $name ) . '.pm';
	165	+}
	166	+
	167	+=pod
	168	+
	169	+=head2 resolved_filename $class, @try_first
	170	+
	171	+For a given class, the C<resolved_filename> static method returns the fully
	172	+resolved filename for a class. That is, the file that the class would be
	173	+loaded from.
	174	+
	175	+This is not nescesarily the file that the class WAS loaded from, as the
	176	+value returned is determined each time it runs, and the C<@INC> include
	177	+path may change.
	178	+
	179	+To get the actual file for a loaded class, see the C<loaded_filename>
	180	+method.
	181	+
	182	+Returns the filename for the class, or C<undef> if the class name is
	183	+invalid.
	184	+
	185	+=cut
	186	+
	187	+sub resolved_filename {
	188	+ my $class = shift;
	189	+ my $filename = $class->_inc_filename(shift) or return undef;
	190	+ my @try_first = @_;
	191	+
	192	+ # Look through the @INC path to find the file
	193	+ foreach ( @try_first, @INC ) {
	194	+ my $full = "$_/$filename";
	195	+ next unless -e $full;
	196	+ return $UNIX ? $full : $class->_inc_to_local($full);
	197	+ }
	198	+
	199	+ # File not found
	200	+ '';
	201	+}
	202	+
	203	+=pod
	204	+
	205	+=head2 loaded_filename $class
	206	+
	207	+For a given loaded class, the C<loaded_filename> static method determines
	208	+(via the C<%INC> hash) the name of the file that it was originally loaded
	209	+from.
	210	+
	211	+Returns a resolved file path, or false if the class did not have it's own
	212	+file.
	213	+
	214	+=cut
	215	+
	216	+sub loaded_filename {
	217	+ my $class = shift;
	218	+ my $filename = $class->_inc_filename(shift);
	219	+ $UNIX ? $INC{$filename} : $class->_inc_to_local($INC{$filename});
	220	+}
	221	+
	222	+
	223	+
	224	+
	225	+
	226	+#####################################################################
	227	+# Sub Related Methods
	228	+
	229	+=pod
	230	+
	231	+=head2 functions $class
	232	+
	233	+For a loaded class, the C<functions> static method returns a list of the
	234	+names of all the functions in the classes immediate namespace.
	235	+
	236	+Note that this is not the METHODS of the class, just the functions.
	237	+
	238	+Returns a reference to an array of the function names on success, or C<undef>
	239	+if the class name is invalid or the class is not loaded.
	240	+
	241	+=cut
	242	+
	243	+sub functions {
	244	+ my $class = shift;
	245	+ my $name = $class->_class(shift) or return undef;
	246	+ return undef unless $class->loaded( $name );
	247	+
	248	+ # Get all the CODE symbol table entries
	249	+ my @functions = sort grep { /$RE_IDENTIFIER/o }
	250	+ grep { defined &{"${name}::$_"} }
	251	+ keys %{"${name}::"};
	252	+ \@functions;
	253	+}
	254	+
	255	+=pod
	256	+
	257	+=head2 function_refs $class
	258	+
	259	+For a loaded class, the C<function_refs> static method returns references to
	260	+all the functions in the classes immediate namespace.
	261	+
	262	+Note that this is not the METHODS of the class, just the functions.
	263	+
	264	+Returns a reference to an array of C<CODE> refs of the functions on
	265	+success, or C<undef> if the class is not loaded.
	266	+
	267	+=cut
	268	+
	269	+sub function_refs {
	270	+ my $class = shift;
	271	+ my $name = $class->_class(shift) or return undef;
	272	+ return undef unless $class->loaded( $name );
	273	+
	274	+ # Get all the CODE symbol table entries, but return
	275	+ # the actual CODE refs this time.
	276	+ my @functions = map { \&{"${name}::$_"} }
	277	+ sort grep { /$RE_IDENTIFIER/o }
	278	+ grep { defined &{"${name}::$_"} }
	279	+ keys %{"${name}::"};
	280	+ \@functions;
	281	+}
	282	+
	283	+=pod
	284	+
	285	+=head2 function_exists $class, $function
	286	+
	287	+Given a class and function name the C<function_exists> static method will
	288	+check to see if the function exists in the class.
	289	+
	290	+Note that this is as a function, not as a method. To see if a method
	291	+exists for a class, use the C<can> method for any class or object.
	292	+
	293	+Returns true if the function exists, false if not, or C<undef> if the
	294	+class or function name are invalid, or the class is not loaded.
	295	+
	296	+=cut
	297	+
	298	+sub function_exists {
	299	+ my $class = shift;
	300	+ my $name = $class->_class( shift ) or return undef;
	301	+ my $function = shift or return undef;
	302	+
	303	+ # Only works if the class is loaded
	304	+ return undef unless $class->loaded( $name );
	305	+
	306	+ # Does the GLOB exist and its CODE part exist
	307	+ defined &{"${name}::$function"};
	308	+}
	309	+
	310	+=pod
	311	+
	312	+=head2 methods $class, @options
	313	+
	314	+For a given class name, the C<methods> static method will returns ALL
	315	+the methods available to that class. This includes all methods available
	316	+from every class up the class' C<@ISA> tree.
	317	+
	318	+Returns a reference to an array of the names of all the available methods
	319	+on success, or C<undef> if the class name is invalid or the class is not
	320	+loaded.
	321	+
	322	+A number of options are available to the C<methods> method that will alter
	323	+the results returned. These should be listed after the class name, in any
	324	+order.
	325	+
	326	+ # Only get public methods
	327	+ my $method = Class::Inspector->methods( 'My::Class', 'public' );
	328	+
	329	+=over 4
	330	+
	331	+=item public
	332	+
	333	+The C<public> option will return only 'public' methods, as defined by the Perl
	334	+convention of prepending an underscore to any 'private' methods. The C<public>
	335	+option will effectively remove any methods that start with an underscore.
	336	+
	337	+=item private
	338	+
	339	+The C<private> options will return only 'private' methods, as defined by the
	340	+Perl convention of prepending an underscore to an private methods. The
	341	+C<private> option will effectively remove an method that do not start with an
	342	+underscore.
	343	+
	344	+B<Note: The C<public> and C<private> options are mutually exclusive>
	345	+
	346	+=item full
	347	+
	348	+C<methods> normally returns just the method name. Supplying the C<full> option
	349	+will cause the methods to be returned as the full names. That is, instead of
	350	+returning C<[ 'method1', 'method2', 'method3' ]>, you would instead get
	351	+C<[ 'Class::method1', 'AnotherClass::method2', 'Class::method3' ]>.
	352	+
	353	+=item expanded
	354	+
	355	+The C<expanded> option will cause a lot more information about method to be
	356	+returned. Instead of just the method name, you will instead get an array
	357	+reference containing the method name as a single combined name, ala C<full>,
	358	+the seperate class and method, and a CODE ref to the actual function ( if
	359	+available ). Please note that the function reference is not guarenteed to
	360	+be available. C<Class::Inspector> is intended at some later time, work
	361	+with modules that have some some of common run-time loader in place ( e.g
	362	+C<Autoloader> or C<Class::Autouse> for example.
	363	+
	364	+The response from C<methods( 'Class', 'expanded' )> would look something like
	365	+the following.
	366	+
	367	+ [
	368	+ [ 'Class::method1', 'Class', 'method1', \&Class::method1 ],
	369	+ [ 'Another::method2', 'Another', 'method2', \&Another::method2 ],
	370	+ [ 'Foo::bar', 'Foo', 'bar', \&Foo::bar ],
	371	+ ]
	372	+
	373	+=back
	374	+
	375	+=cut
	376	+
	377	+sub methods {
	378	+ my $class = shift;
	379	+ my $name = $class->_class( shift ) or return undef;
	380	+ my @arguments = map { lc $_ } @_;
	381	+
	382	+ # Process the arguments to determine the options
	383	+ my %options = ();
	384	+ foreach ( @arguments ) {
	385	+ if ( $_ eq 'public' ) {
	386	+ # Only get public methods
	387	+ return undef if $options{private};
	388	+ $options{public} = 1;
	389	+
	390	+ } elsif ( $_ eq 'private' ) {
	391	+ # Only get private methods
	392	+ return undef if $options{public};
	393	+ $options{private} = 1;
	394	+
	395	+ } elsif ( $_ eq 'full' ) {
	396	+ # Return the full method name
	397	+ return undef if $options{expanded};
	398	+ $options{full} = 1;
	399	+
	400	+ } elsif ( $_ eq 'expanded' ) {
	401	+ # Returns class, method and function ref
	402	+ return undef if $options{full};
	403	+ $options{expanded} = 1;
	404	+
	405	+ } else {
	406	+ # Unknown or unsupported options
	407	+ return undef;
	408	+ }
	409	+ }
	410	+
	411	+ # Only works if the class is loaded
	412	+ return undef unless $class->loaded( $name );
	413	+
	414	+ # Get the super path ( not including UNIVERSAL )
	415	+ # Rather than using Class::ISA, we'll use an inlined version
	416	+ # that implements the same basic algorithm.
	417	+ my @path = ();
	418	+ my @queue = ( $name );
	419	+ my %seen = ( $name => 1 );
	420	+ while ( my $cl = shift @queue ) {
	421	+ push @path, $cl;
	422	+ unshift @queue, grep { ! $seen{$_}++ }
	423	+ map { s/^::/main::/; s/\'/::/g; $_ }
	424	+ ( @{"${cl}::ISA"} );
	425	+ }
	426	+
	427	+ # Find and merge the function names across the entire super path.
	428	+ # Sort alphabetically and return.
	429	+ my %methods = ();
	430	+ foreach my $namespace ( @path ) {
	431	+ my @functions = grep { ! $methods{$_} }
	432	+ grep { /$RE_IDENTIFIER/o }
	433	+ grep { defined &{"${namespace}::$_"} }
	434	+ keys %{"${namespace}::"};
	435	+ foreach ( @functions ) {
	436	+ $methods{$_} = $namespace;
	437	+ }
	438	+ }
	439	+
	440	+ # Filter to public or private methods if needed
	441	+ my @methodlist = sort keys %methods;
	442	+ @methodlist = grep { ! /^\_/ } @methodlist if $options{public};
	443	+ @methodlist = grep { /^\_/ } @methodlist if $options{private};
	444	+
	445	+ # Return in the correct format
	446	+ @methodlist = map { "$methods{$_}::$_" } @methodlist if $options{full};
	447	+ @methodlist = map {
	448	+ [ "$methods{$_}::$_", $methods{$_}, $_, \&{"$methods{$_}::$_"} ]
	449	+ } @methodlist if $options{expanded};
	450	+
	451	+ \@methodlist;
	452	+}
	453	+
	454	+
	455	+
	456	+
	457	+
	458	+#####################################################################
	459	+# Search Methods
	460	+
	461	+=pod
	462	+
	463	+=head2 subclasses $class
	464	+
	465	+The C<subclasses> static method will search then entire namespace (and thus
	466	+B<all> currently loaded classes) to find all classes that are subclasses
	467	+of the class provided as a the parameter.
	468	+
	469	+The actual test will be done by calling C<isa> on the class as a static
	470	+method. (i.e. C<My::Class-E<gt>isa($class)>.
	471	+
	472	+Returns a reference to a list of the loaded classes that match the class
	473	+provided, or false is none match, or C<undef> if the class name provided
	474	+is invalid.
	475	+
	476	+=cut
	477	+
	478	+sub subclasses {
	479	+ my $class = shift;
	480	+ my $name = $class->_class( shift ) or return undef;
	481	+
	482	+ # Prepare the search queue
	483	+ my @found = ();
	484	+ my @queue = grep { $_ ne 'main' } $class->_subnames('');
	485	+ while ( @queue ) {
	486	+ my $c = shift(@queue); # c for class
	487	+ if ( $class->_loaded($c) ) {
	488	+ # At least one person has managed to misengineer
	489	+ # a situation in which ->isa could die, even if the
	490	+ # class is real. Trap these cases and just skip
	491	+ # over that (bizarre) class. That would at limit
	492	+ # problems with finding subclasses to only the
	493	+ # modules that have broken ->isa implementation.
	494	+ local $@;
	495	+ eval {
	496	+ if ( $c->isa($name) ) {
	497	+ # Add to the found list, but don't add the class itself
	498	+ push @found, $c unless $c eq $name;
	499	+ }
	500	+ };
	501	+ }
	502	+
	503	+ # Add any child namespaces to the head of the queue.
	504	+ # This keeps the queue length shorted, and allows us
	505	+ # not to have to do another sort at the end.
	506	+ unshift @queue, map { "${c}::$_" } $class->_subnames($c);
	507	+ }
	508	+
	509	+ @found ? \@found : '';
	510	+}
	511	+
	512	+sub _subnames {
	513	+ my ($class, $name) = @_;
	514	+ return sort
	515	+ grep {
	516	+ substr($_, -2, 2, '') eq '::'
	517	+ and
	518	+ /$RE_IDENTIFIER/o
	519	+ }
	520	+ keys %{"${name}::"};
	521	+}
	522	+
	523	+
	524	+
	525	+
	526	+
	527	+#####################################################################
	528	+# Children Related Methods
	529	+
	530	+# These can go undocumented for now, until I decide if its best to
	531	+# just search the children in namespace only, or if I should do it via
	532	+# the file system.
	533	+
	534	+# Find all the loaded classes below us
	535	+sub children {
	536	+ my $class = shift;
	537	+ my $name = $class->_class(shift) or return ();
	538	+
	539	+ # Find all the Foo:: elements in our symbol table
	540	+ no strict 'refs';
	541	+ map { "${name}::$_" } sort grep { s/::$// } keys %{"${name}::"};
	542	+}
	543	+
	544	+# As above, but recursively
	545	+sub recursive_children {
	546	+ my $class = shift;
	547	+ my $name = $class->_class(shift) or return ();
	548	+ my @children = ( $name );
	549	+
	550	+ # Do the search using a nicer, more memory efficient
	551	+ # variant of actual recursion.
	552	+ my $i = 0;
	553	+ no strict 'refs';
	554	+ while ( my $namespace = $children[$i++] ) {
	555	+ push @children, map { "${namespace}::$_" }
	556	+ grep { ! /^::/ } # Ignore things like ::ISA::CACHE::
	557	+ grep { s/::$// }
	558	+ keys %{"${namespace}::"};
	559	+ }
	560	+
	561	+ sort @children;
	562	+}
	563	+
	564	+
	565	+
	566	+
	567	+
	568	+#####################################################################
	569	+# Private Methods
	570	+
	571	+# Checks and expands ( if needed ) a class name
	572	+sub _class {
	573	+ my $class = shift;
	574	+ my $name = shift or return '';
	575	+
	576	+ # Handle main shorthand
	577	+ return 'main' if $name eq '::';
	578	+ $name =~ s/\A::/main::/;
	579	+
	580	+ # Check the class name is valid
	581	+ $name =~ /$RE_CLASS/o ? $name : '';
	582	+}
	583	+
	584	+# Create a INC-specific filename, which always uses '/'
	585	+# regardless of platform.
	586	+sub _inc_filename {
	587	+ my $class = shift;
	588	+ my $name = $class->_class(shift) or return undef;
	589	+ join( '/', split /(?:\'\|::)/, $name ) . '.pm';
	590	+}
	591	+
	592	+# Convert INC-specific file name to local file name
	593	+sub _inc_to_local {
	594	+ # Shortcut in the Unix case
	595	+ return $_[1] if $UNIX;
	596	+
	597	+ # On other places, we have to deal with an unusual path that might look
	598	+ # like C:/foo/bar.pm which doesn't fit ANY normal pattern.
	599	+ # Putting it through splitpath/dir and back again seems to normalise
	600	+ # it to a reasonable amount.
	601	+ my $class = shift;
	602	+ my $inc_name = shift or return undef;
	603	+ my ($vol, $dir, $file) = File::Spec->splitpath( $inc_name );
	604	+ $dir = File::Spec->catdir( File::Spec->splitdir( $dir \|\| "" ) );
	605	+ File::Spec->catpath( $vol, $dir, $file \|\| "" );
	606	+}
	607	+
	608	+1;
	609	+
	610	+=pod
	611	+
	612	+=head1 SUPPORT
	613	+
	614	+Bugs should be reported via the CPAN bug tracker
	615	+
	616	+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Class-Inspector>
	617	+
	618	+For other issues, or commercial enhancement or support, contact the author.
	619	+
	620	+=head1 AUTHOR
	621	+
	622	+Adam Kennedy E<lt>adamk@cpan.orgE<gt>
	623	+
	624	+=head1 SEE ALSO
	625	+
	626	+L<http://ali.as/>, L<Class::Handle>
	627	+
	628	+=head1 COPYRIGHT
	629	+
	630	+Copyright 2002 - 2011 Adam Kennedy.
	631	+
	632	+This program is free software; you can redistribute
	633	+it and/or modify it under the same terms as Perl itself.
	634	+
	635	+The full text of the license can be found in the
	636	+LICENSE file included with this module.
	637	+
	638	+=cut