view release on metacpan or  search on metacpan

lib/HTTP/UserAgentString/Parser.pm  view on Meta::CPAN

}


sub _writeCacheFile($$$) {
	my ($self, $filename, $content) = @_;

	if (open(my $fh, ">", $filename)) {
		if (print $fh $content) {
			if (close($fh)) {
				return 1;
			} else {
				Carp::carp("Can't close $filename: $!\n");
				return 0;
			}
		} else {
			Carp::carp("Can't write to $filename: $!\n");
			return 0;
		}
	} else {
		Carp::carp("Can't open $filename for writing: $!\n");
		return 0;
	}
}

sub _updateCache($$$) {
	my ($self, $inidata, $version) = @_;

	return ($self->_writeCacheFile($self->cache_file, $inidata) and $self->_writeCacheFile($self->version_file, $version));
}

sub _downloadDB($$) {
	my ($self, $current_version) = @_;
	my $lwp = LWP::UserAgent->new();	
	$lwp->env_proxy();
	my $res_ini = $lwp->get($INI_URL);
	if ($res_ini->is_success) {
		my $inidata = $res_ini->content;
		my $res_md5 = $lwp->get($MD5_URL);
		if ($res_md5->is_success) {
			my $expected_hash = $res_md5->content;
			my $ctx = Digest::MD5->new();
			$ctx->add($inidata);
			my $hash = $ctx->hexdigest();
			if ($hash eq $expected_hash) {
				# Write files to disk
				return $self->_updateCache($inidata, $current_version);
			} else {
				Carp::carp("MD5 digest does not match - expected=$expected_hash; calculate=$hash\n");
				return 0;
			}
		} else {
			Carp::carp("Can't get MD5 from $MD5_URL: " . $res_md5->status_line . "\n");
			return 0;
		}
	} else {
		Carp::carp("Can't get .ini from $INI_URL: " . $res_ini->status_line . "\n");
		return 0;
	}
}

sub updateDB($;$) {
	my ($self, $force) = @_;

	# Check if cache file needs to be updated according to max_age

	my $cache_file = $self->cache_file;

	my $do_check;
	if (! -f $cache_file) {
		$do_check = 1;
	} else {
		my @stat = stat($cache_file);
		if (@stat) {
			my $mtime = $stat[9];
			my $limit = time() - $self->cache_max_age;
			$do_check = ($mtime < $limit);
		} else {
			Carp::carp("Can't stat() $cache_file: $!\n");
			return undef();
		}
	}

	if ($do_check or $force) {
		my $current_version = $self->getCurrentVersion();
		my $cache_version = $self->getCachedVersion();
		if (defined($current_version) and ((! defined($cache_version)) or ($current_version gt $cache_version))) {
			return $self->_downloadDB($current_version);
		} else {
			return -1;
		}
	} else {
		return -1;
	}
}


sub _compileRegexes($$) {
	my ($self, $regexes) = @_;

	foreach my $ir (@$regexes) {
		my $r = $ir->[0];
		my $regex = eval "qr" . $r;
		if (defined($regex)) {
			$ir->[2] = $r;
			$ir->[0] = $regex;
		} else {
			Carp::carp("Invalid regex: " . $ir->[0] . "($@)\n");
			return 0;
		}
	}

	return  1;
}

sub _loadDB($) {
	my $self = shift;
	my $file = $self->cache_file;
	if (open(my $fh, "<", $file)) {
		my $cursec;
		my $nline = 1;
		my $lastvalues;