[p5sagit/p5-mst-13.2.git] / lib / CPANPLUS / Internals / Fetch.pm

package CPANPLUS::Internals::Fetch;

use strict;

use CPANPLUS::Error;
use CPANPLUS::Internals::Constants;

use File::Fetch;
use File::Spec;
use Cwd                         qw[cwd];
use IPC::Cmd                    qw[run];
use Params::Check               qw[check];
use Module::Load::Conditional   qw[can_load];
use Locale::Maketext::Simple    Class => 'CPANPLUS', Style => 'gettext';

$Params::Check::VERBOSE = 1;

=pod

=head1 NAME

CPANPLUS::Internals::Fetch

=head1 SYNOPSIS

    my $output = $cb->_fetch(
                        module      => $modobj,
                        fetchdir    => '/path/to/save/to',
                        verbose     => BOOL,
                        force       => BOOL,
                    );

    $cb->_add_fail_host( host => 'foo.com' );
    $cb->_host_ok(       host => 'foo.com' );


=head1 DESCRIPTION

CPANPLUS::Internals::Fetch fetches files from either ftp, http, file
or rsync mirrors.

This is the rough flow:

    $cb->_fetch
        Delegate to File::Fetch;


=head1 METHODS

=cut

=head1 $path = _fetch( module => $modobj, [fetchdir => '/path/to/save/to', fetch_from => 'scheme://path/to/fetch/from', verbose => BOOL, force => BOOL, prefer_bin => BOOL] )

C<_fetch> will fetch files based on the information in a module
object. You always need a module object. If you want a fake module
object for a one-off fetch, look at C<CPANPLUS::Module::Fake>.

C<fetchdir> is the place to save the file to. Usually this
information comes from your configuration, but you can override it
expressly if needed.

C<fetch_from> lets you specify an URI to get this file from. If you
do not specify one, your list of configured hosts will be probed to
download the file from.

C<force> forces a new download, even if the file already exists.

C<verbose> simply indicates whether or not to print extra messages.

C<prefer_bin> indicates whether you prefer the use of commandline
programs over perl modules. Defaults to your corresponding config
setting.

C<_fetch> figures out, based on the host list, what scheme to use and
from there, delegates to C<File::Fetch> do the actual fetching.

Returns the path of the output file on success, false on failure.

Note that you can set a C<blacklist> on certain methods in the config.
Simply add the identifying name of the method (ie, C<lwp>) to:
    $conf->_set_fetch( blacklist => ['lwp'] );

And the C<LWP> function will be skipped by C<File::Fetch>.

=cut

sub _fetch {
    my $self = shift;
    my $conf = $self->configure_object;
    my %hash = @_;

    local $Params::Check::NO_DUPLICATES = 0;

    my ($modobj, $verbose, $force, $fetch_from);
    my $tmpl = {
        module      => { required => 1, allow => IS_MODOBJ, store => \$modobj },
        fetchdir    => { default => $conf->get_conf('fetchdir') },
        fetch_from  => { default => '', store => \$fetch_from },
        force       => { default => $conf->get_conf('force'),
                            store => \$force },
        verbose     => { default => $conf->get_conf('verbose'),
                            store => \$verbose },
        prefer_bin  => { default => $conf->get_conf('prefer_bin') },
    };


    my $args = check( $tmpl, \%hash ) or return;

    ### check if we already downloaded the thing ###
    if( (my $where = $modobj->status->fetch()) && !$force ) {
        msg(loc("Already fetched '%1' to '%2', " .
                "won't fetch again without force",
                $modobj->module, $where ), $verbose );
        return $where;
    }

    my ($remote_file, $local_file, $local_path);

    ### build the local path to downlaod to ###
    {
        $local_path =   $args->{fetchdir} ||
                        File::Spec->catdir(
                            $conf->get_conf('base'),
                            $modobj->path,
                        );

        ### create the path if it doesn't exist ###
        unless( -d $local_path ) {
            unless( $self->_mkdir( dir => $local_path ) ) {
                msg( loc("Could not create path '%1'", $local_path), $verbose);
                return;
            }
        }

        $local_file = File::Spec->rel2abs(
                        File::Spec->catfile(
                                    $local_path,
                                    $modobj->package,
                        )
                    );
    }

    ### do we already have the file? ###
    if( -e $local_file ) {

        if( $args->{force} ) {

            ### some fetches will fail if the files exist already, so let's
            ### delete them first
            unlink $local_file
                or msg( loc("Could not delete %1, some methods may " .
                            "fail to force a download", $local_file), $verbose);
         } else {

            ### store where we fetched it ###
            $modobj->status->fetch( $local_file );

            return $local_file;
        }
    }


    ### we got a custom URI 
    if ( $fetch_from ) {
        my $abs = $self->__file_fetch(  from    => $fetch_from,
                                        to      => $local_path,
                                        verbose => $verbose );
                                        
        unless( $abs ) {
            error(loc("Unable to download '%1'", $fetch_from));
            return;
        }            

        ### store where we fetched it ###
        $modobj->status->fetch( $abs );

        return $abs;

    ### we will get it from one of our mirrors
    } else {
        ### build the remote path to download from ###
        {   $remote_file = File::Spec::Unix->catfile(
                                        $modobj->path,
                                        $modobj->package,
                                    );
            unless( $remote_file ) {
                error( loc('No remote file given for download') );
                return;
            }
        }
    
        ### see if we even have a host or a method to use to download with ###
        my $found_host;
        my @maybe_bad_host;
    
        HOST: {
            ### F*CKING PIECE OF F*CKING p4 SHIT makes 
            ### '$File :: Fetch::SOME_VAR'
            ### into a meta variable and starts substituting the file name...
            ### GRAAAAAAAAAAAAAAAAAAAAAAH!
            ### use ' to combat it!
    
            ### set up some flags for File::Fetch ###
            local $File'Fetch::BLACKLIST    = $conf->_get_fetch('blacklist');
            local $File'Fetch::TIMEOUT      = $conf->get_conf('timeout');
            local $File'Fetch::DEBUG        = $conf->get_conf('debug');
            local $File'Fetch::FTP_PASSIVE  = $conf->get_conf('passive');
            local $File'Fetch::FROM_EMAIL   = $conf->get_conf('email');
            local $File'Fetch::PREFER_BIN   = $conf->get_conf('prefer_bin');
            local $File'Fetch::WARN         = $verbose;
    
    
            ### loop over all hosts we have ###
            for my $host ( @{$conf->get_conf('hosts')} ) {
                $found_host++;
    
                my $where;

                ### file:// uris are special and need parsing
                if( $host->{'scheme'} eq 'file' ) {    
    
                    ### the full path in the native format of the OS
                    my $host_spec = 
                            File::Spec->file_name_is_absolute( $host->{'path'} )
                                ? $host->{'path'}
                                : File::Spec->rel2abs( $host->{'path'} );
    
                    ### there might be volumes involved on vms/win32
                    if( ON_WIN32 or ON_VMS ) {
                        
                        ### now extract the volume in order to be Win32 and 
                        ### VMS friendly.
                        ### 'no_file' indicates that there's no file part
                        ### of this path, so we only get 2 bits returned.
                        my ($vol, $host_path) = File::Spec->splitpath(
                                                    $host_spec, 'no_file' 
                                                );
                        
                        ### and split up the directories
                        my @host_dirs = File::Spec->splitdir( $host_path );
        
                        ### if we got a volume we pretend its a directory for 
                        ### the sake of the file:// url
                        if( defined $vol and $vol ) {
    
                            ### D:\foo\bar needs to be encoded as D|\foo\bar
                            ### For details, see the following link:
                            ###   http://en.wikipedia.org/wiki/File://
                            ### The RFC doesnt seem to address Windows volume
                            ### descriptors but it does address VMS volume
                            ### descriptors, however wikipedia covers a bit of
                            ### history regarding win32
                            $vol =~ s/:$/|/ if ON_WIN32; 
                            
                            $vol =~ s/:// if ON_VMS;
    
                            ### XXX i'm not sure what cases this is addressing.
                            ### this comes straight from dmq's file:// patches
                            ### for win32. --kane
                            ### According to dmq, the best summary is:
                            ### "if file:// urls dont look right on VMS reuse
                            ### the win32 logic and see if that fixes things"
             
                            ### first element not empty? Might happen on VMS.
                            ### prepend the volume in that case.
                            if( $host_dirs[0] ) {
                                unshift @host_dirs, $vol;
                            
                            ### element empty? reuse it to store the volume
                            ### encoded as a directory name. (Win32/VMS)
                            } else {
                                $host_dirs[0] = $vol;
                            }                    
                        }
        
                        ### now it's in UNIX format, which is the same format
                        ### as used for URIs
                        $host_spec = File::Spec::Unix->catdir( @host_dirs ); 
                    }

                    ### now create the file:// uri from the components               
                    $where = CREATE_FILE_URI->(
                                    File::Spec::Unix->catfile(
                                        $host->{'host'} || '',
                                        $host_spec,
                                        $remote_file,
                                    )      
                                );     

                ### its components will be in unix format, for a http://,
                ### ftp:// or any other style of URI
                } else {     
                    my $mirror_path = File::Spec::Unix->catfile(
                                            $host->{'path'}, $remote_file
                                        );
    
                    my %args = ( scheme => $host->{scheme},
                                 host   => $host->{host},
                                 path   => $mirror_path,
                                );
                    
                    $where = $self->_host_to_uri( %args );
                }
    
                my $abs = $self->__file_fetch(  from    => $where, 
                                                to      => $local_path,
                                                verbose => $verbose );    
                
                ### we got a path back?
                if( $abs ) {
                    ### store where we fetched it ###
                    $modobj->status->fetch( $abs );
        
                    ### this host is good, the previous ones are apparently
                    ### not, so mark them as such.
                    $self->_add_fail_host( host => $_ ) for @maybe_bad_host;
                        
                    return $abs;
                }
                
                ### so we tried to get the file but didn't actually fetch it --
                ### there's a chance this host is bad. mark it as such and 
                ### actually flag it back if we manage to get the file 
                ### somewhere else
                push @maybe_bad_host, $host;
            }
        }
    
        $found_host
            ? error(loc("Fetch failed: host list exhausted " .
                        "-- are you connected today?"))
            : error(loc("No hosts found to download from " .
                        "-- check your config"));
    }
    
    return;
}

sub __file_fetch {
    my $self = shift;
    my $conf = $self->configure_object;
    my %hash = @_;

    my ($where, $local_path, $verbose);
    my $tmpl = {
        from    => { required   => 1, store => \$where },
        to      => { required   => 1, store => \$local_path },
        verbose => { default    => $conf->get_conf('verbose'),
                     store      => \$verbose },
    };
    
    check( $tmpl, \%hash ) or return;

    msg(loc("Trying to get '%1'", $where ), $verbose );

    ### build the object ###
    my $ff = File::Fetch->new( uri => $where );

    ### sanity check ###
    error(loc("Bad uri '%1'",$where)), return unless $ff;

    if( my $file = $ff->fetch( to => $local_path ) ) {
        unless( -e $file && -s _ ) {
            msg(loc("'%1' said it fetched '%2', but it was not created",
                    'File::Fetch', $file), $verbose);

        } else {
            my $abs = File::Spec->rel2abs( $file );
            return $abs;
        }

    } else {
        error(loc("Fetching of '%1' failed: %2", $where, $ff->error));
    }

    return;
}

=pod

=head2 _add_fail_host( host => $host_hashref )

Mark a particular host as bad. This makes C<CPANPLUS::Internals::Fetch>
skip it in fetches until this cache is flushed.

=head2 _host_ok( host => $host_hashref )

Query the cache to see if this host is ok, or if it has been flagged
as bad.

Returns true if the host is ok, false otherwise.

=cut

{   ### caching functions ###

    sub _add_fail_host {
        my $self = shift;
        my %hash = @_;

        my $host;
        my $tmpl = {
            host => { required      => 1, default   => {},
                      strict_type   => 1, store     => \$host },
        };

        check( $tmpl, \%hash ) or return;

        return $self->_hosts->{$host} = 1;
    }

    sub _host_ok {
        my $self = shift;
        my %hash = @_;

        my $host;
        my $tmpl = {
            host => { required => 1, store => \$host },
        };

        check( $tmpl, \%hash ) or return;

        return $self->_hosts->{$host} ? 0 : 1;
    }
}


1;

# Local variables:
# c-indentation-style: bsd
# c-basic-offset: 4
# indent-tabs-mode: nil
# End:
# vim: expandtab shiftwidth=4:
Commit	Line	Data
6aaee015	1	package CPANPLUS::Internals::Fetch;
	2
	3	use strict;
	4
	5	use CPANPLUS::Error;
	6	use CPANPLUS::Internals::Constants;
	7
	8	use File::Fetch;
	9	use File::Spec;
	10	use Cwd qw[cwd];
	11	use IPC::Cmd qw[run];
	12	use Params::Check qw[check];
	13	use Module::Load::Conditional qw[can_load];
	14	use Locale::Maketext::Simple Class => 'CPANPLUS', Style => 'gettext';
	15
	16	$Params::Check::VERBOSE = 1;
	17
	18	=pod
	19
	20	=head1 NAME
	21
	22	CPANPLUS::Internals::Fetch
	23
	24	=head1 SYNOPSIS
	25
	26	my $output = $cb->_fetch(
	27	module => $modobj,
	28	fetchdir => '/path/to/save/to',
	29	verbose => BOOL,
	30	force => BOOL,
	31	);
	32
	33	$cb->_add_fail_host( host => 'foo.com' );
	34	$cb->_host_ok( host => 'foo.com' );
	35
	36
	37	=head1 DESCRIPTION
	38
	39	CPANPLUS::Internals::Fetch fetches files from either ftp, http, file
	40	or rsync mirrors.
	41
	42	This is the rough flow:
	43
	44	$cb->_fetch
	45	Delegate to File::Fetch;
	46
	47
	48	=head1 METHODS
	49
	50	=cut
	51
	52	=head1 $path = _fetch( module => $modobj, [fetchdir => '/path/to/save/to', fetch_from => 'scheme://path/to/fetch/from', verbose => BOOL, force => BOOL, prefer_bin => BOOL] )
	53
	54	C<_fetch> will fetch files based on the information in a module
	55	object. You always need a module object. If you want a fake module
	56	object for a one-off fetch, look at C<CPANPLUS::Module::Fake>.
	57
	58	C<fetchdir> is the place to save the file to. Usually this
	59	information comes from your configuration, but you can override it
	60	expressly if needed.
	61
	62	C<fetch_from> lets you specify an URI to get this file from. If you
	63	do not specify one, your list of configured hosts will be probed to
	64	download the file from.
65
66	C<force> forces a new download, even if the file already exists.
67
68	C<verbose> simply indicates whether or not to print extra messages.
69
70	C<prefer_bin> indicates whether you prefer the use of commandline
71	programs over perl modules. Defaults to your corresponding config
72	setting.
73
74	C<_fetch> figures out, based on the host list, what scheme to use and
75	from there, delegates to C<File::Fetch> do the actual fetching.
76
77	Returns the path of the output file on success, false on failure.
78
79	Note that you can set a C<blacklist> on certain methods in the config.
80	Simply add the identifying name of the method (ie, C<lwp>) to:
81	$conf->_set_fetch( blacklist => ['lwp'] );
82
83	And the C<LWP> function will be skipped by C<File::Fetch>.
84
85	=cut
86
87	sub _fetch {
88	my $self = shift;
89	my $conf = $self->configure_object;
90	my %hash = @_;
91
92	local $Params::Check::NO_DUPLICATES = 0;
93
94	my ($modobj, $verbose, $force, $fetch_from);
95	my $tmpl = {
96	module => { required => 1, allow => IS_MODOBJ, store => \$modobj },
97	fetchdir => { default => $conf->get_conf('fetchdir') },
98	fetch_from => { default => '', store => \$fetch_from },
99	force => { default => $conf->get_conf('force'),
100	store => \$force },
101	verbose => { default => $conf->get_conf('verbose'),
102	store => \$verbose },
103	prefer_bin => { default => $conf->get_conf('prefer_bin') },
104	};
105
106
107	my $args = check( $tmpl, \%hash ) or return;
108
109	### check if we already downloaded the thing ###
110	if( (my $where = $modobj->status->fetch()) && !$force ) {
111	msg(loc("Already fetched '%1' to '%2', " .
112	"won't fetch again without force",
113	$modobj->module, $where ), $verbose );
114	return $where;
115	}
116
117	my ($remote_file, $local_file, $local_path);
118
119	### build the local path to downlaod to ###
120	{
121	$local_path = $args->{fetchdir} \|\|
122	File::Spec->catdir(
123	$conf->get_conf('base'),
124	$modobj->path,
125	);
126
127	### create the path if it doesn't exist ###
128	unless( -d $local_path ) {
129	unless( $self->_mkdir( dir => $local_path ) ) {
130	msg( loc("Could not create path '%1'", $local_path), $verbose);
131	return;
132	}
133	}
134
135	$local_file = File::Spec->rel2abs(
136	File::Spec->catfile(
137	$local_path,
138	$modobj->package,
139	)
140	);
141	}
142
143	### do we already have the file? ###
144	if( -e $local_file ) {
145
146	if( $args->{force} ) {
147
148	### some fetches will fail if the files exist already, so let's
149	### delete them first
150	unlink $local_file
151	or msg( loc("Could not delete %1, some methods may " .
152	"fail to force a download", $local_file), $verbose);
153	} else {
154
155	### store where we fetched it ###
156	$modobj->status->fetch( $local_file );
157
158	return $local_file;
159	}
160	}
161
162
163	### we got a custom URI
164	if ( $fetch_from ) {
165	my $abs = $self->__file_fetch( from => $fetch_from,
166	to => $local_path,
167	verbose => $verbose );
168
169	unless( $abs ) {
170	error(loc("Unable to download '%1'", $fetch_from));
171	return;
172	}
173
174	### store where we fetched it ###
175	$modobj->status->fetch( $abs );
176
177	return $abs;
178
179	### we will get it from one of our mirrors
180	} else {
181	### build the remote path to download from ###
182	{ $remote_file = File::Spec::Unix->catfile(
183	$modobj->path,
184	$modobj->package,
185	);
186	unless( $remote_file ) {
187	error( loc('No remote file given for download') );
188	return;
189	}
190	}
191
192	### see if we even have a host or a method to use to download with ###
193	my $found_host;
194	my @maybe_bad_host;
195
196	HOST: {
197	### FCKING PIECE OF FCKING p4 SHIT makes
198	### '$File :: Fetch::SOME_VAR'
199	### into a meta variable and starts substituting the file name...
200	### GRAAAAAAAAAAAAAAAAAAAAAAH!
201	### use ' to combat it!
202
203	### set up some flags for File::Fetch ###
204	local $File'Fetch::BLACKLIST = $conf->_get_fetch('blacklist');
205	local $File'Fetch::TIMEOUT = $conf->get_conf('timeout');
206	local $File'Fetch::DEBUG = $conf->get_conf('debug');
207	local $File'Fetch::FTP_PASSIVE = $conf->get_conf('passive');
208	local $File'Fetch::FROM_EMAIL = $conf->get_conf('email');
209	local $File'Fetch::PREFER_BIN = $conf->get_conf('prefer_bin');
210	local $File'Fetch::WARN = $verbose;
211
212
213	### loop over all hosts we have ###
214	for my $host ( @{$conf->get_conf('hosts')} ) {
215	$found_host++;
216
6aaee015	217	my $where;
5879cbe1	218
	219	### file:// uris are special and need parsing
	220	if( $host->{'scheme'} eq 'file' ) {
	221
	222	### the full path in the native format of the OS
	223	my $host_spec =
	224	File::Spec->file_name_is_absolute( $host->{'path'} )
	225	? $host->{'path'}
	226	: File::Spec->rel2abs( $host->{'path'} );
	227
	228	### there might be volumes involved on vms/win32
	229	if( ON_WIN32 or ON_VMS ) {
	230
	231	### now extract the volume in order to be Win32 and
	232	### VMS friendly.
	233	### 'no_file' indicates that there's no file part
	234	### of this path, so we only get 2 bits returned.
	235	my ($vol, $host_path) = File::Spec->splitpath(
	236	$host_spec, 'no_file'
	237	);
	238
	239	### and split up the directories
	240	my @host_dirs = File::Spec->splitdir( $host_path );
	241
	242	### if we got a volume we pretend its a directory for
	243	### the sake of the file:// url
	244	if( defined $vol and $vol ) {
	245
	246	### D:\foo\bar needs to be encoded as D\|\foo\bar
	247	### For details, see the following link:
	248	### http://en.wikipedia.org/wiki/File://
	249	### The RFC doesnt seem to address Windows volume
	250	### descriptors but it does address VMS volume
	251	### descriptors, however wikipedia covers a bit of
	252	### history regarding win32
	253	$vol =~ s/:$/\|/ if ON_WIN32;
0fe18d46	254
ae592ab1	255	$vol =~ s/:// if ON_VMS;
0fe18d46	256
5879cbe1	257	### XXX i'm not sure what cases this is addressing.
	258	### this comes straight from dmq's file:// patches
	259	### for win32. --kane
0fe18d46	260	### According to dmq, the best summary is:
	261	### "if file:// urls dont look right on VMS reuse
	262	### the win32 logic and see if that fixes things"
	263
	264	### first element not empty? Might happen on VMS.
	265	### prepend the volume in that case.
5879cbe1	266	if( $host_dirs[0] ) {
5879cbe1	267	unshift @host_dirs, $vol;
0fe18d46	268
	269	### element empty? reuse it to store the volume
	270	### encoded as a directory name. (Win32/VMS)
5879cbe1	271	} else {
	272	$host_dirs[0] = $vol;
	273	}
	274	}
	275
	276	### now it's in UNIX format, which is the same format
	277	### as used for URIs
	278	$host_spec = File::Spec::Unix->catdir( @host_dirs );
	279	}
	280
	281	### now create the file:// uri from the components
6aaee015	282	$where = CREATE_FILE_URI->(
5879cbe1	283	File::Spec::Unix->catfile(
	284	$host->{'host'} \|\| '',
	285	$host_spec,
	286	$remote_file,
	287	)
	288	);
	289
	290	### its components will be in unix format, for a http://,
	291	### ftp:// or any other style of URI
	292	} else {
	293	my $mirror_path = File::Spec::Unix->catfile(
	294	$host->{'path'}, $remote_file
	295	);
	296
6aaee015	297	my %args = ( scheme => $host->{scheme},
	298	host => $host->{host},
	299	path => $mirror_path,
	300	);
	301
	302	$where = $self->_host_to_uri( %args );
	303	}
	304
	305	my $abs = $self->__file_fetch( from => $where,
	306	to => $local_path,
	307	verbose => $verbose );
	308
	309	### we got a path back?
	310	if( $abs ) {
	311	### store where we fetched it ###
	312	$modobj->status->fetch( $abs );
	313
	314	### this host is good, the previous ones are apparently
	315	### not, so mark them as such.
	316	$self->_add_fail_host( host => $_ ) for @maybe_bad_host;
	317
	318	return $abs;
	319	}
	320
	321	### so we tried to get the file but didn't actually fetch it --
	322	### there's a chance this host is bad. mark it as such and
	323	### actually flag it back if we manage to get the file
	324	### somewhere else
	325	push @maybe_bad_host, $host;
	326	}
	327	}
	328
	329	$found_host
	330	? error(loc("Fetch failed: host list exhausted " .
	331	"-- are you connected today?"))
	332	: error(loc("No hosts found to download from " .
	333	"-- check your config"));
	334	}
	335
	336	return;
	337	}
	338
	339	sub __file_fetch {
	340	my $self = shift;
	341	my $conf = $self->configure_object;
	342	my %hash = @_;
	343
	344	my ($where, $local_path, $verbose);
	345	my $tmpl = {
	346	from => { required => 1, store => \$where },
	347	to => { required => 1, store => \$local_path },
	348	verbose => { default => $conf->get_conf('verbose'),
	349	store => \$verbose },
	350	};
	351
	352	check( $tmpl, \%hash ) or return;
	353
	354	msg(loc("Trying to get '%1'", $where ), $verbose );
	355
	356	### build the object ###
	357	my $ff = File::Fetch->new( uri => $where );
	358
	359	### sanity check ###
	360	error(loc("Bad uri '%1'",$where)), return unless $ff;
361
362	if( my $file = $ff->fetch( to => $local_path ) ) {
363	unless( -e $file && -s _ ) {
364	msg(loc("'%1' said it fetched '%2', but it was not created",
365	'File::Fetch', $file), $verbose);
366
367	} else {
368	my $abs = File::Spec->rel2abs( $file );
369	return $abs;
370	}
371
372	} else {
373	error(loc("Fetching of '%1' failed: %2", $where, $ff->error));
374	}
375
376	return;
377	}
378
379	=pod
380
381	=head2 _add_fail_host( host => $host_hashref )
382
383	Mark a particular host as bad. This makes C<CPANPLUS::Internals::Fetch>
384	skip it in fetches until this cache is flushed.
385
386	=head2 _host_ok( host => $host_hashref )
387
388	Query the cache to see if this host is ok, or if it has been flagged
389	as bad.
390
391	Returns true if the host is ok, false otherwise.
392
393	=cut
394
395	{ ### caching functions ###
396
397	sub _add_fail_host {
398	my $self = shift;
399	my %hash = @_;
400
401	my $host;
402	my $tmpl = {
403	host => { required => 1, default => {},
404	strict_type => 1, store => \$host },
405	};
406
407	check( $tmpl, \%hash ) or return;
408
409	return $self->_hosts->{$host} = 1;
410	}
411
412	sub _host_ok {
413	my $self = shift;
414	my %hash = @_;
415
416	my $host;
417	my $tmpl = {
418	host => { required => 1, store => \$host },
419	};
420
421	check( $tmpl, \%hash ) or return;
422
423	return $self->_hosts->{$host} ? 0 : 1;
424	}
425	}
426
427
428	1;
429
430	# Local variables:
431	# c-indentation-style: bsd
432	# c-basic-offset: 4
433	# indent-tabs-mode: nil
434	# End:
435	# vim: expandtab shiftwidth=4: