view release on metacpan or  search on metacpan

lib/Apache/DnsZone.pm  view on Meta::CPAN

########################################################

sub check_nameserver ($) {
    my $host = shift;
    Debug(5, qq{check_nameserver($host) called\n});
    return 0 unless (check_chars($host));
    return 0 unless (check_host_ns($host));
    return 0 unless (length($host) <= 255);
    return 1;
}

#######################################################
# check_txt(txt)                                      #
# checks txt for invalid chars and other invalidities #
#######################################################

sub check_txt ($) {
    my $txt = shift;
    Debug(5, qq{check_txt($txt) called\n});
    return 0 unless $txt =~ /^[\s\w\d\.\-_]+$/;
    return 0 unless (length($txt) <= 255);
    # needs more checkups!
    return 1;
}

#########################################################
# check_email(email)                                    #
# Checks user entered email addresses with Email::Valid #
# Returns address if ok, otherwise 0                    #
#########################################################

sub check_email ($) {
    my $email = shift;
    Debug(5, qq{check_email($email) called\n});
    my $addr = Email::Valid->address($email);
    return 0 unless (length($addr) <= 255);
    return $addr if $addr;
    return 0;
}

##############################################
# get_serial_from_zone(domain_id)            #
# fetches serial from authorative nameserver #
##############################################

sub get_serial_from_zone ($) {
    my $domain_id = shift;
    Debug(5, qq{get_serial_from_zone($domain_id) called\n});
    my $domain = $dbh->id2domain($domain_id);
    resolver_setup($domain_id);
    my $query = $res->res->query($domain, "SOA");
    my $rr = ($query->answer)[0];
    return $rr->serial;
}

##############################################################
# update_serial(domain_id)                                   #
# updates zone serial in db from serial taken from real zone #
##############################################################

sub update_serial ($) {
    my $domain_id = shift;
    Debug(5, qq{update_serial($domain_id) called\n});
    my $serial = get_serial_from_zone($domain_id);
    $dbh->update_serial_soa($domain_id, $serial);
}

######################################
# check_ttl(ttl)                     #
# checks for ttl to be an int of > 0 #
######################################

sub check_ttl {
    my $ttl = shift;
    Debug(5, qq{check_ttl($ttl) called\n});
    if ($ttl =~ /^\d+$/) {
	if ($ttl == 0) {
	    return 0;
	} else {
	    if (length($ttl) <= 7) {
		return 1;
	    } else {
		return 0;
	    }
	}
    } else {
	return 0
    }
    return 0;
}

###################################
# check_lang(lang)                #
# checks for lang to be in the db #
###################################

sub check_lang {
    my $lang = shift;
    Debug(5, qq{check_lang($lang) called\n});
    if ($lang =~ /^\d+$/) {
	if ($lang == 0) {
	    return 0;
	} else {
	    return $dbh->is_valid_lang($lang);
	}
    } else {
	return 0
    }
    return 0;
}

############################################
# check_preference(preference)             #
# checks for preferece to be an int of > 0 #
############################################

sub check_preference {
    my $preference = shift;
    Debug(5, qq{check_preference($preference) called\n});
    if ($preference =~ /^\d+$/) {
	if (length($preference) <= 3) {