/swignition/Swignition/uF/hMeasure.pm

#!/usr/bin/perl

######################################################################
package Swignition::uF::hMeasure;
######################################################################

# This is a complete hodge-podge of a module, but it seems to work.

use CGI::Util;
use Swignition::GenericParser::Utils;
use Swignition::MagicString;
use Swignition::uF;
use POSIX;
use XML::LibXML qw(:all);
use strict;
use utf8;


sub consume
{
	my $page = shift;
	$page->{uF}->{hMeasure} = [ parse_all($page) ];
		
	if (defined $page->{uF}->{hMeasure}->[0])
	{
		$page->mergeNS($page->{uF}->{hMeasure}->[0]);
	}

	foreach my $a (@{ $page->{uF}->{hMeasure} })
	{
		$a->rdf_subject_merge($page);
	}
}


sub parse_all
{
	my $page   = shift;
	my $within = shift || $page->{DOM};
	my @rv;
	
	my @nodes1 = searchClass('hmeasure', $within);
	my @nodes2 = searchClass('hangle', $within);
	my @nodes3 = searchClass('hmoney', $within);
	my @nodes = (@nodes1, @nodes2, @nodes3);

	foreach my $a (@nodes)
	{
		next if ($a->getAttribute('class') =~ /\b(tolerance)\b/);		
		my $A = parse($page, $a);
		push @rv, $A;
	}
	
	return @rv;
} #/sub parse_all


sub uri
{
	my $this = shift;
	my $all  = shift;
	my @rv;

	if (length $this->{_id})
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri.'#'.$this->{_id});
	}
	if (lc($this->{_dom}->tagName) eq 'body')
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri);
	}
	push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{_dom}, 'Measurement')
		unless (@rv);
	
	return $rv[0] unless (defined $all);
	while ($all) { shift @rv; $all--; }
	return @rv;
} #/sub uri


sub qv_uri
{
	my $this = shift;
	my $all  = shift;
	my @rv;

	push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{_dom}, 'QualifiedValue');
	
	return $rv[0] unless (defined $all);
	while ($all) { shift @rv; $all--; }
	return @rv;
} #/sub qv_uri


sub t_uri
{
	my $this = shift;
	my $all  = shift;
	my @rv;

	if (length $this->{tolerance}->{_id})
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri . '#' . $this->{tolerance}->{_id});
	}
	elsif ($this->{tolerance}->{_dom})
	{
		push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{tolerance}->{_dom}, 'Tolerance');
	}
	else
	{
		push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{_dom}, 'Tolerance');
	}
	
	return $rv[0] unless (defined $all);
	while ($all) { shift @rv; $all--; }
	return @rv;
} #/sub t_uri

sub item_uri
{
	my $this = shift;
	my $all  = shift;
	my @rv;

	if ($this->{item_object})
	{
		return $this->{item_object}->uri($all);
	}

	if (length $this->{item_link})
	{
		push @rv, Swignition::uF::TDBURI($this->{item_link});
	}
	if (length $this->{item_dom}->getAttribute('id'))
	{
		push @rv, Swignition::uF::TDBURI($this->{_page}->uri . '#' . $this->{item_dom}->getAttribute('id'));
	}
	push @rv, Swignition::GenericParser::Utils::BNodeURI($this->{item_dom}, 'MeasuredThing')
		unless (@rv);
	
	return $rv[0] unless (defined $all);
	while ($all) { shift @rv; $all--; }
	return @rv;
} #/sub t_uri


sub dim_uri
{
	my $this = shift;

	return 'http://purl.org/commerce#costs'
		if ($this->{class} eq 'hmoney' && !length $this->{type});

	return unless (length $this->{type});

	my $dimension = lc($this->{type});
	$dimension =~ s/\s+/ /g;
	$dimension =~ s/[^a-z0-9 ]//g;
	$dimension =~ s/ ([a-z])/uc($1)/ge;

	return 'http://buzzword.org.uk/rdf/measure#'.$dimension;
	
} #/sub dim_uri


sub rdf_subject_merge
{
	my $this    = shift;
	my $page    = shift;
	my $val;
	
	my $subject = Swignition::RDFModel::Subject->new($this->uri);
	$subject->addObject($this);
	$subject->setDom($this->{_dom});
	my $val = Swignition::RDFModel::Value->new('http://buzzword.org.uk/rdf/measure-aux#Measurement', 1);
	$subject->addVal("http://www.w3.org/1999/02/22-rdf-syntax-ns#type", $val);
	
	my $qv_subject = Swignition::RDFModel::Subject->new($this->qv_uri);
	my $val = Swignition::RDFModel::Value->new(
		($this->{class} eq 'hmoney'
			? 'http://purl.org/commerce#Price' 
			: 'http://buzzword.org.uk/rdf/measure-aux#QualifiedValue')
		, 1);
	$qv_subject->addVal("http://www.w3.org/1999/02/22-rdf-syntax-ns#type", $val);
	$val = Swignition::RDFModel::Value->new($this->qv_uri, 1);
	$subject->addVal("http://buzzword.org.uk/rdf/measure-aux#hasValue", $val);
	if (length $this->{unit})
	{
		$val = Swignition::RDFModel::Value->new($this->{unit});
		$qv_subject->addVal(
			($this->{class} eq 'hmoney'
				?'http://purl.org/commerce#currency'
				:"http://buzzword.org.uk/rdf/measure-aux#unit"),
			$val);
	}
	if (length $this->{num})
	{
		$val = Swignition::RDFModel::Value->new($this->{num});
		$qv_subject->addVal(
			($this->{class} eq 'hmoney'
				?'http://purl.org/commerce#amount'
				:"http://www.w3.org/1999/02/22-rdf-syntax-ns#value"),
			$val);
	}
	if ($this->{class} eq 'hangle')
	{
		$val = Swignition::RDFModel::Value->new($this->{num_label});
		$qv_subject->addVal('http://www.w3.org/2000/01/rdf-schema#label', $val);
	}	
	
	if ($this->{tolerance}->{class} eq 'percentage'
	|| $this->{tolerance}->{unit} eq '%')
	{
		$val = Swignition::RDFModel::Value->new($this->{tolerance}->{num}.'%');
		$subject->addVal("http://buzzword.org.uk/rdf/measure-aux#hasTolerance", $val);
	}
	elsif ($this->{tolerance}->{num})
	{
		my $t_subject = Swignition::RDFModel::Subject->new($this->t_uri);
		my $val = Swignition::RDFModel::Value->new(
			($this->{class} eq 'hmoney'
				? 'http://purl.org/commerce#Price' 
				: 'http://buzzword.org.uk/rdf/measure-aux#Tolerance')
			, 1);
		$t_subject->addVal("http://www.w3.org/1999/02/22-rdf-syntax-ns#type", $val);
		$val = Swignition::RDFModel::Value->new($this->t_uri, 1);
		$subject->addVal("http://buzzword.org.uk/rdf/measure-aux#hasTolerance", $val);
		if (length $this->{tolerance}->{unit})
		{
			$val = Swignition::RDFModel::Value->new($this->{tolerance}->{unit});
			$t_subject->addVal(
				($this->{class} eq 'hmoney'
					?'http://purl.org/commerce#currency'
					:"http://buzzword.org.uk/rdf/measure-aux#unit"),
				$val);
		}
		if (length $this->{tolerance}->{num})
		{
			$val = Swignition::RDFModel::Value->new($this->{tolerance}->{num});
			$t_subject->addVal(
				($this->{class} eq 'hmoney'
					?'http://purl.org/commerce#amount'
					:"http://www.w3.org/1999/02/22-rdf-syntax-ns#value"),
				$val);
		}
		$page->mergeSubject($t_subject);
	}
	
	if (length $this->dim_uri)
	{
		$val = Swignition::RDFModel::Value->new($this->dim_uri, 1);
		$subject->addVal("http://buzzword.org.uk/rdf/measure-aux#dimension", $val);
	}

	if ($this->{item_object} || $this->{item_dom})
	{
		my $item_subject = Swignition::RDFModel::Subject->new($this->item_uri);
		$item_subject->addVal(
			'http://buzzword.org.uk/rdf/measure-aux#hasMeasurement',
			Swignition::RDFModel::Value->new($this->uri, 1)
		);
		$subject->addVal(
			'http://buzzword.org.uk/rdf/measure-aux#item',
			Swignition::RDFModel::Value->new($this->item_uri, 1)
		);
		if (length $this->dim_uri)
		{
			$item_subject->addVal(
				$this->dim_uri,
				Swignition::RDFModel::Value->new($this->qv_uri, 1)
			);
		}
		if (!$this->{item_object})
		{
			$item_subject->addVal(
				'http://www.w3.org/2000/01/rdf-schema#label',
				Swignition::RDFModel::Value->new($this->{item})
			);
		}
		$page->mergeSubject($item_subject);
	}
	
	$page->mergeSubject($subject);
	$page->mergeSubject($qv_subject);
	
} #/sub rdf_subject


sub metadata_ns
{
	my $this = shift;
	return {
		'commerce' => {
				nsurl=>'http://purl.org/commerce#',
				title=>'RDF Commerce Vocab'
			},
		'measure' => {
				nsurl=>'http://buzzword.org.uk/rdf/measure#',
				title=>'RDF Measurements Vocab'
			},
		'measurex' => {
				nsurl=>'http://buzzword.org.uk/rdf/measure-aux#',
				title=>'RDF Measurements Vocab (Auxiliary)'
			}
		};
} #/sub metadata_ns


sub parse
{
	my $page  = shift;
	my $rv    = { '_dom'=>shift };
	my $pkg = __PACKAGE__;
	if (defined $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') })
		{ return $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') }; }
	else
		{ $page->{uF}->{_Shortcuts}->{$pkg}->{ $rv->{_dom}->getAttribute('_xpath') } = $rv; }
	
	my $root  = $rv->{'_dom'}->cloneNode(1);
	my @RemoveTheseNodes;
	
	my $id = $root->getAttribute('id');
	$rv->{_id} = $id if (length $id);
	$rv->{_page} = $page;
			
	Swignition::uF::data_patterns($page, $root, 2);
	
	# Extract embedded hCards
	my @nested = searchClass('vcard', $root);
	foreach my $h (@nested)
	{
		if ($h->getAttribute('class') =~ / (^|\s) item (\s|$) /x)
		{
			$rv->{item_object} = Swignition::uF::hCard::parse($page, $h);
			push @RemoveTheseNodes, $h;
			last;
		}
			
		my $newClass = $h->getAttribute('class');
		$newClass =~ s/\b(item)\b//gix;
		$h->setAttribute('class', $newClass);
	}

	# Extract embedded hCalendar events
	my @nested = searchClass('vevent', $root);
	foreach my $h (@nested)
	{
		if ($h->getAttribute('class') =~ / (^|\s) item (\s|$) /x)
		{
			$rv->{item_object} = Swignition::uF::hEvent::parse($page, $h);
			push @RemoveTheseNodes, $h;
			last;
		}
			
		my $newClass = $h->getAttribute('class');
		$newClass =~ s/\b(item)\b//gix;
		$h->setAttribute('class', $newClass);
	}

	# Now that we have reached here, no other composite microformats have
	# any business being nested within this root element. So in the interest
	# of Microformat opacity, let's destroy them.
	Swignition::uF::destroyer($root);	

	# We'll use these regular expressions later.
	my $_nonZeroDigit = '[1-9]';
	my $_digit        = '\d';
	my $_natural      = "($_nonZeroDigit)($_digit)*";
	my $_integer      = "(0|(\\-|\x{2212})?($_natural)+)";
	my $_decimal      = "($_integer)[\\.\\,]($_digit)*";
	my $_mantissa     = "($_decimal|$_integer)";
	my $_sciNumber    = "($_mantissa)[Ee]($_integer)";
	my $_number       = "($_sciNumber|$_decimal|$_integer|\\x{00BC}|\\x{00BD}|\\x{00BE})";
	
	my $_degree       = "($_number)(deg|\\x{00b0})";
	my $_minute       = "($_number)(min|\\x{2032}|\\\')";
	my $_second       = "($_number)(sec|\\x{2033}|\\\")";
	
	# Type
	$rv->{class} = 'hmeasure';
	$rv->{class} = 'hangle' if ($root->getAttribute('class') =~ /\b(hangle)\b/);	
	$rv->{class} = 'hmoney' if ($root->getAttribute('class') =~ /\b(hmoney)\b/);	

	# Number	
	my @nodes = searchClass('num', $root);
	my $str = STRINGIFY($nodes[0], 'value');
	$rv->{num} = $str
		if (length $str);
	push @RemoveTheseNodes, $nodes[0] if ($nodes[0]);
	
	# Unit
	unless ($rv->{class} eq 'hangle')
	{
		@nodes = searchClass('unit', $root);
		$str = STRINGIFY($nodes[0], 'value');
		$rv->{unit} = $str
			if (length $str);
		push @RemoveTheseNodes, $nodes[0] if ($nodes[0]);
	}

	# Type
	@nodes = searchClass('type', $root);
	$str = STRINGIFY($nodes[0], 'value');
	$rv->{type} = $str
		if (length $str);
	push @RemoveTheseNodes, $nodes[0] if ($nodes[0]);
	
	# Item
	unless ($rv->{item_object})
	{
		@nodes = searchClass('item', $root);
		if (@nodes)
		{
			my $n = $nodes[0];
			my $link;
	
			$str = STRINGIFY($n, 'value');
			
			if (length $n->getAttribute('src'))
				{ $link = $page->uri( $n->getAttribute('src') ); }
			elsif (length $n->getAttribute('href'))
				{ $link = $page->uri( $n->getAttribute('href') ); }
			elsif (length $n->getAttribute('data'))
				{ $link = $page->uri( $n->getAttribute('data') ); }
	
			$rv->{item} = $str
				if (length $str);
			$rv->{item_link} = $link
				if (length $link);
			$rv->{item_dom} = $n;
			
			push @RemoveTheseNodes, $n;
		}
	}
	
	# Tolerance
	@nodes = searchClass('tolerance', $root);
	my $str = STRINGIFY($nodes[0], 'value');
	if ($str =~ /^\s*($_number)\s*\%\s*$/)
	{
		$rv->{tolerence} = bless {
			'class' => 'percentage' ,
			'num'   => $1 ,
			'unit'  => '%'
		};
	}
	elsif ($nodes[0])
	{
		my $tolerance = parse($nodes[0]);
		$rv->{tolerence} = $tolerance
			if (length $tolerance->{num});
	}
	push @RemoveTheseNodes, $nodes[0] if ($nodes[0]);

	foreach my $RemoveIt (@RemoveTheseNodes)
		{ $RemoveIt->parentNode->removeChild($RemoveIt); }
	my $str = STRINGIFY($root, 'value');
	
	unless ($rv->{tolerance})
	{
		my $tol;
		($str, $tol) = split /\x{2213}/, $str;
		$str =~ s/(^\s+)|(\s+$)//g;
		$tol =~ s/(^\s+)|(\s+$)//g;
		
		if (length $tol)
		{
			$tol =~ /$_number/;
			$rv->{tolerance} = bless {
				num => $1 ,
				class => $rv->{class}
			};
			$tol =~ s/$_number//;
			$rv->{tolerance}->{unit} = $tol;
		}
	}
	
	if ($rv->{class} eq 'hangle' && !length $rv->{num})
	{
		$rv->{num} = $str;
	}
	elsif (length $rv->{num} && !length $rv->{unit})
	{
		$rv->{unit} = $str;
		if ($rv->{class} eq 'hmoney')
		{
			$str =~ /(\b[A-Z]{3}\b|\x{20AC}|\x{00A3}|\x{00A5}|\x{0024})/i;
			$rv->{unit} = $1 if (length $1);
		}
	}
	elsif (length $rv->{unit} && !length $rv->{num})
	{
		$str =~ s/\s+//g;		
		$str =~ /$_number/;
		$rv->{num} = $str;
	}
	elsif (!length $rv->{num} && !length $rv->{unit})
	{
		$str =~ /$_number/;
		$rv->{num} = $1;
		$str =~ s/\s*($_number)\s*//;
		$rv->{unit} = $str;
		if ($rv->{class} eq 'hmoney')
		{
			$str =~ /(\b[A-Z]{3}\b|\x{20AC}|\x{00A3}|\x{00A5}|\x{0024})/i;
			$rv->{unit} = $1 if (length $1);
		}
	}
	
	if ($rv->{class} eq 'hmoney')
	{
		$rv->{unit} = 'EUR' if ($rv->{unit} =~ /^\x{20AC}$/);
		$rv->{unit} = 'GBP' if ($rv->{unit} =~ /^\x{00A3}$/);
		$rv->{unit} = 'JPY' if ($rv->{unit} =~ /^\x{00A5}$/);
		$rv->{unit} = 'USD' if ($rv->{unit} =~ /^\x{0024}$/);
	}

	$rv->{num} =~ s/\,/\./g;
	$rv->{num} =~ s/\x{2212}/\-/g;

	if ($rv->{class} eq 'hangle')
	{
		$str = $rv->{num};
		
		$str =~ m/$_degree/;  $rv->{num_degree} = $1 if (length $1);
		$str =~ m/$_minute/;  $rv->{num_minute} = $1 if (length $1);
		$str =~ m/$_second/;  $rv->{num_second} = $1 if (length $1);

		if ($rv->{num_degree} < 0)
		{
			$rv->{num_minute} *= -1;
			$rv->{num_second} *= -1;
		}
		elsif ($rv->{num_degree} == 0 && $rv->{num_minute} < 0)
		{
			$rv->{num_second} *= -1;
		}
		
		$rv->{num} = $rv->{num_degree}
			+ ( $rv->{num_minute} / 60 )
			+ ( $rv->{num_second} / 3600 );

		$rv->{num_label} = $str;
	}
	
	if ($rv->{class} ne 'hangle' && defined $rv->{tolerance} && !length $rv->{tolerance}->{unit})
	{
		$rv->{tolerance}->{unit} = $rv->{unit};
	}
	
	bless $rv;
	return $rv;
	
} #/sub parse


1; #/package Swignition::uF::hMeasure