Refactor Rx types into their own modules and share amongst test files

Author: briandfoy

xt/lib/Local/Rx.pm

@@ -0,0 +1,26 @@
+package # hide from PAUSE
+	Local::Rx;
+
+use Data::Rx;
+
+use Local::Rx::Type::CommitID;
+use Local::Rx::Type::CVE;
+use Local::Rx::Type::GHSA;
+use Local::Rx::Type::URL;
+use Local::Rx::Type::VCS_URL;
+use Local::Rx::Type::YYYYMMDD;
+
+sub new {
+	Data::Rx->new({
+		type_plugins => [qw(
+			Local::Rx::Type::YYYYMMDD
+			Local::Rx::Type::GHSA
+			Local::Rx::Type::CVE
+			Local::Rx::Type::URL
+			Local::Rx::Type::VCS_URL
+			Local::Rx::Type::CommitID
+			)],
+	});
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/CVE.pm

@@ -0,0 +1,18 @@
+package # hide from PAUSE
+	Local::Rx::Type::CVE;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/cve',
+	}
+
+sub assert_valid {
+	my ($self, $value) = @_;
+	$value =~ /\ACVE-\d+-\d+\z/a or $self->fail({
+		error => [ qw(type) ],
+		message => "value <$value> is not a valid CVE identifier",
+		value => $value,
+		})
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/CommitID.pm

@@ -0,0 +1,28 @@
+package # hide from PAUSE
+	Local::Rx::Type::CommitID;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/commit-id',
+	}
+
+sub assert_valid {
+	my ($self, $value) = @_;
+	if( ! defined $value ) {
+		return $self->fail({
+			error => [ qw(type) ],
+			message => "URL value is not defined",
+			value => $value,
+			})
+		}
+	elsif( $value !~ m{\A[\da-f]{40}\z}ia ) {
+		$self->fail({
+			error => [ qw(type) ],
+			message => "Commit ID <$value> is not 40 hexadecimal characters",
+			value => $value,
+			})
+		}
+	return 1;
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/GHSA.pm

@@ -0,0 +1,18 @@
+package # hide from PAUSE
+	Local::Rx::Type::GHSA;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/ghsa',
+	}
+
+sub assert_valid { # GHSA-6wjc-jvcr-hcxw
+	my ($self, $value) = @_;
+	$value =~ /\AGHSA(?:-[a-z0-9]{4}){3}\z/a or $self->fail({
+		error => [ qw(type) ],
+		message => "value <$value> is not a valid GitHub Advisory Database identifier",
+		value => $value,
+		})
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/URL.pm

@@ -0,0 +1,28 @@
+package # hide from PAUSE
+	Local::Rx::Type::URL;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/url',
+	}
+
+sub assert_valid {
+	my ($self, $value) = @_;
+	if( ! defined $value ) {
+		return $self->fail({
+			error => [ qw(type) ],
+			message => "URL value is not defined",
+			value => $value,
+			})
+		}
+	elsif( $value !~ m{\A(?:https?|ftp)://}ia ) {
+		$self->fail({
+			error => [ qw(type) ],
+			message => "URL value <$value> is not valid",
+			value => $value,
+			})
+		}
+	return 1;
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/VCS_URL.pm

@@ -0,0 +1,28 @@
+package # hide from PAUSE
+	Local::Rx::Type::VCS_URL;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/vcs-url',
+	}
+
+sub assert_valid {
+	my ($self, $value) = @_;
+	if( ! defined $value ) {
+		return $self->fail({
+			error => [ qw(type) ],
+			message => "URL value is not defined",
+			value => $value,
+			})
+		}
+	elsif( $value !~ m{\A(?:https?|git|svn)://}ia ) {
+		$self->fail({
+			error => [ qw(type) ],
+			message => "URL value <$value> is not valid",
+			value => $value,
+			})
+		}
+	return 1;
+	}
+
+__PACKAGE__;

xt/lib/Local/Rx/Type/YYYYMMDD.pm

@@ -0,0 +1,19 @@
+package # hide from PAUSE
+	Local::Rx::Type::YYYYMMDD;
+use parent 'Data::Rx::CommonType::EasyNew';
+
+sub type_uri {
+	'tag:example.com,EXAMPLE:rx/cpansa-date',
+	}
+
+sub assert_valid {
+	my ($self, $value) = @_;
+	return 1 unless defined $value;
+	$value =~ /\A(?:19[6789]\d|20[012]\d)-\d\d-\d\d\z/a or $self->fail({
+		error => [ qw(type) ],
+		message => "date value is not YYYY-MM-DD",
+		value => $value,
+		})
+	}
+
+__PACKAGE__;