Net-LDAP-FilterBuilder-1.0004/0000755013452301345230000000000011404445322015167 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/examples/0000755013452301345230000000000011404445322017005 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/examples/demo.pl0000644013452301345230000000021511233431436020265 0ustar oliveroliver#!/usr/bin/perl use Net::LDAP::FilterBuilder; my $filter1 = Net::LDAP::FilterBuilder->new( sn => 'Jones' ); # now $filter1 eq '(sn=Jones)' Net-LDAP-FilterBuilder-1.0004/lib/0000755013452301345230000000000011404445322015735 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/lib/Net/0000755013452301345230000000000011404445322016463 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/lib/Net/LDAP/0000755013452301345230000000000011404445322017203 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/lib/Net/LDAP/FilterBuilder.pm0000644013452301345230000001474011404445033022302 0ustar oliveroliver# # $HeadURL: https://svn.oucs.ox.ac.uk/people/oliver/pub/cpan/libnet-ldap-filterbuilder-perl/trunk/lib/Net/LDAP/FilterBuilder.pm $ # $LastChangedRevision: 767 $ # $LastChangedDate: 2010-06-11 15:37:15 +0100 (Fri, 11 Jun 2010) $ # $LastChangedBy: oliver $ # package Net::LDAP::FilterBuilder; use strict; use warnings FATAL => 'all'; our $VERSION = '1.0004'; $VERSION = eval $VERSION; # numify for warning-free dev releases use overload '""' => \&as_str; sub escape { my $class = shift; my $value = shift; for ( $value ) { s{\\}{\\}g; s{\*}{\\*}g; s{\(}{\\(}g; s{\)}{\\)}g; s{\0}{\\0}g; } return $value; } sub new { my $proto = shift; my $class = ref( $proto ) || $proto; my $filter; if ( @_ == 0 ) { $filter = '(objectclass=*)'; } elsif ( @_ == 1 ) { $filter = shift; } else { my $op = @_ % 2 ? shift : '='; my @parts; while ( my ( $attr, $val ) = splice( @_, 0, 2 ) ) { if ( ref( $val ) eq 'ARRAY' ) { push @parts, sprintf( '(|%s)', join( q{}, map $class->new( $op, $attr, $_ ), @{ $val } ) ); } elsif ( ref( $val ) eq 'SCALAR' ) { push @parts, sprintf( '(%s%s%s)', $attr, $op, ${ $val } ); } else { push @parts, sprintf( '(%s%s%s)', $attr, $op, $class->escape( $val ) ); } } if ( @parts > 1 ) { $filter = sprintf( '(&%s)', join( q{}, @parts ) ); } else { $filter = shift @parts; } } bless( \$filter, $class ); } sub or { my $self = shift; ${ $self } = sprintf( '(|%s%s)', $self, $self->new( @_ ) ); return $self; } sub and { my $self = shift; ${ $self } = sprintf( '(&%s%s)', $self, $self->new( @_ ) ); return $self; } sub not { my $self = shift; ${ $self } = sprintf( '(!%s)', $self ); return $self; } sub as_str { ${ $_[0] }; } 1; __END__ =head1 NAME Net::LDAP::FilterBuilder - Build LDAP filter statements =head1 VERSION This document refers to version 1.0004 of Net::LDAP::FilterBuilder =head1 PURPOSE Use this module to construct LDAP filter statments which are compliant with the RFC 4515 syntax and also safely escape special characters. Filter statements can be built incrementally using simple logic operations. =head1 SYNOPSIS use Net::LDAP::FilterBuilder; my $filter1 = Net::LDAP::FilterBuilder->new( sn => 'Jones' ); # now $filter1 eq '(sn=Jones)' Basic logic operations such as C, C and C: $filter1->and( givenName => 'David' ); # (&(sn=Jones)(givenName=David)) my $filter2 = Net::LDAP::FilterBuilder->new( sn => [ 'Jones', 'Edwards', 'Lewis' ] ); # (|(sn=Jones)(sn=Edwards)(sn=Lewis)) my $filter3 = Net::LDAP::FilterBuilder->new( givenName => 'David' )->not; # (!(givenName=David)) Build up filters incrementally from other FilterBuidler objects: my $filter4 = Net::LDAP::FilterBuilder->new( sn => ['Jones', 'Edwards'] )->and( $filter3 ); # (&(|(sn=Jones)(sn=Edwards))(!(givenName=David))) Special characters to LDAP will be escaped: my $filter5 = Net::LDAP::FilterBuilder->new( sn => 'foo*bar' ); # (sn=foo\*bar) To disable escaping, pass a Scalar reference: my $filter6 = Net::LDAP::FilterBuilder->new( sn => \'foo*bar' ); # (sn=foo*bar) Alternate operators are available through the three-argument constructor form: my $filter7 = Net::LDAP::FilterBuilder->new( '>=', dateOfBirth => '19700101000000Z' ); # (dateOfBirth>=19700101000000Z) =head1 DESCRIPTION This is a convenience module which greatly simplifies the construction of LDAP query filter statments, which are described in RFC 4515 and also the L manual page. =head1 USAGE To make any filter, call the constructor C with the attribute and value to match: my $filter = Net::LDAP::FilterBuilder->new( sn => 'Jones' ); The value returned is an object, but stringifies to the current query: print "success" if $filter eq '(sn=Jones)'; # prints "success" However you can refine the filter statement using three additional methods for the logical operations C, C and C, as shown in the L<"SYOPSIS"> section, above, and the L<"METHODS"> section below. There are two ways to refine a filter. Either call the logic method with a new attribute and value, or call a logic method and pass another Net::LDAP::FilterBuilder object. These two practices are also shown in the L<"SYNOPSIS"> section, above. =head2 Comparison Operators By default the module uses an equal operator between the attribute and value. To select an alternate operator, use the three agurment form of the constructor: my $filter = Net::LDAP::FilterBuilder->new( '>=', dateOfBirth => '19700101000000Z' ); # (dateOfBirth>=19700101000000Z) Note that this module is not aware of the list of valid operators, it simply takes the first argument to be the operator, whatever it might be. =head2 Special Character Escaping If you happen to include one of the small set of characters which are of special significance to LDAP filter statments in your value argument, then those characters will be escaped. The list of characters is: ( ) * \ NUL To avoid this pass in a scalar reference as the value argument. For example to enable a wildcard (substring) match on a value: my $filter = Net::LDAP::FilterBuilder->new( sn => \'foo*bar' ); # (sn=foo*bar) =head1 METHODS =over 4 =item B Returns the string representation of the LDAP filter. Note that the object will stringify to this value in string context, too. =item B(FILTERSPEC) Logically conjoins this filter with the one specified by FILTERSPEC. FILTERSPEC may be a L object, or a hash representation of the filter as taken by L>. Returns the newly-conjoined L. =item B(FILTERSPEC) Logically disjoins this filter with the one specified by FILTERSPEC. FILTERSPEC may be a L object, or a hash representation of the filter as taken by L>. Returns the newly-disjoined L. =item B Logically complements this filter. Returns the newly-negated L. =back =head1 AUTHOR Originally written by Ray Miller. =head1 MAINTAINER Oliver Gorwits C<< >> =head1 COPYRIGHT & LICENSE Copyright (c) The University of Oxford 2008. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Net-LDAP-FilterBuilder-1.0004/Makefile.PL0000644013452301345230000000041711233431436017144 0ustar oliveroliveruse inc::Module::Install 0.67; perl_version '5.008001'; name 'Net-LDAP-FilterBuilder'; all_from 'lib/Net/LDAP/FilterBuilder.pm'; test_requires 'Test::More' => 0; test_requires 'Test::Pod' => 0; test_requires 'Test::Pod::Coverage' => 0; WriteAll; Net-LDAP-FilterBuilder-1.0004/META.yml0000644013452301345230000000100411404445306016435 0ustar oliveroliver--- abstract: 'Build LDAP filter statements' author: - 'Originally written by Ray Miller.' build_requires: Test::More: 0 Test::Pod: 0 Test::Pod::Coverage: 0 distribution_type: module generated_by: 'Module::Install version 0.76' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-LDAP-FilterBuilder no_index: directory: - inc - t - examples requires: perl: 5.8.1 resources: license: http://dev.perl.org/licenses/ version: 1.0004 Net-LDAP-FilterBuilder-1.0004/README0000644013452301345230000001122411404445056016053 0ustar oliveroliverNAME Net::LDAP::FilterBuilder - Build LDAP filter statements VERSION This document refers to version 1.0004 of Net::LDAP::FilterBuilder PURPOSE Use this module to construct LDAP filter statments which are compliant with the RFC 4515 syntax and also safely escape special characters. Filter statements can be built incrementally using simple logic operations. SYNOPSIS use Net::LDAP::FilterBuilder; my $filter1 = Net::LDAP::FilterBuilder->new( sn => 'Jones' ); # now $filter1 eq '(sn=Jones)' Basic logic operations such as "and", "or" and "not": $filter1->and( givenName => 'David' ); # (&(sn=Jones)(givenName=David)) my $filter2 = Net::LDAP::FilterBuilder->new( sn => [ 'Jones', 'Edwards', 'Lewis' ] ); # (|(sn=Jones)(sn=Edwards)(sn=Lewis)) my $filter3 = Net::LDAP::FilterBuilder->new( givenName => 'David' )->not; # (!(givenName=David)) Build up filters incrementally from other FilterBuidler objects: my $filter4 = Net::LDAP::FilterBuilder->new( sn => ['Jones', 'Edwards'] )->and( $filter3 ); # (&(|(sn=Jones)(sn=Edwards))(!(givenName=David))) Special characters to LDAP will be escaped: my $filter5 = Net::LDAP::FilterBuilder->new( sn => 'foo*bar' ); # (sn=foo\*bar) To disable escaping, pass a Scalar reference: my $filter6 = Net::LDAP::FilterBuilder->new( sn => \'foo*bar' ); # (sn=foo*bar) Alternate operators are available through the three-argument constructor form: my $filter7 = Net::LDAP::FilterBuilder->new( '>=', dateOfBirth => '19700101000000Z' ); # (dateOfBirth>=19700101000000Z) DESCRIPTION This is a convenience module which greatly simplifies the construction of LDAP query filter statments, which are described in RFC 4515 and also the Net::LDAP::Filter manual page. USAGE To make any filter, call the constructor "new" with the attribute and value to match: my $filter = Net::LDAP::FilterBuilder->new( sn => 'Jones' ); The value returned is an object, but stringifies to the current query: print "success" if $filter eq '(sn=Jones)'; # prints "success" However you can refine the filter statement using three additional methods for the logical operations "and", "or" and "not", as shown in the "SYOPSIS" section, above, and the "METHODS" section below. There are two ways to refine a filter. Either call the logic method with a new attribute and value, or call a logic method and pass another Net::LDAP::FilterBuilder object. These two practices are also shown in the "SYNOPSIS" section, above. Comparison Operators By default the module uses an equal operator between the attribute and value. To select an alternate operator, use the three agurment form of the constructor: my $filter = Net::LDAP::FilterBuilder->new( '>=', dateOfBirth => '19700101000000Z' ); # (dateOfBirth>=19700101000000Z) Note that this module is not aware of the list of valid operators, it simply takes the first argument to be the operator, whatever it might be. Special Character Escaping If you happen to include one of the small set of characters which are of special significance to LDAP filter statments in your value argument, then those characters will be escaped. The list of characters is: ( ) * \ NUL To avoid this pass in a scalar reference as the value argument. For example to enable a wildcard (substring) match on a value: my $filter = Net::LDAP::FilterBuilder->new( sn => \'foo*bar' ); # (sn=foo*bar) METHODS as_str Returns the string representation of the LDAP filter. Note that the object will stringify to this value in string context, too. and(FILTERSPEC) Logically conjoins this filter with the one specified by FILTERSPEC. FILTERSPEC may be a Net::LDAP::FilterBuilder object, or a hash representation of the filter as taken by new. Returns the newly-conjoined Net::LDAP::FilterBuilder. or(FILTERSPEC) Logically disjoins this filter with the one specified by FILTERSPEC. FILTERSPEC may be a Net::LDAP::FilterBuilder object, or a hash representation of the filter as taken by new. Returns the newly-disjoined Net::LDAP::FilterBuilder. not Logically complements this filter. Returns the newly-negated Net::LDAP::FilterBuilder. AUTHOR Originally written by Ray Miller. MAINTAINER Oliver Gorwits "" COPYRIGHT & LICENSE Copyright (c) The University of Oxford 2008. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-LDAP-FilterBuilder-1.0004/MANIFEST0000644013452301345230000000061411404445316016324 0ustar oliveroliverChanges examples/demo.pl inc/Module/Install.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/Fetch.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm INSTALL lib/Net/LDAP/FilterBuilder.pm Makefile.PL MANIFEST This list of files META.yml README t/00-load.t t/20-filter.t t/pod-coverage.t t/pod.t Net-LDAP-FilterBuilder-1.0004/t/0000755013452301345230000000000011404445322015432 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/t/20-filter.t0000644013452301345230000000362411404444732017334 0ustar oliveroliver#!/usr/bin/perl use Test::More 'no_plan'; BEGIN { use_ok('Net::LDAP::FilterBuilder') }; ######################### # Insert your test code below, the Test::More module is use()ed here so read # its man page ( perldoc Test::More ) for help writing this test script. my $f = Net::LDAP::FilterBuilder->new( sn => 'Gorwits' ); is( "$f", '(sn=Gorwits)' ); $f = Net::LDAP::FilterBuilder->new( sn => [ 'Gorwits', 'Edwards', 'Morrell' ] ); is( "$f", '(|(sn=Gorwits)(sn=Edwards)(sn=Morrell))' ); $f = Net::LDAP::FilterBuilder->new( sn => [ 'Gorwits', 'Edwards' ], givenName => 'Guy' ); is( "$f", '(&(|(sn=Gorwits)(sn=Edwards))(givenName=Guy))' ); $f = Net::LDAP::FilterBuilder->new( sn => [ 'Gorwits', 'Edwards' ] )->and( givenName => 'Oliver' ); is( "$f", '(&(|(sn=Gorwits)(sn=Edwards))(givenName=Oliver))' ); $f = Net::LDAP::FilterBuilder->new( sn => 'Gorwits' )->or( sn => 'Edwards' )->and( givenName => 'Oliver' ); is( "$f", '(&(|(sn=Gorwits)(sn=Edwards))(givenName=Oliver))' ); $f = Net::LDAP::FilterBuilder->new( sn => 'Gorwits' )->or( Net::LDAP::FilterBuilder->new( sn => 'Edwards' )->and( givenName => 'Oliver' ) ); is( "$f", '(|(sn=Gorwits)(&(sn=Edwards)(givenName=Oliver)))' ); $f = Net::LDAP::FilterBuilder->new( sn => 'Gorwits' )->or( sn => 'Edwards' )->and( givenName => 'Oliver' )->not; is( "$f", '(!(&(|(sn=Gorwits)(sn=Edwards))(givenName=Oliver)))' ); $f = Net::LDAP::FilterBuilder->new( sn => ['Gorwits', 'Edwards'] )->and( Net::LDAP::FilterBuilder->new( givenName => 'Oliver' )->not ); is( "$f", '(&(|(sn=Gorwits)(sn=Edwards))(!(givenName=Oliver)))' ); $f = Net::LDAP::FilterBuilder->new( sn => 'foo*bar' ); is( "$f", '(sn=foo\*bar)' ); $f = Net::LDAP::FilterBuilder->new( sn => \'foo*bar' ); is( "$f", '(sn=foo*bar)' ); $f = Net::LDAP::FilterBuilder->new( sn => \'*' ); is( "$f", '(sn=*)' ); $f = Net::LDAP::FilterBuilder->new( '>=', dateOfBirth => '19700101000000Z' ); is( "$f", '(dateOfBirth>=19700101000000Z)' ); Net-LDAP-FilterBuilder-1.0004/t/pod.t0000644013452301345230000000021411233431436016377 0ustar oliveroliver#!perl -T use Test::More; eval "use Test::Pod 1.14"; plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; all_pod_files_ok(); Net-LDAP-FilterBuilder-1.0004/t/00-load.t0000644013452301345230000000017211233431436016754 0ustar oliveroliver#!/usr/bin/env perl use strict; use warnings; use Test::More tests => 1; BEGIN { use_ok( 'Net::LDAP::FilterBuilder' ); } Net-LDAP-FilterBuilder-1.0004/t/pod-coverage.t0000644013452301345230000000031611233431436020173 0ustar oliveroliver#!perl -T use Test::More; eval "use Test::Pod::Coverage 1.04"; plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@; all_pod_coverage_ok( {also_private => [ qr/./, ]} ); Net-LDAP-FilterBuilder-1.0004/Changes0000644013452301345230000000144011404445022016456 0ustar oliveroliverlibnet-ldap-filterbuilder (1.0004-1) UNRELEASED; urgency=low * Fix for new Test::Simple which does not like stringification -- Oliver Gorwits Fri, 11 Jun 2010 15:36:46 +0100 libnet-ldap-filterbuilder (1.0003-1) UNRELEASED; urgency=low * Add docs patch from Tom Jones to expose as_str and other methods. -- Oliver Gorwits Tue, 20 Oct 2009 08:21:49 +0100 libnet-ldap-filterbuilder (1.0002-1) UNRELEASED; urgency=low * Add example and pod tests -- Oliver Gorwits Sat, 8 Nov 2008 17:32:57 +0000 libnet-ldap-filterbuilder (1.0001-1) UNRELEASED; urgency=low * Initial release on an unsuspecting world. -- Oliver Gorwits Thu, 2 Oct 2008 13:58:08 +0100 Net-LDAP-FilterBuilder-1.0004/inc/0000755013452301345230000000000011404445322015740 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/inc/Module/0000755013452301345230000000000011404445322017165 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/inc/Module/Install/0000755013452301345230000000000011404445322020573 5ustar oliveroliverNet-LDAP-FilterBuilder-1.0004/inc/Module/Install/Win32.pm0000644013452301345230000000340211404445306022034 0ustar oliveroliver#line 1 package Module::Install::Win32; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.76'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/Can.pm0000644013452301345230000000337411404445306021643 0ustar oliveroliver#line 1 package Module::Install::Can; use strict; use Module::Install::Base; use Config (); ### This adds a 5.005 Perl version dependency. ### This is a bug and will be fixed. use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { my $abs = File::Spec->catfile($dir, $_[1]); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 157 Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/Metadata.pm0000644013452301345230000002573211404445306022664 0ustar oliveroliver#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } my @scalar_keys = qw{ name module_name abstract author version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; sub Meta { shift } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}{$key} if defined wantarray and !@_; $self->{values}{$key} = shift; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}{resources} }; } return $self->{values}{resources}{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } sub requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{requires} }, [ $module, $version ]; } $self->{values}{requires}; } sub build_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{build_requires} }, [ $module, $version ]; } $self->{values}{build_requires}; } sub configure_requires { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{configure_requires} }, [ $module, $version ]; } $self->{values}{configure_requires}; } sub recommends { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{recommends} }, [ $module, $version ]; } $self->{values}{recommends}; } sub bundles { my $self = shift; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @{ $self->{values}{bundles} }, [ $module, $version ]; } $self->{values}{bundles}; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}{resources} ||= []; push @{ $self->{values}{resources} }, [ $name, $value ]; } $self->{values}{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub sign { my $self = shift; return $self->{values}{sign} if defined wantarray and ! @_; $self->{values}{sign} = ( @_ ? $_[0] : 1 ); return $self; } sub dynamic_config { my $self = shift; unless ( @_ ) { warn "You MUST provide an explicit true/false value to dynamic_config\n"; return $self; } $self->{values}{dynamic_config} = $_[0] ? 1 : 0; return 1; } sub perl_version { my $self = shift; return $self->{values}{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); $version =~ s/_.+$//; $version = $version + 0; # Numify unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}{perl_version} = $version; return 1; } sub license { my $self = shift; return $self->{values}{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $self->{values}{license} = $license; # Automatically fill in license URLs if ( $license eq 'perl' ) { $self->resources( license => 'http://dev.perl.org/licenses/' ); } return 1; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless $self->author; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}{features} ? @{ $self->{values}{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}{no_index}{$type} }, @_ if $type; return $self->{values}{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub perl_version_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ^ (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; $author =~ s{E}{<}g; $author =~ s{E}{>}g; $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } sub license_from { my $self = shift; if ( Module::Install::_read($_[0]) =~ m/ ( =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b .*? ) (=head\\d.*|=cut.*|) \z /ixms ) { my $license_text = $1; my @phrases = ( 'under the same (?:terms|license) as perl itself' => 'perl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'BSD license' => 'bsd', 1, 'Artistic license' => 'artistic', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s{\s+}{\\s+}g; if ( $license_text =~ /\b$pattern\b/i ) { if ( $osi and $license_text =~ /All rights reserved/i ) { print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n"; } $self->license($license); return 1; } } } warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g; unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than on rt.cpan.org link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub install_script { my $self = shift; my $args = $self->makemaker_args; my $exe = $args->{EXE_FILES} ||= []; foreach ( @_ ) { if ( -f $_ ) { push @$exe, $_; } elsif ( -d 'script' and -f "script/$_" ) { push @$exe, "script/$_"; } else { die("Cannot find script '$_'"); } } } 1; Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/Fetch.pm0000644013452301345230000000463011404445306022167 0ustar oliveroliver#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base; use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/WriteAll.pm0000644013452301345230000000132111404445306022653 0ustar oliveroliver#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '0.76'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->Meta->write if $args{meta}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { $self->makemaker_args( PL_FILES => {} ); } if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } } 1; Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/Makefile.pm0000644013452301345230000001445411404445306022660 0ustar oliveroliver#line 1 package Module::Install::Makefile; use strict 'vars'; use Module::Install::Base; use ExtUtils::MakeMaker (); use vars qw{$VERSION $ISCORE @ISA}; BEGIN { $VERSION = '0.76'; $ISCORE = 1; @ISA = qw{Module::Install::Base}; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing, always use defaults if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } sub makemaker_args { my $self = shift; my $args = ( $self->{makemaker_args} ||= {} ); %$args = ( %$args, @_ ); return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = sShift; my $name = shift; my $args = $self->makemaker_args; $args->{name} = defined $args->{$name} ? join( ' ', $args->{name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } my %test_dir = (); sub _wanted_t { /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1; } sub tests_recursive { my $self = shift; if ( $self->tests ) { die "tests_recursive will not work if tests are already defined"; } my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } %test_dir = (); require File::Find; File::Find::find( \&_wanted_t, $dir ); $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Make sure we have a new enough require ExtUtils::MakeMaker; # MakeMaker can complain about module versions that include # an underscore, even though its own version may contain one! # Hence the funny regexp to get rid of it. See RT #35800 # for details. $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ ); # Generate the my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{VERSION} = $self->version; $args->{NAME} =~ s/-/::/g; if ( $self->tests ) { $args->{test} = { TESTS => $self->tests }; } if ($] >= 5.005) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = $self->author; } if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) { $args->{NO_META} = 1; } if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } # merge both kinds of requires into prereq_pm my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } map { @$_ } grep $_, ($self->configure_requires, $self->build_requires, $self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # merge both kinds of requires into prereq_pm my $subdirs = ($args->{DIR} ||= []); if ($self->bundles) { foreach my $bundle (@{ $self->bundles }) { my ($file, $dir) = @$bundle; push @$subdirs, $dir if -d $dir; delete $prereq->{$file}; } } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } $args->{INSTALLDIRS} = $self->installdirs; my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if (my $preop = $self->admin->preop($user_preop)) { $args{dist} = $preop; } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; my $makefile = do { local $/; }; close MAKEFILE or die $!; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 377 Net-LDAP-FilterBuilder-1.0004/inc/Module/Install/Base.pm0000644013452301345230000000205011404445306022002 0ustar oliveroliver#line 1 package Module::Install::Base; $VERSION = '0.76'; # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } ### This is the ONLY module that shouldn't have strict on # use strict; #line 41 sub new { my ($class, %args) = @_; foreach my $method ( qw(call load) ) { *{"$class\::$method"} = sub { shift()->_top->$method(@_); } unless defined &{"$class\::$method"}; } bless( \%args, $class ); } #line 61 sub AUTOLOAD { my $self = shift; local $@; my $autoload = eval { $self->_top->autoload } or return; goto &$autoload; } #line 76 sub _top { $_[0]->{_top} } #line 89 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 101 sub is_admin { $_[0]->admin->VERSION; } sub DESTROY {} package Module::Install::Base::FakeAdmin; my $Fake; sub new { $Fake ||= bless(\@_, $_[0]) } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 146 Net-LDAP-FilterBuilder-1.0004/inc/Module/Install.pm0000644013452301345230000002100711404445306021133 0ustar oliveroliver#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } BEGIN { require 5.004; } use strict 'vars'; use vars qw{$VERSION}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '0.76'; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 and (stat($0))[9] > time ) { die <<"END_DIE" } Your installer $0 has a modification time in the future. This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); use Cwd (); use File::Find (); use File::Path (); use FindBin; sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # delegate back to parent dirs goto &$code unless $cwd eq $pwd; } $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym"; unshift @_, ( $self, $1 ); goto &{$self->can('call')} unless uc($1) eq $1; }; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; unless ( -f $self->{file} ) { require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{"$self->{file}"}; delete $INC{"$self->{path}.pm"}; return 1; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { my $admin = $self->{admin}; @exts = $admin->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = delete $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } sub _read { local *FH; open FH, "< $_[0]" or die "open($_[0]): $!"; my $str = do { local $/; }; close FH or die "close($_[0]): $!"; return $str; } sub _write { local *FH; open FH, "> $_[0]" or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!" } close FH or die "close($_[0]): $!"; } sub _version ($) { my $s = shift || 0; $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s ) ? $_[0] : undef; } 1; # Copyright 2008 Adam Kennedy. Net-LDAP-FilterBuilder-1.0004/INSTALL0000644013452301345230000000045511233431436016225 0ustar oliveroliverWHAT IS THIS? This is Net::LDAP::FilterBuilder, a Perl module. Please see the README that comes with this distribution. HOW DO I INSTALL IT? To install this module, cd to the directory that contains this README file and type the following: perl Makefile.PL make make test make install