File Coverage

blib/lib/DDG/Meta/Information.pm

Criterion	Covered	Total	%
statement	112	112	100.0
branch	15	24	62.5
condition	2	3	66.6
subroutine	22	26	84.6
pod	1	2	50.0
total	152	167	91.0

package DDG::Meta::Information;
our $AUTHORITY = 'cpan:DDG';
# ABSTRACT: DDG plugin meta information storage
$DDG::Meta::Information::VERSION = '1018';
use strict;
use warnings;
use Carp qw( croak );
use Package::Stash;

require Moo::Role;

my %supported_types = (
	email => [ 'mailto:{{a}}', '{{b}}' ],
	twitter => [ 'https://twitter.com/{{a}}', '@{{b}}' ],
	web => [ '{{a}}', '{{b}}' ],
	github => [ 'https://github.com/{{a}}', '{{b}}' ],
	facebook => [ 'https://facebook.com/{{a}}', '{{b}}' ],
	cpan => [ 'https://metacpan.org/author/{{a}}', '{{a}}' ],
);

my @supported_categories = qw(
	bang
	calculations
	cheat_sheets
	computing_info
	computing_tools
	conversions
	dates
	entertainment
	facts
	finance
	food
	formulas
	forums
	geography
	ids
	language
	location_aware
	physical_properties
	programming
	q/a
	random
	reference
	special
	software
	time_sensitive
	transformations
);

my @supported_topics = qw(
	everyday
	economy_and_finance
        computing
	cryptography
	entertainment
	food_and_drink
	gaming
	geek
	geography
	math
	music
	programming
	science
	social
	special_interest
	sysadmin
	travel
	trivia
	web_design
	words_and_games
);


my %applied;

sub apply_keywords {
	my ( $class, $target ) = @_;

	return if exists $applied{$target};
	$applied{$target} = undef;

	my @attributions;
	my @topics;
	my @primary_example_queries;
	my @secondary_example_queries;
    	my $description;
    	my $source;
	my $icon;
	my $category;
	my $name;
	my $icon_url;
	my $code_url;
	my $status;
	my $url_regex = url_match_regex();

	my $stash = Package::Stash->new($target);


	$stash->add_symbol('&category', sub {
		croak "Only one category allowed."
			unless scalar @_ == 1;
		my $value = shift;
		croak $value." is not a valid category (Supported: ".join(',',@supported_categories).")"
			unless grep { $_ eq $value } @supported_categories;
		$category = $value;

	});


	$stash->add_symbol('&topics', sub {
		while (@_) {
			my $value = shift;
			croak $value." is not a valid topic (Supported: ".join(',',@supported_topics).")"
				unless grep { $_ eq $value } @supported_topics;
			push @topics, $value;
		}
	});


	$stash->add_symbol('&attribution', sub {
		while (@_) {
			my $type = shift;
			my $value = shift;
			croak $type." is not a valid attribution type (Supported: ".join(',',keys %supported_types).")"
				unless grep { $_ eq $type } keys %supported_types;
			push @attributions, [ $type, $value ];
		}
	});


	$stash->add_symbol('&name', sub {
		croak 'Only one name allowed.'
			unless scalar @_ == 1;
		my $value = shift;
		$name = $value;
	});


	$stash->add_symbol('&source', sub {
		croak 'Only one source allowed.'
			unless scalar @_ == 1;
		my $value = shift;
		$source = $value;
	});


	$stash->add_symbol('&description', sub {
		croak 'Only one description allowed.'
			unless scalar @_ == 1;
		my $value = shift;
		$description = $value;
	});


	$stash->add_symbol('&primary_example_queries', sub {
		while(@_){
			my $query = shift;
			push @primary_example_queries, $query;
		}
	});


	$stash->add_symbol('&secondary_example_queries', sub {
		while(@_){
			my $query = shift;
			push @secondary_example_queries, $query;
		}
	});


	$stash->add_symbol('&icon_url', sub {
		my $value = shift;
		croak $value." is not a valid URL."
			unless ($value =~ m/$url_regex/g or $value =~ /^\/(i\/)?(.+)\.(ico|png|jpe?g)$/ig);
		$icon_url = $value;
	});


	$stash->add_symbol('&code_url', sub {
		my $value = shift;
		croak $value." is not a valid URL."
			unless $value =~ m/$url_regex/g;
		$code_url = $value;
	});


	$stash->add_symbol('&status', sub {
		my $value = shift;
		croak $value." is not a valid status."
			unless $value =~ m/^(enabled|disabled)$/ig;
		$status = $value;
	});



	$stash->add_symbol('&get_category', sub {
		return $category;
	});


	$stash->add_symbol('&get_topics', sub {
		return \@topics;
	});


	$stash->add_symbol('&get_meta_information', sub {
		my %meta_information;

		$meta_information{name} = $name;
		$meta_information{primary_example_queries} = \@primary_example_queries;
		$meta_information{secondary_example_queries} = \@secondary_example_queries;
		$meta_information{icon_url} = $icon_url;
		$meta_information{description} = $description;
		$meta_information{source} = $source;
		$meta_information{code_url} = $code_url;
		$meta_information{status} = $status;

		return \%meta_information;
	});


	$stash->add_symbol('&get_attributions', sub {
		my @attribution_links;
		for (@attributions) {
			my $type = shift @{$_};
			my $value = shift @{$_};
			my ( $a, $b ) = ref $value eq 'ARRAY' ? ( $value->[0], $value->[1] ) : ( $value, $value );
			my ( $link, $val ) = @{$supported_types{$type}};
			$link =~ s/\Q{{a}}/$a/;
			$link =~ s/\Q{{b}}/$b/;
			$val =~ s/\Q{{a}}/$a/;
			$val =~ s/\Q{{b}}/$b/;
			push @attribution_links, $link, $val;
		}
		return \@attribution_links;
	});

	#
	# apply role
	#

	Moo::Role->apply_role_to_package($target,'DDG::HasAttribution');

}

#
# Function taken from URL::RegexMatching
# - couldn't install due to bad Makefile
#
sub url_match_regex {
    return
      qr{(?i)\b((?:[a-z][\w-]+:(?:/{1,3}|[a-z0-9%])|www\d{0,3}[.]|[a-z0-9.\-]+[.][a-z]{2,4}/)(?:[^\s()<>]+|\(([^\s()<>]+|(\([^\s()<>]+\)))*\))+(?:\(([^\s()<>]+|(\([^\s()<>]+\)))*\)|[^\s`!()\[\]{};:'".,<>?«»“”‘’]))};
}

1;

__END__