File Coverage

blib/lib/Data/Microformat.pm

Criterion	Covered	Total	%
statement	161	163	98.7
branch	46	56	82.1
condition	11	12	91.6
subroutine	19	19	100.0
pod	5	5	100.0
total	242	255	94.9

package Data::Microformat;

use strict;
use warnings;

our $VERSION = "0.04";

our $AUTOLOAD;

use HTML::Entities;
use HTML::TreeBuilder;
use HTML::Stream qw(html_escape);
use Carp;

sub new
{
	my $class = shift;
	my %opts  = @_;
	my $fields = ();
	my $singulars = ();
	foreach my $field ($class->singular_fields)
	{
		$fields->{$field} = undef;
		$singulars->{$field} = 1;
	}
	foreach my $field ($class->plural_fields)
	{
		$fields->{$field} = undef;
	}

	my $class_name = $class->class_name;

	my $self  = bless { _class_name => $class_name, _singulars => $singulars, %$fields, config => {%opts} }, $class;
	$self->_init();
	return $self;
}

sub _init
{
	my $self = shift;
}

sub AUTOLOAD
{
	my $self      = shift;
	my $parameter = shift;
	$parameter    =~ s!(^\s*|\s*$)!!g if $parameter && !ref($parameter);

	my $name = $AUTOLOAD;
	$name =~ s/.*://;

	unless (exists $self->{$name}) {
		#warn(ref($self)." does not have a parameter called $name.\n") unless $name =~ m/DESTROY/;
		# Do nothing here, as there's no need to warn that some parts of hCards aren't valid
		return;
	}
	if ($self->{_singulars}{$name}) {
		$self->{$name} = $parameter if $parameter && (!$self->{_no_dupe_keys} || !defined $self->{$name});
		return $self->{$name};
	} else {
		push @{$self->{$name}}, $parameter if $parameter;
		my @vals =  @{$self->{$name} || []};
		return wantarray? @vals : $vals[0];
	}
}

sub parse
{
	my $class = shift;
	my $content = shift;
	my $representative_url = shift;

	# These few transforms allow us to decode "psychotic" encodings, see t/03type.t for details
#	$content =~ tr/+/ /;
#	$content =~ s/%([a-fA-F0-9]{2,2})/chr(hex($1))/eg;
#	$content =~ s///g;
#	$content = decode_entities($content);
#	$content =~ s/%([A-F0-9]{2})/pack("C",hex($1))/ieg;

	my $tree = HTML::TreeBuilder->new_from_content($content);
	$tree->elementify;

	if (wantarray)
	{
		my @ret = $class->from_tree($tree, $representative_url);
		$tree->delete;
		return @ret;
	}
	else
	{
		my $ret = $class->from_tree($tree, $representative_url);
		$tree->delete;
		return $ret;
	}
}

sub from_tree
{
	my $class = shift;
	my $tree = shift;

	my @objects;
	my $class_name = $class->class_name;
	my @object_trees = $tree->look_down("class", qr/(^|\s)$class_name($|\s)/);

	return unless (@object_trees);

	foreach my $object_tree (@object_trees)
	{
		my $object = $class->new;
		$object->{_no_dupe_keys} = 1;
		my @bits = $object_tree->descendants;

		foreach my $bit (@bits)
		{
			next unless $bit->attr('class');

			my @types = split(" ", $bit->attr('class'));
			foreach my $type (@types)
			{
				$type =~ s/\-/\_/g;
				$type = $class->_trim($type);
				my @cons = $bit->content_list;

				my $data = $class->_trim($cons[0]);
				if ($bit->tag eq "abbr" && $bit->attr('title'))
				{
					$data = $class->_trim($bit->attr('title'));
				}
				$object->$type($data);
			}
		}
        $object->{_no_dupe_keys} = 0;
		push(@objects, $object)
	}

	return wantarray? @objects : $objects[0];
}

sub to_html
{
	my $self  = shift;

	my $tree = $self->_to_hcard_elements;
	my $ret = $tree->as_HTML('<>&', "\t", { });
	$tree->delete;

	return $ret;
}


*to_hcard = \&to_html;

sub to_text
{
	my $self  = shift;

	my $tree = $self->_to_hcard_elements;
	my $ret = _as_text($tree);
	$tree->delete;

	return $ret;
}

sub _as_text
{
	my $tree = shift;

	if (scalar $tree->descendants == 0)
	{
		return $tree->attr('class').": ".$tree->as_text;
	}

	my $ret = $tree->attr('class').": \n";

	foreach my $child ($tree->content_list)
	{
		next unless (ref($child) =~ m/HTML::Element/);
		my $temp = _as_text($child);
		$temp .= "\n" unless ($temp =~ m/\n$/s);
		$temp =~ s/^/\t/gm;
		$ret .= $temp;
	}
	return $ret;
}

sub _to_hcard_elements
{
	my $self  = shift;

	my $class_name = $self->{_class_name};

	if (defined $self->{kind})
	{
		$class_name = $self->{kind};
	}
	my $root = HTML::Element->new('div', class => $class_name);
	for my $field ($self->singular_fields)
	{
		next unless defined $self->{$field};
		next if ($field eq "kind");
		if (ref($self->{$field}) =~ m/Data::Microformat/)
		{
			# Then take the return and root it to our root
			my $child = $self->{$field}->_to_hcard_elements;
			if ($child->attr('class') eq "vcard")
			{
				$child->attr('class', $field." vcard"); # Since we know it's a vcard
			}
			$root->push_content($child);
		}
		else
		{
			my $name = $field;
			$name =~ tr/_/-/;
			my $child = HTML::Element->new('div', class => $name);
			$child->push_content($self->{$field});
			$root->push_content($child);
		}
	}
	for my $field ($self->plural_fields)
	{
		next unless defined $self->{$field};
		my $name = $field;
		$name =~ tr/_/-/;
		my $fields = $self->{$field};
		foreach my $value (@$fields)
		{
			if (ref($value) =~ m/Data::Microformat/)
			{
				# Then take the return and root it to our root
				my $child = $value->_to_hcard_elements;
				if ($child->attr('class') eq "vcard")
				{
					$child->attr('class', $field." vcard"); # Since we know it's a vcard
				}
				$root->push_content($child);
			}
			else
			{
				my $child = HTML::Element->new('div', class => $name);
				$child->push_content($value);
				$root->push_content($child);
			}
		}
	}
	return $root;
}

sub _url_decode
{
	my $class   = shift;
	my $content = shift;
	return unless defined $content;
	$content =~ s/%([\da-f]{2})/chr(hex($1))/eg;
	return $content;
}

sub _trim
{
	my $class   = shift;
	my $content = shift;
	return unless defined $content;
	$content =~ s/(^\s*|\s*$)//g;
	return $content;
}

sub _remove_newlines
{
	my $class   = shift;
	my $content = shift;
	return unless defined $content;
	$content =~ s/[\n\r]/ /g;
	return $content;
}


sub _get_child_html_from_element
{
    my $class   = shift;
    my $element = shift;
    my @list    = $element->content_list;
    return $element->as_text unless @list;
    my $out     = "";
    for my $child (@list) {
        if (ref($child)) {
            $out .= $child->as_HTML(undef,"\t",{});
        } else {
            $out .= $child;
        }
    }
    return $out;
}

1;

__END__