Linux ip-148-66-134-25.ip.secureserver.net 3.10.0-1160.119.1.el7.tuxcare.els10.x86_64 #1 SMP Fri Oct 11 21:40:41 UTC 2024 x86_64
Apache
: 148.66.134.25 | : 3.22.70.169
66 Domain
8.0.30
amvm
www.github.com/MadExploits
Terminal
AUTO ROOT
Adminer
Backdoor Destroyer
Linux Exploit
Lock Shell
Lock File
Create User
CREATE RDP
PHP Mailer
BACKCONNECT
UNLOCK SHELL
HASH IDENTIFIER
CPANEL RESET
BLACK DEFEND!
README
+ Create Folder
+ Create File
/
usr /
share /
perl5 /
vendor_perl /
CPANPLUS /
Internals /
[ HOME SHELL ]
Name
Size
Permission
Action
Constants
[ DIR ]
drwxr-xr-x
Source
[ DIR ]
drwxr-xr-x
Utils
[ DIR ]
drwxr-xr-x
Constants.pm
16.45
KB
-rw-r--r--
Extract.pm
7.45
KB
-rw-r--r--
Fetch.pm
15.72
KB
-rw-r--r--
Report.pm
22.17
KB
-rw-r--r--
Search.pm
11.85
KB
-rw-r--r--
Source.pm
41.42
KB
-rw-r--r--
Utils.pm
16.84
KB
-rw-r--r--
Delete
Unzip
Zip
${this.title}
Close
Code Editor : Search.pm
package CPANPLUS::Internals::Search; use strict; use CPANPLUS::Error; use CPANPLUS::Internals::Constants; use CPANPLUS::Module; use CPANPLUS::Module::Author; use File::Find; use File::Spec; use Params::Check qw[check allow]; use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext'; use vars qw[$VERSION]; $VERSION = "0.9138"; $Params::Check::VERBOSE = 1; =pod =head1 NAME CPANPLUS::Internals::Search - internals for searching for modules =head1 SYNOPSIS my $aref = $cpan->_search_module_tree( type => 'package', allow => [qr/DBI/], ); my $aref = $cpan->_search_author_tree( type => 'cpanid', data => \@old_results, verbose => 1, allow => [qw|KANE AUTRIJUS|], ); my $aref = $cpan->_all_installed( ); =head1 DESCRIPTION The functions in this module are designed to find module(objects) based on certain criteria and return them. =head1 METHODS =head2 _search_module_tree( type => TYPE, allow => \@regexes, [data => \@previous_results ] ) Searches the moduletree for module objects matching the criteria you specify. Returns an array ref of module objects on success, and false on failure. It takes the following arguments: =over 4 =item type This can be any of the accessors for the C<CPANPLUS::Module> objects. This is a required argument. =item allow A set of rules, or more precisely, a list of regexes (via C<qr//> or plain strings), that the C<type> must adhere too. You can specify as many as you like, and it will be treated as an C<OR> search. For an C<AND> search, see the C<data> argument. This is a required argument. =item data An arrayref of previous search results. This is the way to do an C<AND> search -- C<_search_module_tree> will only search the module objects specified in C<data> if provided, rather than the moduletree itself. =back =cut # Although the Params::Check solution is more graceful, it is WAY too slow. # # This sample script: # # use CPANPLUS::Backend; # my $cb = new CPANPLUS::Backend; # $cb->module_tree; # my @list = $cb->search( type => 'module', allow => [qr/^Acme/] ); # print $_->module, $/ for @list; # # Produced the following output using Dprof WITH params::check code # # Total Elapsed Time = 3.670024 Seconds # User+System Time = 3.390373 Seconds # Exclusive Times # %Time ExclSec CumulS #Calls sec/call Csec/c Name # 88.7 3.008 4.463 20610 0.0001 0.0002 Params::Check::check # 47.4 1.610 1.610 1 1.6100 1.6100 Storable::net_pstore # 25.6 0.869 0.737 20491 0.0000 0.0000 Locale::Maketext::Simple::_default # _gettext # 23.2 0.789 0.524 40976 0.0000 0.0000 Params::Check::_who_was_it # 23.2 0.789 0.677 20610 0.0000 0.0000 Params::Check::_sanity_check # 19.7 0.670 0.670 1 0.6700 0.6700 Storable::pretrieve # 14.1 0.480 0.211 41350 0.0000 0.0000 Params::Check::_convert_case # 11.5 0.390 0.256 20610 0.0000 0.0000 Params::Check::_hashdefs # 11.5 0.390 0.255 20697 0.0000 0.0000 Params::Check::_listreqs # 11.4 0.389 0.177 20653 0.0000 0.0000 Params::Check::_canon_key # 10.9 0.370 0.356 20697 0.0000 0.0000 Params::Check::_hasreq # 8.02 0.272 4.750 1 0.2723 4.7501 CPANPLUS::Internals::Search::_sear # ch_module_tree # 6.49 0.220 0.086 20653 0.0000 0.0000 Params::Check::_iskey # 6.19 0.210 0.077 20488 0.0000 0.0000 Params::Check::_store_error # 5.01 0.170 0.036 20680 0.0000 0.0000 CPANPLUS::Module::__ANON__ # # and this output /without/ # # Total Elapsed Time = 2.803426 Seconds # User+System Time = 2.493426 Seconds # Exclusive Times # %Time ExclSec CumulS #Calls sec/call Csec/c Name # 56.9 1.420 1.420 1 1.4200 1.4200 Storable::net_pstore # 25.6 0.640 0.640 1 0.6400 0.6400 Storable::pretrieve # 9.22 0.230 0.096 20680 0.0000 0.0000 CPANPLUS::Module::__ANON__ # 7.06 0.176 0.272 1 0.1762 0.2719 CPANPLUS::Internals::Search::_sear # ch_module_tree # 3.21 0.080 0.098 10 0.0080 0.0098 IPC::Cmd::BEGIN # 1.60 0.040 0.205 13 0.0031 0.0158 CPANPLUS::Internals::BEGIN # 1.20 0.030 0.030 29 0.0010 0.0010 vars::BEGIN # 1.20 0.030 0.117 10 0.0030 0.0117 Log::Message::BEGIN # 1.20 0.030 0.029 9 0.0033 0.0033 CPANPLUS::Internals::Search::BEGIN # 0.80 0.020 0.020 5 0.0040 0.0040 DynaLoader::dl_load_file # 0.80 0.020 0.127 10 0.0020 0.0127 CPANPLUS::Module::BEGIN # 0.80 0.020 0.389 2 0.0099 0.1944 main::BEGIN # 0.80 0.020 0.359 12 0.0017 0.0299 CPANPLUS::Backend::BEGIN # 0.40 0.010 0.010 30 0.0003 0.0003 Config::FETCH # 0.40 0.010 0.010 18 0.0006 0.0005 Locale::Maketext::Simple::load_loc # sub _search_module_tree { my $self = shift; my $conf = $self->configure_object; my %hash = @_; my($mods,$list,$verbose,$type); my $tmpl = { data => { default => [], strict_type=> 1, store => \$mods }, allow => { required => 1, default => [ ], strict_type => 1, store => \$list }, verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, type => { required => 1, allow => [CPANPLUS::Module->accessors()], store => \$type }, }; my $args = do { ### don't check the template for sanity ### -- we know it's good and saves a lot of performance local $Params::Check::SANITY_CHECK_TEMPLATE = 0; check( $tmpl, \%hash ); } or return; ### a list of module objects was supplied if( @$mods ) { local $Params::Check::VERBOSE = 0; my @rv; for my $mod (@$mods) { #push @rv, $mod if check( # { $type => { allow => $list } }, # { $type => $mod->$type() } # ); push @rv, $mod if allow( $mod->$type() => $list ); } return \@rv; } else { my @rv = $self->_source_search_module_tree( allow => $list, type => $type, ); return \@rv; } } =pod =head2 _search_author_tree( type => TYPE, allow => \@regexex, [data => \@previous_results ] ) Searches the authortree for author objects matching the criteria you specify. Returns an array ref of author objects on success, and false on failure. It takes the following arguments: =over 4 =item type This can be any of the accessors for the C<CPANPLUS::Module::Author> objects. This is a required argument. =item allow A set of rules, or more precisely, a list of regexes (via C<qr//> or plain strings), that the C<type> must adhere too. You can specify as many as you like, and it will be treated as an C<OR> search. For an C<AND> search, see the C<data> argument. This is a required argument. =item data An arrayref of previous search results. This is the way to do an C<and> search -- C<_search_author_tree> will only search the author objects specified in C<data> if provided, rather than the authortree itself. =back =cut sub _search_author_tree { my $self = shift; my $conf = $self->configure_object; my %hash = @_; my($authors,$list,$verbose,$type); my $tmpl = { data => { default => [], strict_type=> 1, store => \$authors }, allow => { required => 1, default => [ ], strict_type => 1, store => \$list }, verbose => { default => $conf->get_conf('verbose'), store => \$verbose }, type => { required => 1, allow => [CPANPLUS::Module::Author->accessors()], store => \$type }, }; my $args = check( $tmpl, \%hash ) or return; if( @$authors ) { local $Params::Check::VERBOSE = 0; my @rv; for my $auth (@$authors) { #push @rv, $auth if check( # { $type => { allow => $list } }, # { $type => $auth->$type } # ); push @rv, $auth if allow( $auth->$type() => $list ); } return \@rv; } else { my @rv = $self->_source_search_author_tree( allow => $list, type => $type, ); return \@rv; } } =pod =head2 _all_installed() This function returns an array ref of module objects of modules that are installed on this system. =cut sub _all_installed { my $self = shift; my $conf = $self->configure_object; my %hash = @_; ### File::Find uses follow_skip => 1 by default, which doesn't die ### on duplicates, unless they are directories or symlinks. ### Ticket #29796 shows this code dying on Alien::WxWidgets, ### which uses symlinks. ### File::Find doc says to use follow_skip => 2 to ignore duplicates ### so this will stop it from dying. my %find_args = ( follow_skip => 2 ); ### File::Find uses lstat, which quietly becomes stat on win32 ### it then uses -l _ which is not allowed by the statbuffer because ### you did a stat, not an lstat (duh!). so don't tell win32 to ### follow symlinks, as that will break badly $find_args{'follow_fast'} = 1 unless ON_WIN32; ### never use the @INC hooks to find installed versions of ### modules -- they're just there in case they're not on the ### perl install, but the user shouldn't trust them for *other* ### modules! ### XXX CPANPLUS::inc is now obsolete, remove the calls #local @INC = CPANPLUS::inc->original_inc; my %seen; my @rv; for my $dir (@INC ) { next if $dir eq '.'; ### not a directory after all ### may be coderef or some such next unless -d $dir; ### make sure to clean up the directories just in case, ### as we're making assumptions about the length ### This solves rt.cpan issue #19738 ### John M. notes: On VMS cannonpath can not currently handle ### the $dir values that are in UNIX format. $dir = File::Spec->canonpath( $dir ) unless ON_VMS; ### have to use F::S::Unix on VMS, or things will break my $file_spec = ON_VMS ? 'File::Spec::Unix' : 'File::Spec'; ### XXX in some cases File::Find can actually die! ### so be safe and wrap it in an eval. eval { File::Find::find( { %find_args, wanted => sub { return unless /\.pm$/i; my $mod = $File::Find::name; ### make sure it's in Unix format, as it ### may be in VMS format on VMS; $mod = VMS::Filespec::unixify( $mod ) if ON_VMS; $mod = substr($mod, length($dir) + 1, -3); $mod = join '::', $file_spec->splitdir($mod); return if $seen{$mod}++; my $modobj = $self->module_tree($mod); ### separate return, a list context return with one '' ### in it, is also true! return unless $modobj; push @rv, $modobj; }, }, $dir ) }; ### report the error if file::find died error(loc("Error finding installed files in '%1': %2", $dir, $@)) if $@; } return \@rv; } 1; # Local variables: # c-indentation-style: bsd # c-basic-offset: 4 # indent-tabs-mode: nil # End: # vim: expandtab shiftwidth=4:
Close
