view release on metacpan or  search on metacpan

lib/Data/Microformat.pm  view on Meta::CPAN

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/<!–(.|\n)*–>//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;