HTML-Microformats-0.105/0000755000076400007640000000000011775404023013055 5ustar taitaiHTML-Microformats-0.105/inc/0000755000076400007640000000000011775404022013625 5ustar taitaiHTML-Microformats-0.105/inc/YAML/0000755000076400007640000000000011775404022014367 5ustar taitaiHTML-Microformats-0.105/inc/YAML/Tiny.pm0000644000076400007640000003534411775403725015672 0ustar taitai#line 1 package YAML::Tiny; use strict; # UTF Support? sub HAVE_UTF8 () { $] >= 5.007003 } BEGIN { if ( HAVE_UTF8 ) { # The string eval helps hide this from Test::MinimumVersion eval "require utf8;"; die "Failed to load UTF-8 support" if $@; } # Class structure require 5.004; require Exporter; require Carp; $YAML::Tiny::VERSION = '1.51'; # $YAML::Tiny::VERSION = eval $YAML::Tiny::VERSION; @YAML::Tiny::ISA = qw{ Exporter }; @YAML::Tiny::EXPORT = qw{ Load Dump }; @YAML::Tiny::EXPORT_OK = qw{ LoadFile DumpFile freeze thaw }; # Error storage $YAML::Tiny::errstr = ''; } # The character class of all characters we need to escape # NOTE: Inlined, since it's only used once # my $RE_ESCAPE = '[\\x00-\\x08\\x0b-\\x0d\\x0e-\\x1f\"\n]'; # Printed form of the unprintable characters in the lowest range # of ASCII characters, listed by ASCII ordinal position. my @UNPRINTABLE = qw( z x01 x02 x03 x04 x05 x06 a x08 t n v f r x0e x0f x10 x11 x12 x13 x14 x15 x16 x17 x18 x19 x1a e x1c x1d x1e x1f ); # Printable characters for escapes my %UNESCAPES = ( z => "\x00", a => "\x07", t => "\x09", n => "\x0a", v => "\x0b", f => "\x0c", r => "\x0d", e => "\x1b", '\\' => '\\', ); # Special magic boolean words my %QUOTE = map { $_ => 1 } qw{ null Null NULL y Y yes Yes YES n N no No NO true True TRUE false False FALSE on On ON off Off OFF }; ##################################################################### # Implementation # Create an empty YAML::Tiny object sub new { my $class = shift; bless [ @_ ], $class; } # Create an object from a file sub read { my $class = ref $_[0] ? ref shift : shift; # Check the file my $file = shift or return $class->_error( 'You did not specify a file name' ); return $class->_error( "File '$file' does not exist" ) unless -e $file; return $class->_error( "'$file' is a directory, not a file" ) unless -f _; return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _; # Slurp in the file local $/ = undef; local *CFG; unless ( open(CFG, $file) ) { return $class->_error("Failed to open file '$file': $!"); } my $contents = ; unless ( close(CFG) ) { return $class->_error("Failed to close file '$file': $!"); } $class->read_string( $contents ); } # Create an object from a string sub read_string { my $class = ref $_[0] ? ref shift : shift; my $self = bless [], $class; my $string = $_[0]; eval { unless ( defined $string ) { die \"Did not provide a string to load"; } # Byte order marks # NOTE: Keeping this here to educate maintainers # my %BOM = ( # "\357\273\277" => 'UTF-8', # "\376\377" => 'UTF-16BE', # "\377\376" => 'UTF-16LE', # "\377\376\0\0" => 'UTF-32LE' # "\0\0\376\377" => 'UTF-32BE', # ); if ( $string =~ /^(?:\376\377|\377\376|\377\376\0\0|\0\0\376\377)/ ) { die \"Stream has a non UTF-8 BOM"; } else { # Strip UTF-8 bom if found, we'll just ignore it $string =~ s/^\357\273\277//; } # Try to decode as utf8 utf8::decode($string) if HAVE_UTF8; # Check for some special cases return $self unless length $string; unless ( $string =~ /[\012\015]+\z/ ) { die \"Stream does not end with newline character"; } # Split the file into lines my @lines = grep { ! /^\s*(?:\#.*)?\z/ } split /(?:\015{1,2}\012|\015|\012)/, $string; # Strip the initial YAML header @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines; # A nibbling parser while ( @lines ) { # Do we have a document header? if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) { # Handle scalar documents shift @lines; if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) { push @$self, $self->_read_scalar( "$1", [ undef ], \@lines ); next; } } if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) { # A naked document push @$self, undef; while ( @lines and $lines[0] !~ /^---/ ) { shift @lines; } } elsif ( $lines[0] =~ /^\s*\-/ ) { # An array at the root my $document = [ ]; push @$self, $document; $self->_read_array( $document, [ 0 ], \@lines ); } elsif ( $lines[0] =~ /^(\s*)\S/ ) { # A hash at the root my $document = { }; push @$self, $document; $self->_read_hash( $document, [ length($1) ], \@lines ); } else { die \"YAML::Tiny failed to classify the line '$lines[0]'"; } } }; if ( ref $@ eq 'SCALAR' ) { return $self->_error(${$@}); } elsif ( $@ ) { require Carp; Carp::croak($@); } return $self; } # Deparse a scalar string to the actual scalar sub _read_scalar { my ($self, $string, $indent, $lines) = @_; # Trim trailing whitespace $string =~ s/\s*\z//; # Explitic null/undef return undef if $string eq '~'; # Single quote if ( $string =~ /^\'(.*?)\'(?:\s+\#.*)?\z/ ) { return '' unless defined $1; $string = $1; $string =~ s/\'\'/\'/g; return $string; } # Double quote. # The commented out form is simpler, but overloaded the Perl regex # engine due to recursion and backtracking problems on strings # larger than 32,000ish characters. Keep it for reference purposes. # if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) { if ( $string =~ /^\"([^\\"]*(?:\\.[^\\"]*)*)\"(?:\s+\#.*)?\z/ ) { # Reusing the variable is a little ugly, # but avoids a new variable and a string copy. $string = $1; $string =~ s/\\"/"/g; $string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex; return $string; } # Special cases if ( $string =~ /^[\'\"!&]/ ) { die \"YAML::Tiny does not support a feature in line '$string'"; } return {} if $string =~ /^{}(?:\s+\#.*)?\z/; return [] if $string =~ /^\[\](?:\s+\#.*)?\z/; # Regular unquoted string if ( $string !~ /^[>|]/ ) { if ( $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or $string =~ /:(?:\s|$)/ ) { die \"YAML::Tiny found illegal characters in plain scalar: '$string'"; } $string =~ s/\s+#.*\z//; return $string; } # Error die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines; # Check the indent depth $lines->[0] =~ /^(\s*)/; $indent->[-1] = length("$1"); if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Pull the lines my @multiline = (); while ( @$lines ) { $lines->[0] =~ /^(\s*)/; last unless length($1) >= $indent->[-1]; push @multiline, substr(shift(@$lines), length($1)); } my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n"; my $t = (substr($string, 1, 1) eq '-') ? '' : "\n"; return join( $j, @multiline ) . $t; } # Parse an array sub _read_array { my ($self, $array, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) { # Inline nested hash my $indent2 = length("$1"); $lines->[0] =~ s/-/ /; push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) { # Array entry with a value shift @$lines; push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines ); } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) { shift @$lines; unless ( @$lines ) { push @$array, undef; return 1; } if ( $lines->[0] =~ /^(\s*)\-/ ) { my $indent2 = length("$1"); if ( $indent->[-1] == $indent2 ) { # Null array entry push @$array, undef; } else { # Naked indenter push @$array, [ ]; $self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines ); } } elsif ( $lines->[0] =~ /^(\s*)\S/ ) { push @$array, { }; $self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines ); } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) { # This is probably a structure like the following... # --- # foo: # - list # bar: value # # ... so lets return and let the hash parser handle it return 1; } else { die \"YAML::Tiny failed to classify line '$lines->[0]'"; } } return 1; } # Parse an array sub _read_hash { my ($self, $hash, $indent, $lines) = @_; while ( @$lines ) { # Check for a new document if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) { while ( @$lines and $lines->[0] !~ /^---/ ) { shift @$lines; } return 1; } # Check the indent level $lines->[0] =~ /^(\s*)/; if ( length($1) < $indent->[-1] ) { return 1; } elsif ( length($1) > $indent->[-1] ) { die \"YAML::Tiny found bad indenting in line '$lines->[0]'"; } # Get the key unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+(?:\#.*)?|$)// ) { if ( $lines->[0] =~ /^\s*[?\'\"]/ ) { die \"YAML::Tiny does not support a feature in line '$lines->[0]'"; } die \"YAML::Tiny failed to classify line '$lines->[0]'"; } my $key = $1; # Do we have a value? if ( length $lines->[0] ) { # Yes $hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines ); } else { # An indent shift @$lines; unless ( @$lines ) { $hash->{$key} = undef; return 1; } if ( $lines->[0] =~ /^(\s*)-/ ) { $hash->{$key} = []; $self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines ); } elsif ( $lines->[0] =~ /^(\s*)./ ) { my $indent2 = length("$1"); if ( $indent->[-1] >= $indent2 ) { # Null hash entry $hash->{$key} = undef; } else { $hash->{$key} = {}; $self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines ); } } } } return 1; } # Save an object to a file sub write { my $self = shift; my $file = shift or return $self->_error('No file name provided'); # Write it to the file open( CFG, '>' . $file ) or return $self->_error( "Failed to open file '$file' for writing: $!" ); print CFG $self->write_string; close CFG; return 1; } # Save an object to a string sub write_string { my $self = shift; return '' unless @$self; # Iterate over the documents my $indent = 0; my @lines = (); foreach my $cursor ( @$self ) { push @lines, '---'; # An empty document if ( ! defined $cursor ) { # Do nothing # A scalar document } elsif ( ! ref $cursor ) { $lines[-1] .= ' ' . $self->_write_scalar( $cursor, $indent ); # A list at the root } elsif ( ref $cursor eq 'ARRAY' ) { unless ( @$cursor ) { $lines[-1] .= ' []'; next; } push @lines, $self->_write_array( $cursor, $indent, {} ); # A hash at the root } elsif ( ref $cursor eq 'HASH' ) { unless ( %$cursor ) { $lines[-1] .= ' {}'; next; } push @lines, $self->_write_hash( $cursor, $indent, {} ); } else { Carp::croak("Cannot serialize " . ref($cursor)); } } join '', map { "$_\n" } @lines; } sub _write_scalar { my $string = $_[1]; return '~' unless defined $string; return "''" unless length $string; if ( $string =~ /[\x00-\x08\x0b-\x0d\x0e-\x1f\"\'\n]/ ) { $string =~ s/\\/\\\\/g; $string =~ s/"/\\"/g; $string =~ s/\n/\\n/g; $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g; return qq|"$string"|; } if ( $string =~ /(?:^\W|\s|:\z)/ or $QUOTE{$string} ) { return "'$string'"; } return $string; } sub _write_array { my ($self, $array, $indent, $seen) = @_; if ( $seen->{refaddr($array)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $el ( @$array ) { my $line = (' ' x $indent) . '-'; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } sub _write_hash { my ($self, $hash, $indent, $seen) = @_; if ( $seen->{refaddr($hash)}++ ) { die "YAML::Tiny does not support circular references"; } my @lines = (); foreach my $name ( sort keys %$hash ) { my $el = $hash->{$name}; my $line = (' ' x $indent) . "$name:"; my $type = ref $el; if ( ! $type ) { $line .= ' ' . $self->_write_scalar( $el, $indent + 1 ); push @lines, $line; } elsif ( $type eq 'ARRAY' ) { if ( @$el ) { push @lines, $line; push @lines, $self->_write_array( $el, $indent + 1, $seen ); } else { $line .= ' []'; push @lines, $line; } } elsif ( $type eq 'HASH' ) { if ( keys %$el ) { push @lines, $line; push @lines, $self->_write_hash( $el, $indent + 1, $seen ); } else { $line .= ' {}'; push @lines, $line; } } else { die "YAML::Tiny does not support $type references"; } } @lines; } # Set error sub _error { $YAML::Tiny::errstr = $_[1]; undef; } # Retrieve error sub errstr { $YAML::Tiny::errstr; } ##################################################################### # YAML Compatibility sub Dump { YAML::Tiny->new(@_)->write_string; } sub Load { my $self = YAML::Tiny->read_string(@_); unless ( $self ) { Carp::croak("Failed to load YAML document from string"); } if ( wantarray ) { return @$self; } else { # To match YAML.pm, return the last document return $self->[-1]; } } BEGIN { *freeze = *Dump; *thaw = *Load; } sub DumpFile { my $file = shift; YAML::Tiny->new(@_)->write($file); } sub LoadFile { my $self = YAML::Tiny->read($_[0]); unless ( $self ) { Carp::croak("Failed to load YAML document from '" . ($_[0] || '') . "'"); } if ( wantarray ) { return @$self; } else { # Return only the last document to match YAML.pm, return $self->[-1]; } } ##################################################################### # Use Scalar::Util if possible, otherwise emulate it BEGIN { local $@; eval { require Scalar::Util; }; my $v = eval("$Scalar::Util::VERSION") || 0; if ( $@ or $v < 1.18 ) { eval <<'END_PERL'; # Scalar::Util failed to load or too old sub refaddr { my $pkg = ref($_[0]) or return undef; if ( !! UNIVERSAL::can($_[0], 'can') ) { bless $_[0], 'Scalar::Util::Fake'; } else { $pkg = undef; } "$_[0]" =~ /0x(\w+)/; my $i = do { local $^W; hex $1 }; bless $_[0], $pkg if defined $pkg; $i; } END_PERL } else { *refaddr = *Scalar::Util::refaddr; } } 1; __END__ #line 1175 HTML-Microformats-0.105/inc/Scalar/0000755000076400007640000000000011775404022015032 5ustar taitaiHTML-Microformats-0.105/inc/Scalar/Util.pm0000644000076400007640000000210511775403725016314 0ustar taitai#line 1 # Scalar::Util.pm # # Copyright (c) 1997-2007 Graham Barr . All rights reserved. # This program is free software; you can redistribute it and/or # modify it under the same terms as Perl itself. package Scalar::Util; use strict; require Exporter; require List::Util; # List::Util loads the XS our @ISA = qw(Exporter); our @EXPORT_OK = qw(blessed dualvar reftype weaken isweak tainted readonly openhandle refaddr isvstring looks_like_number set_prototype); our $VERSION = "1.25"; $VERSION = eval $VERSION; our @EXPORT_FAIL; unless (defined &weaken) { push @EXPORT_FAIL, qw(weaken); } unless (defined &isweak) { push @EXPORT_FAIL, qw(isweak isvstring); } unless (defined &isvstring) { push @EXPORT_FAIL, qw(isvstring); } sub export_fail { if (grep { /^(?:weaken|isweak)$/ } @_ ) { require Carp; Carp::croak("Weak references are not implemented in the version of perl"); } if (grep { /^isvstring$/ } @_ ) { require Carp; Carp::croak("Vstrings are not implemented in the version of perl"); } @_; } 1; __END__ #line 261 HTML-Microformats-0.105/inc/unicore/0000755000076400007640000000000011775404022015271 5ustar taitaiHTML-Microformats-0.105/inc/unicore/Name.pm0000644000076400007640000002127311775403725016525 0ustar taitai#line 1 # !!!!!!! DO NOT EDIT THIS FILE !!!!!!! # This file is machine-generated by lib/unicore/mktables from the Unicode # database, Version 6.1.0. Any changes made here will be lost! # !!!!!!! INTERNAL PERL USE ONLY !!!!!!! # This file is for internal use by core Perl only. The format and even the # name or existence of this file are subject to change without notice. Don't # use it directly. package charnames; # This module contains machine-generated tables and code for the # algorithmically-determinable Unicode character names. The following # routines can be used to translate between name and code point and vice versa { # Closure # Matches legal code point. 4-6 hex numbers, If there are 6, the first # two must be 10; if there are 5, the first must not be a 0. Written this # way to decrease backtracking. The first regex allows the code point to # be at the end of a word, but to work properly, the word shouldn't end # with a valid hex character. The second one won't match a code point at # the end of a word, and doesn't have the run-on issue my $run_on_code_point_re = qr/(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b)/; my $code_point_re = qr/(?^aa:\b(?^aax: (?: 10[0-9A-F]{4} | [1-9A-F][0-9A-F]{4} | [0-9A-F]{4} ) \b))/; # In the following hash, the keys are the bases of names which includes # the code point in the name, like CJK UNIFIED IDEOGRAPH-4E01. The values # of each key is another hash which is used to get the low and high ends # for each range of code points that apply to the name. my %names_ending_in_code_point = ( 'CJK COMPATIBILITY IDEOGRAPH' => { 'high' => [ 64109, 64217, 195101, ], 'low' => [ 63744, 64112, 194560, ], }, 'CJK UNIFIED IDEOGRAPH' => { 'high' => [ 19893, 40908, 173782, 177972, 178205, ], 'low' => [ 13312, 19968, 131072, 173824, 177984, ], }, ); # The following hash is a copy of the previous one, except is for loose # matching, so each name has blanks and dashes squeezed out my %loose_names_ending_in_code_point = ( 'CJKCOMPATIBILITYIDEOGRAPH' => { 'high' => [ 64109, 64217, 195101, ], 'low' => [ 63744, 64112, 194560, ], }, 'CJKUNIFIEDIDEOGRAPH' => { 'high' => [ 19893, 40908, 173782, 177972, 178205, ], 'low' => [ 13312, 19968, 131072, 173824, 177984, ], }, ); # And the following array gives the inverse mapping from code points to # names. Lowest code points are first my @code_points_ending_in_code_point = ( { 'high' => 19893, 'low' => 13312, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 40908, 'low' => 19968, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 64109, 'low' => 63744, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, { 'high' => 64217, 'low' => 64112, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, { 'high' => 173782, 'low' => 131072, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 177972, 'low' => 173824, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 178205, 'low' => 177984, 'name' => 'CJK UNIFIED IDEOGRAPH', }, { 'high' => 195101, 'low' => 194560, 'name' => 'CJK COMPATIBILITY IDEOGRAPH', }, , ); # Convert from code point to Jamo short name for use in composing Hangul # syllable names my %Jamo = ( 4352 => 'G', 4353 => 'GG', 4354 => 'N', 4355 => 'D', 4356 => 'DD', 4357 => 'R', 4358 => 'M', 4359 => 'B', 4360 => 'BB', 4361 => 'S', 4362 => 'SS', 4363 => '', 4364 => 'J', 4365 => 'JJ', 4366 => 'C', 4367 => 'K', 4368 => 'T', 4369 => 'P', 4370 => 'H', 4449 => 'A', 4450 => 'AE', 4451 => 'YA', 4452 => 'YAE', 4453 => 'EO', 4454 => 'E', 4455 => 'YEO', 4456 => 'YE', 4457 => 'O', 4458 => 'WA', 4459 => 'WAE', 4460 => 'OE', 4461 => 'YO', 4462 => 'U', 4463 => 'WEO', 4464 => 'WE', 4465 => 'WI', 4466 => 'YU', 4467 => 'EU', 4468 => 'YI', 4469 => 'I', 4520 => 'G', 4521 => 'GG', 4522 => 'GS', 4523 => 'N', 4524 => 'NJ', 4525 => 'NH', 4526 => 'D', 4527 => 'L', 4528 => 'LG', 4529 => 'LM', 4530 => 'LB', 4531 => 'LS', 4532 => 'LT', 4533 => 'LP', 4534 => 'LH', 4535 => 'M', 4536 => 'B', 4537 => 'BS', 4538 => 'S', 4539 => 'SS', 4540 => 'NG', 4541 => 'J', 4542 => 'C', 4543 => 'K', 4544 => 'T', 4545 => 'P', 4546 => 'H', ); # Leading consonant (can be null) my %Jamo_L = ( '' => 11, 'B' => 7, 'BB' => 8, 'C' => 14, 'D' => 3, 'DD' => 4, 'G' => 0, 'GG' => 1, 'H' => 18, 'J' => 12, 'JJ' => 13, 'K' => 15, 'M' => 6, 'N' => 2, 'P' => 17, 'R' => 5, 'S' => 9, 'SS' => 10, 'T' => 16, ); # Vowel my %Jamo_V = ( 'A' => 0, 'AE' => 1, 'E' => 5, 'EO' => 4, 'EU' => 18, 'I' => 20, 'O' => 8, 'OE' => 11, 'U' => 13, 'WA' => 9, 'WAE' => 10, 'WE' => 15, 'WEO' => 14, 'WI' => 16, 'YA' => 2, 'YAE' => 3, 'YE' => 7, 'YEO' => 6, 'YI' => 19, 'YO' => 12, 'YU' => 17, ); # Optional trailing consonant my %Jamo_T = ( 'B' => 17, 'BS' => 18, 'C' => 23, 'D' => 7, 'G' => 1, 'GG' => 2, 'GS' => 3, 'H' => 27, 'J' => 22, 'K' => 24, 'L' => 8, 'LB' => 11, 'LG' => 9, 'LH' => 15, 'LM' => 10, 'LP' => 14, 'LS' => 12, 'LT' => 13, 'M' => 16, 'N' => 4, 'NG' => 21, 'NH' => 6, 'NJ' => 5, 'P' => 26, 'S' => 19, 'SS' => 20, 'T' => 25, ); # Computed re that splits up a Hangul name into LVT or LV syllables my $syllable_re = qr/(|B|BB|C|D|DD|G|GG|H|J|JJ|K|M|N|P|R|S|SS|T)(A|AE|E|EO|EU|I|O|OE|U|WA|WAE|WE|WEO|WI|YA|YAE|YE|YEO|YI|YO|YU)(B|BS|C|D|G|GG|GS|H|J|K|L|LB|LG|LH|LM|LP|LS|LT|M|N|NG|NH|NJ|P|S|SS|T)?/; my $HANGUL_SYLLABLE = "HANGUL SYLLABLE "; my $loose_HANGUL_SYLLABLE = "HANGULSYLLABLE"; # These constants names and values were taken from the Unicode standard, # version 5.1, section 3.12. They are used in conjunction with Hangul # syllables my $SBase = 0xAC00; my $LBase = 0x1100; my $VBase = 0x1161; my $TBase = 0x11A7; my $SCount = 11172; my $LCount = 19; my $VCount = 21; my $TCount = 28; my $NCount = $VCount * $TCount; sub name_to_code_point_special { my ($name, $loose) = @_; # Returns undef if not one of the specially handled names; otherwise # returns the code point equivalent to the input name # $loose is non-zero if to use loose matching, 'name' in that case # must be input as upper case with all blanks and dashes squeezed out. if ((! $loose && $name =~ s/$HANGUL_SYLLABLE//) || ($loose && $name =~ s/$loose_HANGUL_SYLLABLE//)) { return if $name !~ qr/^$syllable_re$/; my $L = $Jamo_L{$1}; my $V = $Jamo_V{$2}; my $T = (defined $3) ? $Jamo_T{$3} : 0; return ($L * $VCount + $V) * $TCount + $T + $SBase; } # Name must end in 'code_point' for this to handle. return if (($loose && $name !~ /^ (.*?) ($run_on_code_point_re) $/x) || (! $loose && $name !~ /^ (.*) ($code_point_re) $/x)); my $base = $1; my $code_point = CORE::hex $2; my $names_ref; if ($loose) { $names_ref = \%loose_names_ending_in_code_point; } else { return if $base !~ s/-$//; $names_ref = \%names_ending_in_code_point; } # Name must be one of the ones which has the code point in it. return if ! $names_ref->{$base}; # Look through the list of ranges that apply to this name to see if # the code point is in one of them. for (my $i = 0; $i < scalar @{$names_ref->{$base}{'low'}}; $i++) { return if $names_ref->{$base}{'low'}->[$i] > $code_point; next if $names_ref->{$base}{'high'}->[$i] < $code_point; # Here, the code point is in the range. return $code_point; } # Here, looked like the name had a code point number in it, but # did not match one of the valid ones. return; } sub code_point_to_name_special { my $code_point = shift; # Returns the name of a code point if algorithmically determinable; # undef if not # If in the Hangul range, calculate the name based on Unicode's # algorithm if ($code_point >= $SBase && $code_point <= $SBase + $SCount -1) { use integer; my $SIndex = $code_point - $SBase; my $L = $LBase + $SIndex / $NCount; my $V = $VBase + ($SIndex % $NCount) / $TCount; my $T = $TBase + $SIndex % $TCount; $name = "$HANGUL_SYLLABLE$Jamo{$L}$Jamo{$V}"; $name .= $Jamo{$T} if $T != $TBase; return $name; } # Look through list of these code points for one in range. foreach my $hash (@code_points_ending_in_code_point) { return if $code_point < $hash->{'low'}; if ($code_point <= $hash->{'high'}) { return sprintf("%s-%04X", $hash->{'name'}, $code_point); } } return; # None found } } # End closure 1; HTML-Microformats-0.105/inc/utf8.pm0000644000076400007640000000061511775403725015064 0ustar taitai#line 1 package utf8; $utf8::hint_bits = 0x00800000; our $VERSION = '1.09'; sub import { $^H |= $utf8::hint_bits; $enc{caller()} = $_[1] if $_[1]; } sub unimport { $^H &= ~$utf8::hint_bits; } sub AUTOLOAD { require "utf8_heavy.pl"; goto &$AUTOLOAD if defined &$AUTOLOAD; require Carp; Carp::croak("Undefined subroutine $AUTOLOAD called"); } 1; __END__ #line 214 HTML-Microformats-0.105/inc/Module/0000755000076400007640000000000011775404022015052 5ustar taitaiHTML-Microformats-0.105/inc/Module/AutoInstall.pm0000644000076400007640000006216211775403736017671 0ustar taitai#line 1 package Module::AutoInstall; use strict; use Cwd (); use File::Spec (); use ExtUtils::MakeMaker (); use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # special map on pre-defined feature sets my %FeatureMap = ( '' => 'Core Features', # XXX: deprecated '-core' => 'Core Features', ); # various lexical flags my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS ); my ( $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps, $UpgradeDeps ); my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps, $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps, $PostambleActionsListAllDeps, $PostambleUsed, $NoTest); # See if it's a testing or non-interactive session _accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN ); _init(); sub _accept_default { $AcceptDefault = shift; } sub _installdeps_target { $InstallDepsTarget = shift; } sub missing_modules { return @Missing; } sub do_install { __PACKAGE__->install( [ $Config ? ( UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) : () ], @Missing, ); } # initialize various flags, and/or perform install sub _init { foreach my $arg ( @ARGV, split( /[\s\t]+/, $ENV{PERL_AUTOINSTALL} || $ENV{PERL_EXTUTILS_AUTOINSTALL} || '' ) ) { if ( $arg =~ /^--config=(.*)$/ ) { $Config = [ split( ',', $1 ) ]; } elsif ( $arg =~ /^--installdeps=(.*)$/ ) { __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) { $UpgradeDeps = 1; __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) ); exit 0; } elsif ( $arg =~ /^--default(?:deps)?$/ ) { $AcceptDefault = 1; } elsif ( $arg =~ /^--check(?:deps)?$/ ) { $CheckOnly = 1; } elsif ( $arg =~ /^--skip(?:deps)?$/ ) { $SkipInstall = 1; } elsif ( $arg =~ /^--test(?:only)?$/ ) { $TestOnly = 1; } elsif ( $arg =~ /^--all(?:deps)?$/ ) { $AllDeps = 1; } } } # overrides MakeMaker's prompt() to automatically accept the default choice sub _prompt { goto &ExtUtils::MakeMaker::prompt unless $AcceptDefault; my ( $prompt, $default ) = @_; my $y = ( $default =~ /^[Yy]/ ); print $prompt, ' [', ( $y ? 'Y' : 'y' ), '/', ( $y ? 'n' : 'N' ), '] '; print "$default\n"; return $default; } # the workhorse sub import { my $class = shift; my @args = @_ or return; my $core_all; print "*** $class version " . $class->VERSION . "\n"; print "*** Checking for Perl dependencies...\n"; my $cwd = Cwd::cwd(); $Config = []; my $maxlen = length( ( sort { length($b) <=> length($a) } grep { /^[^\-]/ } map { ref($_) ? ( ( ref($_) eq 'HASH' ) ? keys(%$_) : @{$_} ) : '' } map { +{@args}->{$_} } grep { /^[^\-]/ or /^-core$/i } keys %{ +{@args} } )[0] ); # We want to know if we're under CPAN early to avoid prompting, but # if we aren't going to try and install anything anyway then skip the # check entirely since we don't want to have to load (and configure) # an old CPAN just for a cosmetic message $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget; while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) { my ( @required, @tests, @skiptests ); my $default = 1; my $conflict = 0; if ( $feature =~ m/^-(\w+)$/ ) { my $option = lc($1); # check for a newer version of myself _update_to( $modules, @_ ) and return if $option eq 'version'; # sets CPAN configuration options $Config = $modules if $option eq 'config'; # promote every features to core status $core_all = ( $modules =~ /^all$/i ) and next if $option eq 'core'; next unless $option eq 'core'; } print "[" . ( $FeatureMap{ lc($feature) } || $feature ) . "]\n"; $modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' ); unshift @$modules, -default => &{ shift(@$modules) } if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) { if ( $mod =~ m/^-(\w+)$/ ) { my $option = lc($1); $default = $arg if ( $option eq 'default' ); $conflict = $arg if ( $option eq 'conflict' ); @tests = @{$arg} if ( $option eq 'tests' ); @skiptests = @{$arg} if ( $option eq 'skiptests' ); next; } printf( "- %-${maxlen}s ...", $mod ); if ( $arg and $arg =~ /^\D/ ) { unshift @$modules, $arg; $arg = 0; } # XXX: check for conflicts and uninstalls(!) them. my $cur = _version_of($mod); if (_version_cmp ($cur, $arg) >= 0) { print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n"; push @Existing, $mod => $arg; $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { if (not defined $cur) # indeed missing { print "missing." . ( $arg ? " (would need $arg)" : '' ) . "\n"; } else { # no need to check $arg as _version_cmp ($cur, undef) would satisfy >= above print "too old. ($cur < $arg)\n"; } push @required, $mod => $arg; } } next unless @required; my $mandatory = ( $feature eq '-core' or $core_all ); if ( !$SkipInstall and ( $CheckOnly or ($mandatory and $UnderCPAN) or $AllDeps or $InstallDepsTarget or _prompt( qq{==> Auto-install the } . ( @required / 2 ) . ( $mandatory ? ' mandatory' : ' optional' ) . qq{ module(s) from CPAN?}, $default ? 'y' : 'n', ) =~ /^[Yy]/ ) ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } elsif ( !$SkipInstall and $default and $mandatory and _prompt( qq{==> The module(s) are mandatory! Really skip?}, 'n', ) =~ /^[Nn]/ ) { push( @Missing, @required ); $DisabledTests{$_} = 1 for map { glob($_) } @skiptests; } else { $DisabledTests{$_} = 1 for map { glob($_) } @tests; } } if ( @Missing and not( $CheckOnly or $UnderCPAN) ) { require Config; my $make = $Config::Config{make}; if ($InstallDepsTarget) { print "*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n"; } else { print "*** Dependencies will be installed the next time you type '$make'.\n"; } # make an educated guess of whether we'll need root permission. print " (You may need to do that as the 'root' user.)\n" if eval '$>'; } print "*** $class configuration finished.\n"; chdir $cwd; # import to main:: no strict 'refs'; *{'main::WriteMakefile'} = \&Write if caller(0) eq 'main'; return (@Existing, @Missing); } sub _running_under { my $thing = shift; print <<"END_MESSAGE"; *** Since we're running under ${thing}, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } # Check to see if we are currently running under CPAN.pm and/or CPANPLUS; # if we are, then we simply let it taking care of our dependencies sub _check_lock { return unless @Missing or @_; if ($ENV{PERL5_CPANM_IS_RUNNING}) { return _running_under('cpanminus'); } my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING}; if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) { return _running_under($cpan_env ? 'CPAN' : 'CPANPLUS'); } require CPAN; if ($CPAN::VERSION > '1.89') { if ($cpan_env) { return _running_under('CPAN'); } return; # CPAN.pm new enough, don't need to check further } # last ditch attempt, this -will- configure CPAN, very sorry _load_cpan(1); # force initialize even though it's already loaded # Find the CPAN lock-file my $lock = MM->catfile( $CPAN::Config->{cpan_home}, ".lock" ); return unless -f $lock; # Check the lock local *LOCK; return unless open(LOCK, $lock); if ( ( $^O eq 'MSWin32' ? _under_cpan() : == getppid() ) and ( $CPAN::Config->{prerequisites_policy} || '' ) ne 'ignore' ) { print <<'END_MESSAGE'; *** Since we're running under CPAN, I'll just let it take care of the dependency's installation later. END_MESSAGE return 1; } close LOCK; return; } sub install { my $class = shift; my $i; # used below to strip leading '-' from config keys my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } ); my ( @modules, @installed ); while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) { # grep out those already installed if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } else { push @modules, $pkg, $ver; } } if ($UpgradeDeps) { push @modules, @installed; @installed = (); } return @installed unless @modules; # nothing to do return @installed if _check_lock(); # defer to the CPAN shell print "*** Installing dependencies...\n"; return unless _connected_to('cpan.org'); my %args = @config; my %failed; local *FAILED; if ( $args{do_once} and open( FAILED, '.#autoinstall.failed' ) ) { while () { chomp; $failed{$_}++ } close FAILED; my @newmod; while ( my ( $k, $v ) = splice( @modules, 0, 2 ) ) { push @newmod, ( $k => $v ) unless $failed{$k}; } @modules = @newmod; } if ( _has_cpanplus() and not $ENV{PERL_AUTOINSTALL_PREFER_CPAN} ) { _install_cpanplus( \@modules, \@config ); } else { _install_cpan( \@modules, \@config ); } print "*** $class installation finished.\n"; # see if we have successfully installed them while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) { push @installed, $pkg; } elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) { print FAILED "$pkg\n"; } } close FAILED if $args{do_once}; return @installed; } sub _install_cpanplus { my @modules = @{ +shift }; my @config = _cpanplus_config( @{ +shift } ); my $installed = 0; require CPANPLUS::Backend; my $cp = CPANPLUS::Backend->new; my $conf = $cp->configure_object; return unless $conf->can('conf') # 0.05x+ with "sudo" support or _can_write($conf->_get_build('base')); # 0.04x # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $conf->get_conf('makeflags') || ''; if ( UNIVERSAL::isa( $makeflags, 'HASH' ) ) { # 0.03+ uses a hashref here $makeflags->{UNINST} = 1 unless exists $makeflags->{UNINST}; } else { # 0.02 and below uses a scalar $makeflags = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); } $conf->set_conf( makeflags => $makeflags ); $conf->set_conf( prereqs => 1 ); while ( my ( $key, $val ) = splice( @config, 0, 2 ) ) { $conf->set_conf( $key, $val ); } my $modtree = $cp->module_tree; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { print "*** Installing $pkg...\n"; MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; my $success; my $obj = $modtree->{$pkg}; if ( $obj and _version_cmp( $obj->{version}, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = $cp->install( modules => [ $obj->{module} ] ); if ( $rv and ( $rv->{ $obj->{module} } or $rv->{ok} ) ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation cancelled.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _cpanplus_config { my @config = (); while ( @_ ) { my ($key, $value) = (shift(), shift()); if ( $key eq 'prerequisites_policy' ) { if ( $value eq 'follow' ) { $value = CPANPLUS::Internals::Constants::PREREQ_INSTALL(); } elsif ( $value eq 'ask' ) { $value = CPANPLUS::Internals::Constants::PREREQ_ASK(); } elsif ( $value eq 'ignore' ) { $value = CPANPLUS::Internals::Constants::PREREQ_IGNORE(); } else { die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n"; } push @config, 'prereqs', $value; } elsif ( $key eq 'force' ) { push @config, $key, $value; } elsif ( $key eq 'notest' ) { push @config, 'skiptest', $value; } else { die "*** Cannot convert option $key to CPANPLUS version.\n"; } } return @config; } sub _install_cpan { my @modules = @{ +shift }; my @config = @{ +shift }; my $installed = 0; my %args; _load_cpan(); require Config; if (CPAN->VERSION < 1.80) { # no "sudo" support, probe for writableness return unless _can_write( MM->catfile( $CPAN::Config->{cpan_home}, 'sources' ) ) and _can_write( $Config::Config{sitelib} ); } # if we're root, set UNINST=1 to avoid trouble unless user asked for it. my $makeflags = $CPAN::Config->{make_install_arg} || ''; $CPAN::Config->{make_install_arg} = join( ' ', split( ' ', $makeflags ), 'UNINST=1' ) if ( $makeflags !~ /\bUNINST\b/ and eval qq{ $> eq '0' } ); # don't show start-up info $CPAN::Config->{inhibit_startup_message} = 1; # set additional options while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) { ( $args{$opt} = $arg, next ) if $opt =~ /^(?:force|notest)$/; # pseudo-option $CPAN::Config->{$opt} = $arg; } if ($args{notest} && (not CPAN::Shell->can('notest'))) { die "Your version of CPAN is too old to support the 'notest' pragma"; } local $CPAN::Config->{prerequisites_policy} = 'follow'; while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) { MY::preinstall( $pkg, $ver ) or next if defined &MY::preinstall; print "*** Installing $pkg...\n"; my $obj = CPAN::Shell->expand( Module => $pkg ); my $success = 0; if ( $obj and _version_cmp( $obj->cpan_version, $ver ) >= 0 ) { my $pathname = $pkg; $pathname =~ s/::/\\W/; foreach my $inc ( grep { m/$pathname.pm/i } keys(%INC) ) { delete $INC{$inc}; } my $rv = do { if ($args{force}) { CPAN::Shell->force( install => $pkg ) } elsif ($args{notest}) { CPAN::Shell->notest( install => $pkg ) } else { CPAN::Shell->install($pkg) } }; $rv ||= eval { $CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, ) ->{install} if $CPAN::META; }; if ( $rv eq 'YES' ) { print "*** $pkg successfully installed.\n"; $success = 1; } else { print "*** $pkg installation failed.\n"; $success = 0; } $installed += $success; } else { print << "."; *** Could not find a version $ver or above for $pkg; skipping. . } MY::postinstall( $pkg, $ver, $success ) if defined &MY::postinstall; } return $installed; } sub _has_cpanplus { return ( $HasCPANPLUS = ( $INC{'CPANPLUS/Config.pm'} or _load('CPANPLUS::Shell::Default') ) ); } # make guesses on whether we're under the CPAN installation directory sub _under_cpan { require Cwd; require File::Spec; my $cwd = File::Spec->canonpath( Cwd::cwd() ); my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} ); return ( index( $cwd, $cpan ) > -1 ); } sub _update_to { my $class = __PACKAGE__; my $ver = shift; return if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade if ( _prompt( "==> A newer version of $class ($ver) is required. Install?", 'y' ) =~ /^[Nn]/ ) { die "*** Please install $class $ver manually.\n"; } print << "."; *** Trying to fetch it from CPAN... . # install ourselves _load($class) and return $class->import(@_) if $class->install( [], $class, $ver ); print << '.'; exit 1; *** Cannot bootstrap myself. :-( Installation terminated. . } # check if we're connected to some host, using inet_aton sub _connected_to { my $site = shift; return ( ( _load('Socket') and Socket::inet_aton($site) ) or _prompt( qq( *** Your host cannot resolve the domain name '$site', which probably means the Internet connections are unavailable. ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/ ); } # check if a directory is writable; may create it on demand sub _can_write { my $path = shift; mkdir( $path, 0755 ) unless -e $path; return 1 if -w $path; print << "."; *** You are not allowed to write to the directory '$path'; the installation may fail due to insufficient permissions. . if ( eval '$>' and lc(`sudo -V`) =~ /version/ and _prompt( qq( ==> Should we try to re-execute the autoinstall process with 'sudo'?), ((-t STDIN) ? 'y' : 'n') ) =~ /^[Yy]/ ) { # try to bootstrap ourselves from sudo print << "."; *** Trying to re-execute the autoinstall process with 'sudo'... . my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; return unless system( 'sudo', $^X, $0, "--config=$config", "--installdeps=$missing" ); print << "."; *** The 'sudo' command exited with error! Resuming... . } return _prompt( qq( ==> Should we try to install the required module(s) anyway?), 'n' ) =~ /^[Yy]/; } # load a module and return the version it reports sub _load { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; local $@; return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 ); } # report version without loading a module sub _version_of { my $mod = pop; # method/function doesn't matter my $file = $mod; $file =~ s|::|/|g; $file .= '.pm'; foreach my $dir ( @INC ) { next if ref $dir; my $path = File::Spec->catfile($dir, $file); next unless -e $path; require ExtUtils::MM_Unix; return ExtUtils::MM_Unix->parse_version($path); } return undef; } # Load CPAN.pm and it's configuration sub _load_cpan { return if $CPAN::VERSION and $CPAN::Config and not @_; require CPAN; # CPAN-1.82+ adds CPAN::Config::AUTOLOAD to redirect to # CPAN::HandleConfig->load. CPAN reports that the redirection # is deprecated in a warning printed at the user. # CPAN-1.81 expects CPAN::HandleConfig->load, does not have # $CPAN::HandleConfig::VERSION but cannot handle # CPAN::Config->load # Which "versions expect CPAN::Config->load? if ( $CPAN::HandleConfig::VERSION || CPAN::HandleConfig->can('load') ) { # Newer versions of CPAN have a HandleConfig module CPAN::HandleConfig->load; } else { # Older versions had the load method in Config directly CPAN::Config->load; } } # compare two versions, either use Sort::Versions or plain comparison # return values same as <=> sub _version_cmp { my ( $cur, $min ) = @_; return -1 unless defined $cur; # if 0 keep comparing return 1 unless $min; $cur =~ s/\s+$//; # check for version numbers that are not in decimal format if ( ref($cur) or ref($min) or $cur =~ /v|\..*\./ or $min =~ /v|\..*\./ ) { if ( ( $version::VERSION or defined( _load('version') )) and version->can('new') ) { # use version.pm if it is installed. return version->new($cur) <=> version->new($min); } elsif ( $Sort::Versions::VERSION or defined( _load('Sort::Versions') ) ) { # use Sort::Versions as the sorting algorithm for a.b.c versions return Sort::Versions::versioncmp( $cur, $min ); } warn "Cannot reliably compare non-decimal formatted versions.\n" . "Please install version.pm or Sort::Versions.\n"; } # plain comparison local $^W = 0; # shuts off 'not numeric' bugs return $cur <=> $min; } # nothing; this usage is deprecated. sub main::PREREQ_PM { return {}; } sub _make_args { my %args = @_; $args{PREREQ_PM} = { %{ $args{PREREQ_PM} || {} }, @Existing, @Missing } if $UnderCPAN or $TestOnly; if ( $args{EXE_FILES} and -e 'MANIFEST' ) { require ExtUtils::Manifest; my $manifest = ExtUtils::Manifest::maniread('MANIFEST'); $args{EXE_FILES} = [ grep { exists $manifest->{$_} } @{ $args{EXE_FILES} } ]; } $args{test}{TESTS} ||= 't/*.t'; $args{test}{TESTS} = join( ' ', grep { !exists( $DisabledTests{$_} ) } map { glob($_) } split( /\s+/, $args{test}{TESTS} ) ); my $missing = join( ',', @Missing ); my $config = join( ',', UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config} ) if $Config; $PostambleActions = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); my $deps_list = join( ',', @Missing, @Existing ); $PostambleActionsUpgradeDeps = "\$(PERL) $0 --config=$config --upgradedeps=$deps_list"; my $config_notest = join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}), 'notest', 1 ) if $Config; $PostambleActionsNoTest = ( ($missing and not $UnderCPAN) ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing" : "\$(NOECHO) \$(NOOP)" ); $PostambleActionsUpgradeDepsNoTest = "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list"; $PostambleActionsListDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing); my @all = (@Missing, @Existing); $PostambleActionsListAllDeps = '@$(PERL) -le "print for @ARGV" ' . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all); return %args; } # a wrapper to ExtUtils::MakeMaker::WriteMakefile sub Write { require Carp; Carp::croak "WriteMakefile: Need even number of args" if @_ % 2; if ($CheckOnly) { print << "."; *** Makefile not written in check-only mode. . return; } my %args = _make_args(@_); no strict 'refs'; $PostambleUsed = 0; local *MY::postamble = \&postamble unless defined &MY::postamble; ExtUtils::MakeMaker::WriteMakefile(%args); print << "." unless $PostambleUsed; *** WARNING: Makefile written with customized MY::postamble() without including contents from Module::AutoInstall::postamble() -- auto installation features disabled. Please contact the author. . return 1; } sub postamble { $PostambleUsed = 1; my $fragment; $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget; config :: installdeps \t\$(NOECHO) \$(NOOP) AUTO_INSTALL $fragment .= <<"END_MAKE"; checkdeps :: \t\$(PERL) $0 --checkdeps installdeps :: \t$PostambleActions installdeps_notest :: \t$PostambleActionsNoTest upgradedeps :: \t$PostambleActionsUpgradeDeps upgradedeps_notest :: \t$PostambleActionsUpgradeDepsNoTest listdeps :: \t$PostambleActionsListDeps listalldeps :: \t$PostambleActionsListAllDeps END_MAKE return $fragment; } 1; __END__ #line 1193 HTML-Microformats-0.105/inc/Module/Package.pm0000644000076400007640000000311411775403740016750 0ustar taitai#line 1 ## # name: Module::Package # abstract: Postmodern Perl Module Packaging # author: Ingy döt Net # license: perl # copyright: 2011 # see: # - Module::Package::Plugin # - Module::Install::Package # - Module::Package::Tutorial package Module::Package; use 5.005; use strict; BEGIN { $Module::Package::VERSION = '0.30'; $inc::Module::Package::VERSION ||= $Module::Package::VERSION; @inc::Module::Package::ISA = __PACKAGE__; } sub import { my $class = shift; $INC{'inc/Module/Install.pm'} = __FILE__; unshift @INC, 'inc' unless $INC[0] eq 'inc'; eval "use Module::Install 1.01 (); 1" or $class->error($@); package main; Module::Install->import(); eval { module_package_internals_version_check($Module::Package::VERSION); module_package_internals_init(@_); }; if ($@) { $Module::Package::ERROR = $@; die $@; } } # XXX Remove this when things are stable. sub error { my ($class, $error) = @_; if (-e 'inc' and not -e 'inc/.author') { require Data::Dumper; $Data::Dumper::Sortkeys = 1; my $dump1 = Data::Dumper::Dumper(\%INC); my $dump2 = Data::Dumper::Dumper(\@INC); die <<"..."; This should not have happened. Hopefully this dump will explain the problem: inc::Module::Package: $inc::Module::Package::VERSION Module::Package: $Module::Package::VERSION inc::Module::Install: $inc::Module::Install::VERSION Module::Install: $Module::Install::VERSION Error: $error %INC: $dump1 \@INC: $dump2 ... } else { die $error; } } 1; HTML-Microformats-0.105/inc/Module/Install/0000755000076400007640000000000011775404022016460 5ustar taitaiHTML-Microformats-0.105/inc/Module/Install/Fetch.pm0000644000076400007640000000462711775403737020074 0ustar taitai#line 1 package Module::Install::Fetch; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub get_file { my ($self, %args) = @_; my ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) { $args{url} = $args{ftp_url} or (warn("LWP support unavailable!\n"), return); ($scheme, $host, $path, $file) = $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return; } $|++; print "Fetching '$file' from $host... "; unless (eval { require Socket; Socket::inet_aton($host) }) { warn "'$host' resolve failed!\n"; return; } return unless $scheme eq 'ftp' or $scheme eq 'http'; require Cwd; my $dir = Cwd::getcwd(); chdir $args{local_dir} or return if exists $args{local_dir}; if (eval { require LWP::Simple; 1 }) { LWP::Simple::mirror($args{url}, $file); } elsif (eval { require Net::FTP; 1 }) { eval { # use Net::FTP to get past firewall my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600); $ftp->login("anonymous", 'anonymous@example.com'); $ftp->cwd($path); $ftp->binary; $ftp->get($file) or (warn("$!\n"), return); $ftp->quit; } } elsif (my $ftp = $self->can_run('ftp')) { eval { # no Net::FTP, fallback to ftp.exe require FileHandle; my $fh = FileHandle->new; local $SIG{CHLD} = 'IGNORE'; unless ($fh->open("|$ftp -n")) { warn "Couldn't open ftp: $!\n"; chdir $dir; return; } my @dialog = split(/\n/, <<"END_FTP"); open $host user anonymous anonymous\@example.com cd $path binary get $file $file quit END_FTP foreach (@dialog) { $fh->print("$_\n") } $fh->close; } } else { warn "No working 'ftp' program available!\n"; chdir $dir; return; } unless (-f $file) { warn "Fetching failed: $@\n"; chdir $dir; return; } return if exists $args{size} and -s $file != $args{size}; system($args{run}) if exists $args{run}; unlink($file) if $args{remove}; print(((!exists $args{check_for} or -e $args{check_for}) ? "done!" : "failed! ($!)"), "\n"); chdir $dir; return !$?; } 1; HTML-Microformats-0.105/inc/Module/Install/AutoInstall.pm0000644000076400007640000000416211775403736021273 0ustar taitai#line 1 package Module::Install::AutoInstall; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub AutoInstall { $_[0] } sub run { my $self = shift; $self->auto_install_now(@_); } sub write { my $self = shift; $self->auto_install(@_); } sub auto_install { my $self = shift; return if $self->{done}++; # Flatten array of arrays into a single array my @core = map @$_, map @$_, grep ref, $self->build_requires, $self->requires; my @config = @_; # We'll need Module::AutoInstall $self->include('Module::AutoInstall'); require Module::AutoInstall; my @features_require = Module::AutoInstall->import( (@config ? (-config => \@config) : ()), (@core ? (-core => \@core) : ()), $self->features, ); my %seen; my @requires = map @$_, map @$_, grep ref, $self->requires; while (my ($mod, $ver) = splice(@requires, 0, 2)) { $seen{$mod}{$ver}++; } my @build_requires = map @$_, map @$_, grep ref, $self->build_requires; while (my ($mod, $ver) = splice(@build_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @configure_requires = map @$_, map @$_, grep ref, $self->configure_requires; while (my ($mod, $ver) = splice(@configure_requires, 0, 2)) { $seen{$mod}{$ver}++; } my @deduped; while (my ($mod, $ver) = splice(@features_require, 0, 2)) { push @deduped, $mod => $ver unless $seen{$mod}{$ver}++; } $self->requires(@deduped); $self->makemaker_args( Module::AutoInstall::_make_args() ); my $class = ref($self); $self->postamble( "# --- $class section:\n" . Module::AutoInstall::postamble() ); } sub installdeps_target { my ($self, @args) = @_; $self->include('Module::AutoInstall'); require Module::AutoInstall; Module::AutoInstall::_installdeps_target(1); $self->auto_install(@args); } sub auto_install_now { my $self = shift; $self->auto_install(@_); Module::AutoInstall::do_install(); } 1; HTML-Microformats-0.105/inc/Module/Install/Package.pm0000644000076400007640000002340511775403723020364 0ustar taitai#line 1 ## # name: Module::Install::Package # abstract: Module::Install support for Module::Package # author: Ingy döt Net # license: perl # copyright: 2011 # see: # - Module::Package # This module contains the Module::Package logic that must be available to # both the Author and the End User. Author-only logic goes in a # Module::Package::Plugin subclass. package Module::Install::Package; use strict; use Module::Install::Base; use vars qw'@ISA $VERSION'; @ISA = 'Module::Install::Base'; $VERSION = '0.30'; #-----------------------------------------------------------------------------# # XXX BOOTBUGHACK # This is here to try to get us out of Module-Package-0.11 cpantesters hell... # Remove this when the situation has blown over. sub pkg { *inc::Module::Package::VERSION = sub { $VERSION }; my $self = shift; $self->module_package_internals_init($@); } #-----------------------------------------------------------------------------# # We allow the author to specify key/value options after the plugin. These # options need to be available both at author time and install time. #-----------------------------------------------------------------------------# # OO accessor for command line options: sub package_options { @_>1?($_[0]->{package_options}=$_[1]):$_[0]->{package_options}} my $default_options = { deps_list => 1, install_bin => 1, install_share => 1, manifest_skip => 1, requires_from => 1, }; #-----------------------------------------------------------------------------# # Module::Install plugin directives. Use long, ugly names to not pollute the # Module::Install plugin namespace. These are only intended to be called from # Module::Package. #-----------------------------------------------------------------------------# # Module::Package starts off life as a normal call to this Module::Install # plugin directive: my $module_install_plugin; my $module_package_plugin; my $module_package_dist_plugin; # XXX ARGVHACK This @argv thing is a temporary fix for an ugly bug somewhere in the # Wikitext module usage. my @argv; sub module_package_internals_init { my $self = $module_install_plugin = shift; my ($plugin_spec, %options) = @_; $self->package_options({%$default_options, %options}); if ($module_install_plugin->is_admin) { $module_package_plugin = $self->_load_plugin($plugin_spec); $module_package_plugin->mi($module_install_plugin); $module_package_plugin->version_check($VERSION); } else { $module_package_dist_plugin = $self->_load_dist_plugin($plugin_spec); $module_package_dist_plugin->mi($module_install_plugin) if ref $module_package_dist_plugin; } # NOTE - This is the point in time where the body of Makefile.PL runs... return; sub INIT { return unless $module_install_plugin; return if $Module::Package::ERROR; eval { if ($module_install_plugin->is_admin) { $module_package_plugin->initial(); $module_package_plugin->main(); } else { $module_install_plugin->_initial(); $module_package_dist_plugin->_initial() if ref $module_package_dist_plugin; $module_install_plugin->_main(); $module_package_dist_plugin->_main() if ref $module_package_dist_plugin; } }; if ($@) { $Module::Package::ERROR = $@; die $@; } @argv = @ARGV; # XXX ARGVHACK } # If this Module::Install plugin was used (by Module::Package) then wrap # up any loose ends. This will get called after Makefile.PL has completed. sub END { @ARGV = @argv; # XXX ARGVHACK return unless $module_install_plugin; return if $Module::Package::ERROR; $module_package_plugin ? do { $module_package_plugin->final; $module_package_plugin->replicate_module_package; } : do { $module_install_plugin->_final; $module_package_dist_plugin->_final() if ref $module_package_dist_plugin; } } } # Module::Package, Module::Install::Package and Module::Package::Plugin # must all have the same version. Seems wise. sub module_package_internals_version_check { my ($self, $version) = @_; return if $version < 0.1800001; # XXX BOOTBUGHACK!! die <<"..." unless $version == $VERSION; Error! Something has gone awry: Module::Package version=$version is using Module::Install::Package version=$VERSION If you are the author of this module, try upgrading Module::Package. Otherwise, please notify the author of this error. ... } # Find and load the author side plugin: sub _load_plugin { my ($self, $spec, $namespace) = @_; $spec ||= ''; $namespace ||= 'Module::Package'; my $version = ''; $Module::Package::plugin_version = 0; if ($spec =~ s/\s+(\S+)\s*//) { $version = $1; $Module::Package::plugin_version = $version; } my ($module, $plugin) = not($spec) ? ('Plugin', "Plugin::basic") : ($spec =~ /^\w(\w|::)*$/) ? ($spec, $spec) : ($spec =~ /^:(\w+)$/) ? ('Plugin', "Plugin::$1") : ($spec =~ /^(\S*\w):(\w+)$/) ? ($1, "$1::$2") : die "$spec is invalid"; $module = "${namespace}::${module}"; $plugin = "${namespace}::${plugin}"; eval "use $module $version (); 1" or die $@; return $plugin->new(); } # Find and load the user side plugin: sub _load_dist_plugin { my ($self, $spec, $namespace) = @_; $spec ||= ''; $namespace ||= 'Module::Package::Dist'; my $r = eval { $self->_load_plugin($spec, $namespace); }; return $r if ref $r; return; } #-----------------------------------------------------------------------------# # These are the user side analogs to the author side plugin API calls. # Prefix with '_' to not pollute Module::Install plugin space. #-----------------------------------------------------------------------------# sub _initial { my ($self) = @_; } sub _main { my ($self) = @_; } # NOTE These must match Module::Package::Plugin::final. sub _final { my ($self) = @_; $self->_all_from; $self->_requires_from; $self->_install_bin; $self->_install_share; $self->_WriteAll; } #-----------------------------------------------------------------------------# # This section is where all the useful code bits go. These bits are needed by # both Author and User side runs. #-----------------------------------------------------------------------------# my $all_from = 0; sub _all_from { my $self = shift; return if $all_from++; return if $self->name; my $file = shift || "$main::PM" or die "all_from has no file"; $self->all_from($file); } my $requires_from = 0; sub _requires_from { my $self = shift; return if $requires_from++; return unless $self->package_options->{requires_from}; my $file = shift || "$main::PM" or die "requires_from has no file"; $self->requires_from($main::PM) } my $install_bin = 0; sub _install_bin { my $self = shift; return if $install_bin++; return unless $self->package_options->{install_bin}; return unless -d 'bin'; my @bin; File::Find::find(sub { return unless -f $_; push @bin, $File::Find::name; }, 'bin'); $self->install_script($_) for @bin; } my $install_share = 0; sub _install_share { my $self = shift; return if $install_share++; return unless $self->package_options->{install_share}; return unless -d 'share'; $self->install_share; } my $WriteAll = 0; sub _WriteAll { my $self = shift; return if $WriteAll++; $self->WriteAll(@_); } # Base package for Module::Package plugin distributed components. package Module::Package::Dist; sub new { my ($class, %args) = @_; bless \%args, $class; } sub mi { @_ > 1 ? ($_[0]->{mi}=$_[1]) : $_[0]->{mi}; } sub _initial { my ($self) = @_; } sub _main { my ($self) = @_; } sub _final { my ($self) = @_; } 1; #-----------------------------------------------------------------------------# # Take a guess at the primary .pm and .pod files for 'all_from', and friends. # Put them in global magical vars in the main:: namespace. #-----------------------------------------------------------------------------# package Module::Package::PM; use overload '""' => sub { $_[0]->guess_pm unless @{$_[0]}; return $_[0]->[0]; }; sub set { $_[0]->[0] = $_[1] } sub guess_pm { my $pm = ''; my $self = shift; if (-e 'META.yml') { open META, 'META.yml' or die "Can't open 'META.yml' for input:\n$!"; my $meta = do { local $/; }; close META; $meta =~ /^module_name: (\S+)$/m or die "Can't get module_name from META.yml"; $pm = $1; $pm =~ s!::!/!g; $pm = "lib/$pm.pm"; } else { require File::Find; my @array = (); File::Find::find(sub { return unless /\.pm$/; my $name = $File::Find::name; my $num = ($name =~ s!/+!/!g); my $ary = $array[$num] ||= []; push @$ary, $name; }, 'lib'); shift @array while @array and not defined $array[0]; die "Can't guess main module" unless @array; (($pm) = sort @{$array[0]}) or die "Can't guess main module"; } my $pmc = $pm . 'c'; $pm = $pmc if -e $pmc; $self->set($pm); } $main::PM = bless [$main::PM ? ($main::PM) : ()], __PACKAGE__; package Module::Package::POD; use overload '""' => sub { return $_[0]->[0] if @{$_[0]}; (my $pod = "$main::PM") =~ s/\.pm/.pod/ or die "Module::Package's \$main::PM value should end in '.pm'"; return -e $pod ? $pod : ''; }; sub set { $_[0][0] = $_[1] } $main::POD = bless [$main::POD ? ($main::POD) : ()], __PACKAGE__; 1; HTML-Microformats-0.105/inc/Module/Install/Win32.pm0000644000076400007640000000340311775403737017734 0ustar taitai#line 1 package Module::Install::Win32; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # determine if the user needs nmake, and download it if needed sub check_nmake { my $self = shift; $self->load('can_run'); $self->load('get_file'); require Config; return unless ( $^O eq 'MSWin32' and $Config::Config{make} and $Config::Config{make} =~ /^nmake\b/i and ! $self->can_run('nmake') ); print "The required 'nmake' executable not found, fetching it...\n"; require File::Basename; my $rv = $self->get_file( url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe', ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe', local_dir => File::Basename::dirname($^X), size => 51928, run => 'Nmake15.exe /o > nul', check_for => 'Nmake.exe', remove => 1, ); die <<'END_MESSAGE' unless $rv; ------------------------------------------------------------------------------- Since you are using Microsoft Windows, you will need the 'nmake' utility before installation. It's available at: http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe or ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe Please download the file manually, save it to a directory in %PATH% (e.g. C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to that directory, and run "Nmake15.exe" from there; that will create the 'nmake.exe' file needed by this module. You may then resume the installation process described in README. ------------------------------------------------------------------------------- END_MESSAGE } 1; HTML-Microformats-0.105/inc/Module/Install/Makefile.pm0000644000076400007640000002743711775403731020556 0ustar taitai#line 1 package Module::Install::Makefile; use strict 'vars'; use ExtUtils::MakeMaker (); use Module::Install::Base (); use Fcntl qw/:flock :seek/; use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub Makefile { $_[0] } my %seen = (); sub prompt { shift; # Infinite loop protection my @c = caller(); if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) { die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])"; } # In automated testing or non-interactive session, always use defaults if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) { local $ENV{PERL_MM_USE_DEFAULT} = 1; goto &ExtUtils::MakeMaker::prompt; } else { goto &ExtUtils::MakeMaker::prompt; } } # Store a cleaned up version of the MakeMaker version, # since we need to behave differently in a variety of # ways based on the MM version. my $makemaker = eval $ExtUtils::MakeMaker::VERSION; # If we are passed a param, do a "newer than" comparison. # Otherwise, just return the MakeMaker version. sub makemaker { ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0 } # Ripped from ExtUtils::MakeMaker 6.56, and slightly modified # as we only need to know here whether the attribute is an array # or a hash or something else (which may or may not be appendable). my %makemaker_argtype = ( C => 'ARRAY', CONFIG => 'ARRAY', # CONFIGURE => 'CODE', # ignore DIR => 'ARRAY', DL_FUNCS => 'HASH', DL_VARS => 'ARRAY', EXCLUDE_EXT => 'ARRAY', EXE_FILES => 'ARRAY', FUNCLIST => 'ARRAY', H => 'ARRAY', IMPORTS => 'HASH', INCLUDE_EXT => 'ARRAY', LIBS => 'ARRAY', # ignore '' MAN1PODS => 'HASH', MAN3PODS => 'HASH', META_ADD => 'HASH', META_MERGE => 'HASH', PL_FILES => 'HASH', PM => 'HASH', PMLIBDIRS => 'ARRAY', PMLIBPARENTDIRS => 'ARRAY', PREREQ_PM => 'HASH', CONFIGURE_REQUIRES => 'HASH', SKIP => 'ARRAY', TYPEMAPS => 'ARRAY', XS => 'HASH', # VERSION => ['version',''], # ignore # _KEEP_AFTER_FLUSH => '', clean => 'HASH', depend => 'HASH', dist => 'HASH', dynamic_lib=> 'HASH', linkext => 'HASH', macro => 'HASH', postamble => 'HASH', realclean => 'HASH', test => 'HASH', tool_autosplit => 'HASH', # special cases where you can use makemaker_append CCFLAGS => 'APPENDABLE', DEFINE => 'APPENDABLE', INC => 'APPENDABLE', LDDLFLAGS => 'APPENDABLE', LDFROM => 'APPENDABLE', ); sub makemaker_args { my ($self, %new_args) = @_; my $args = ( $self->{makemaker_args} ||= {} ); foreach my $key (keys %new_args) { if ($makemaker_argtype{$key}) { if ($makemaker_argtype{$key} eq 'ARRAY') { $args->{$key} = [] unless defined $args->{$key}; unless (ref $args->{$key} eq 'ARRAY') { $args->{$key} = [$args->{$key}] } push @{$args->{$key}}, ref $new_args{$key} eq 'ARRAY' ? @{$new_args{$key}} : $new_args{$key}; } elsif ($makemaker_argtype{$key} eq 'HASH') { $args->{$key} = {} unless defined $args->{$key}; foreach my $skey (keys %{ $new_args{$key} }) { $args->{$key}{$skey} = $new_args{$key}{$skey}; } } elsif ($makemaker_argtype{$key} eq 'APPENDABLE') { $self->makemaker_append($key => $new_args{$key}); } } else { if (defined $args->{$key}) { warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n}; } $args->{$key} = $new_args{$key}; } } return $args; } # For mm args that take multiple space-seperated args, # append an argument to the current list. sub makemaker_append { my $self = shift; my $name = shift; my $args = $self->makemaker_args; $args->{$name} = defined $args->{$name} ? join( ' ', $args->{$name}, @_ ) : join( ' ', @_ ); } sub build_subdirs { my $self = shift; my $subdirs = $self->makemaker_args->{DIR} ||= []; for my $subdir (@_) { push @$subdirs, $subdir; } } sub clean_files { my $self = shift; my $clean = $self->makemaker_args->{clean} ||= {}; %$clean = ( %$clean, FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_), ); } sub realclean_files { my $self = shift; my $realclean = $self->makemaker_args->{realclean} ||= {}; %$realclean = ( %$realclean, FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_), ); } sub libs { my $self = shift; my $libs = ref $_[0] ? shift : [ shift ]; $self->makemaker_args( LIBS => $libs ); } sub inc { my $self = shift; $self->makemaker_args( INC => shift ); } sub _wanted_t { } sub tests_recursive { my $self = shift; my $dir = shift || 't'; unless ( -d $dir ) { die "tests_recursive dir '$dir' does not exist"; } my %tests = map { $_ => 1 } split / /, ($self->tests || ''); require File::Find; File::Find::find( sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 }, $dir ); $self->tests( join ' ', sort keys %tests ); } sub write { my $self = shift; die "&Makefile->write() takes no arguments\n" if @_; # Check the current Perl version my $perl_version = $self->perl_version; if ( $perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; } # Make sure we have a new enough MakeMaker require ExtUtils::MakeMaker; if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) { # This previous attempted to inherit the version of # ExtUtils::MakeMaker in use by the module author, but this # was found to be untenable as some authors build releases # using future dev versions of EU:MM that nobody else has. # Instead, #toolchain suggests we use 6.59 which is the most # stable version on CPAN at time of writing and is, to quote # ribasushi, "not terminally fucked, > and tested enough". # TODO: We will now need to maintain this over time to push # the version up as new versions are released. $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 ); } else { # Allow legacy-compatibility with 5.005 by depending on the # most recent EU:MM that supported 5.005. $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 ); $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 ); } # Generate the MakeMaker params my $args = $self->makemaker_args; $args->{DISTNAME} = $self->name; $args->{NAME} = $self->module_name || $self->name; $args->{NAME} =~ s/-/::/g; $args->{VERSION} = $self->version or die <<'EOT'; ERROR: Can't determine distribution version. Please specify it explicitly via 'version' in Makefile.PL, or set a valid $VERSION in a module, and provide its file path via 'version_from' (or 'all_from' if you prefer) in Makefile.PL. EOT if ( $self->tests ) { my @tests = split ' ', $self->tests; my %seen; $args->{test} = { TESTS => (join ' ', grep {!$seen{$_}++} @tests), }; } elsif ( $Module::Install::ExtraTests::use_extratests ) { # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness. # So, just ignore our xt tests here. } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) { $args->{test} = { TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ), }; } if ( $] >= 5.005 ) { $args->{ABSTRACT} = $self->abstract; $args->{AUTHOR} = join ', ', @{$self->author || []}; } if ( $self->makemaker(6.10) ) { $args->{NO_META} = 1; #$args->{NO_MYMETA} = 1; } if ( $self->makemaker(6.17) and $self->sign ) { $args->{SIGN} = 1; } unless ( $self->is_admin ) { delete $args->{SIGN}; } if ( $self->makemaker(6.31) and $self->license ) { $args->{LICENSE} = $self->license; } my $prereq = ($args->{PREREQ_PM} ||= {}); %$prereq = ( %$prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->requires) ); # Remove any reference to perl, PREREQ_PM doesn't support it delete $args->{PREREQ_PM}->{perl}; # Merge both kinds of requires into BUILD_REQUIRES my $build_prereq = ($args->{BUILD_REQUIRES} ||= {}); %$build_prereq = ( %$build_prereq, map { @$_ } # flatten [module => version] map { @$_ } grep $_, ($self->configure_requires, $self->build_requires) ); # Remove any reference to perl, BUILD_REQUIRES doesn't support it delete $args->{BUILD_REQUIRES}->{perl}; # Delete bundled dists from prereq_pm, add it to Makefile DIR my $subdirs = ($args->{DIR} || []); if ($self->bundles) { my %processed; foreach my $bundle (@{ $self->bundles }) { my ($mod_name, $dist_dir) = @$bundle; delete $prereq->{$mod_name}; $dist_dir = File::Basename::basename($dist_dir); # dir for building this module if (not exists $processed{$dist_dir}) { if (-d $dist_dir) { # List as sub-directory to be processed by make push @$subdirs, $dist_dir; } # Else do nothing: the module is already present on the system $processed{$dist_dir} = undef; } } } unless ( $self->makemaker('6.55_03') ) { %$prereq = (%$prereq,%$build_prereq); delete $args->{BUILD_REQUIRES}; } if ( my $perl_version = $self->perl_version ) { eval "use $perl_version; 1" or die "ERROR: perl: Version $] is installed, " . "but we need version >= $perl_version"; if ( $self->makemaker(6.48) ) { $args->{MIN_PERL_VERSION} = $perl_version; } } if ($self->installdirs) { warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS}; $args->{INSTALLDIRS} = $self->installdirs; } my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_} ) } keys %$args; my $user_preop = delete $args{dist}->{PREOP}; if ( my $preop = $self->admin->preop($user_preop) ) { foreach my $key ( keys %$preop ) { $args{dist}->{$key} = $preop->{$key}; } } my $mm = ExtUtils::MakeMaker::WriteMakefile(%args); $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile'); } sub fix_up_makefile { my $self = shift; my $makefile_name = shift; my $top_class = ref($self->_top) || ''; my $top_version = $self->_top->VERSION || ''; my $preamble = $self->preamble ? "# Preamble by $top_class $top_version\n" . $self->preamble : ''; my $postamble = "# Postamble by $top_class $top_version\n" . ($self->postamble || ''); local *MAKEFILE; open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!"; eval { flock MAKEFILE, LOCK_EX }; my $makefile = do { local $/; }; $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /; $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g; $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g; $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m; $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m; # Module::Install will never be used to build the Core Perl # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m; #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m; # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well. $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g; # XXX - This is currently unused; not sure if it breaks other MM-users # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg; seek MAKEFILE, 0, SEEK_SET; truncate MAKEFILE, 0; print MAKEFILE "$preamble$makefile$postamble" or die $!; close MAKEFILE or die $!; 1; } sub preamble { my ($self, $text) = @_; $self->{preamble} = $text . $self->{preamble} if defined $text; $self->{preamble}; } sub postamble { my ($self, $text) = @_; $self->{postamble} ||= $self->admin->postamble; $self->{postamble} .= $text if defined $text; $self->{postamble} } 1; __END__ #line 544 HTML-Microformats-0.105/inc/Module/Install/Can.pm0000644000076400007640000000615711775403737017544 0ustar taitai#line 1 package Module::Install::Can; use strict; use Config (); use ExtUtils::MakeMaker (); use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } # check if we can load some module ### Upgrade this to not have to load the module if possible sub can_use { my ($self, $mod, $ver) = @_; $mod =~ s{::|\\}{/}g; $mod .= '.pm' unless $mod =~ /\.pm$/i; my $pkg = $mod; $pkg =~ s{/}{::}g; $pkg =~ s{\.pm$}{}i; local $@; eval { require $mod; $pkg->VERSION($ver || 0); 1 }; } # Check if we can run some command sub can_run { my ($self, $cmd) = @_; my $_cmd = $cmd; return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd)); for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') { next if $dir eq ''; require File::Spec; my $abs = File::Spec->catfile($dir, $cmd); return $abs if (-x $abs or $abs = MM->maybe_command($abs)); } return; } # Can our C compiler environment build XS files sub can_xs { my $self = shift; # Ensure we have the CBuilder module $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 ); # Do we have the configure_requires checker? local $@; eval "require ExtUtils::CBuilder;"; if ( $@ ) { # They don't obey configure_requires, so it is # someone old and delicate. Try to avoid hurting # them by falling back to an older simpler test. return $self->can_cc(); } # Do we have a working C compiler my $builder = ExtUtils::CBuilder->new( quiet => 1, ); unless ( $builder->have_compiler ) { # No working C compiler return 0; } # Write a C file representative of what XS becomes require File::Temp; my ( $FH, $tmpfile ) = File::Temp::tempfile( "compilexs-XXXXX", SUFFIX => '.c', ); binmode $FH; print $FH <<'END_C'; #include "EXTERN.h" #include "perl.h" #include "XSUB.h" int main(int argc, char **argv) { return 0; } int boot_sanexs() { return 1; } END_C close $FH; # Can the C compiler access the same headers XS does my @libs = (); my $object = undef; eval { local $^W = 0; $object = $builder->compile( source => $tmpfile, ); @libs = $builder->link( objects => $object, module_name => 'sanexs', ); }; my $result = $@ ? 0 : 1; # Clean up all the build files foreach ( $tmpfile, $object, @libs ) { next unless defined $_; 1 while unlink; } return $result; } # Can we locate a (the) C compiler sub can_cc { my $self = shift; my @chunks = split(/ /, $Config::Config{cc}) or return; # $Config{cc} may contain args; try to find out the program part while (@chunks) { return $self->can_run("@chunks") || (pop(@chunks), next); } return; } # Fix Cygwin bug on maybe_command(); if ( $^O eq 'cygwin' ) { require ExtUtils::MM_Cygwin; require ExtUtils::MM_Win32; if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) { *ExtUtils::MM_Cygwin::maybe_command = sub { my ($self, $file) = @_; if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) { ExtUtils::MM_Win32->maybe_command($file); } else { ExtUtils::MM_Unix->maybe_command($file); } } } } 1; __END__ #line 236 HTML-Microformats-0.105/inc/Module/Install/Base.pm0000644000076400007640000000214711775403723017703 0ustar taitai#line 1 package Module::Install::Base; use strict 'vars'; use vars qw{$VERSION}; BEGIN { $VERSION = '1.06'; } # Suspend handler for "redefined" warnings BEGIN { my $w = $SIG{__WARN__}; $SIG{__WARN__} = sub { $w }; } #line 42 sub new { my $class = shift; unless ( defined &{"${class}::call"} ) { *{"${class}::call"} = sub { shift->_top->call(@_) }; } unless ( defined &{"${class}::load"} ) { *{"${class}::load"} = sub { shift->_top->load(@_) }; } bless { @_ }, $class; } #line 61 sub AUTOLOAD { local $@; my $func = eval { shift->_top->autoload } or return; goto &$func; } #line 75 sub _top { $_[0]->{_top}; } #line 90 sub admin { $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new; } #line 106 sub is_admin { ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin'); } sub DESTROY {} package Module::Install::Base::FakeAdmin; use vars qw{$VERSION}; BEGIN { $VERSION = $Module::Install::Base::VERSION; } my $fake; sub new { $fake ||= bless(\@_, $_[0]); } sub AUTOLOAD {} sub DESTROY {} # Restore warning handler BEGIN { $SIG{__WARN__} = $SIG{__WARN__}->(); } 1; #line 159 HTML-Microformats-0.105/inc/Module/Install/WriteAll.pm0000644000076400007640000000237611775403737020565 0ustar taitai#line 1 package Module::Install::WriteAll; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = qw{Module::Install::Base}; $ISCORE = 1; } sub WriteAll { my $self = shift; my %args = ( meta => 1, sign => 0, inline => 0, check_nmake => 1, @_, ); $self->sign(1) if $args{sign}; $self->admin->WriteAll(%args) if $self->is_admin; $self->check_nmake if $args{check_nmake}; unless ( $self->makemaker_args->{PL_FILES} ) { # XXX: This still may be a bit over-defensive... unless ($self->makemaker(6.25)) { $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL'; } } # Until ExtUtils::MakeMaker support MYMETA.yml, make sure # we clean it up properly ourself. $self->realclean_files('MYMETA.yml'); if ( $args{inline} ) { $self->Inline->write; } else { $self->Makefile->write; } # The Makefile write process adds a couple of dependencies, # so write the META.yml files after the Makefile. if ( $args{meta} ) { $self->Meta->write; } # Experimental support for MYMETA if ( $ENV{X_MYMETA} ) { if ( $ENV{X_MYMETA} eq 'JSON' ) { $self->Meta->write_mymeta_json; } else { $self->Meta->write_mymeta_yaml; } } return 1; } 1; HTML-Microformats-0.105/inc/Module/Install/Include.pm0000644000076400007640000000101511775403724020406 0ustar taitai#line 1 package Module::Install::Include; use strict; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } sub include { shift()->admin->include(@_); } sub include_deps { shift()->admin->include_deps(@_); } sub auto_include { shift()->admin->auto_include(@_); } sub auto_include_deps { shift()->admin->auto_include_deps(@_); } sub auto_include_dependent_dists { shift()->admin->auto_include_dependent_dists(@_); } 1; HTML-Microformats-0.105/inc/Module/Install/Metadata.pm0000644000076400007640000004327711775403724020563 0ustar taitai#line 1 package Module::Install::Metadata; use strict 'vars'; use Module::Install::Base (); use vars qw{$VERSION @ISA $ISCORE}; BEGIN { $VERSION = '1.06'; @ISA = 'Module::Install::Base'; $ISCORE = 1; } my @boolean_keys = qw{ sign }; my @scalar_keys = qw{ name module_name abstract version distribution_type tests installdirs }; my @tuple_keys = qw{ configure_requires build_requires requires recommends bundles resources }; my @resource_keys = qw{ homepage bugtracker repository }; my @array_keys = qw{ keywords author }; *authors = \&author; sub Meta { shift } sub Meta_BooleanKeys { @boolean_keys } sub Meta_ScalarKeys { @scalar_keys } sub Meta_TupleKeys { @tuple_keys } sub Meta_ResourceKeys { @resource_keys } sub Meta_ArrayKeys { @array_keys } foreach my $key ( @boolean_keys ) { *$key = sub { my $self = shift; if ( defined wantarray and not @_ ) { return $self->{values}->{$key}; } $self->{values}->{$key} = ( @_ ? $_[0] : 1 ); return $self; }; } foreach my $key ( @scalar_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} = shift; return $self; }; } foreach my $key ( @array_keys ) { *$key = sub { my $self = shift; return $self->{values}->{$key} if defined wantarray and !@_; $self->{values}->{$key} ||= []; push @{$self->{values}->{$key}}, @_; return $self; }; } foreach my $key ( @resource_keys ) { *$key = sub { my $self = shift; unless ( @_ ) { return () unless $self->{values}->{resources}; return map { $_->[1] } grep { $_->[0] eq $key } @{ $self->{values}->{resources} }; } return $self->{values}->{resources}->{$key} unless @_; my $uri = shift or die( "Did not provide a value to $key()" ); $self->resources( $key => $uri ); return 1; }; } foreach my $key ( grep { $_ ne "resources" } @tuple_keys) { *$key = sub { my $self = shift; return $self->{values}->{$key} unless @_; my @added; while ( @_ ) { my $module = shift or last; my $version = shift || 0; push @added, [ $module, $version ]; } push @{ $self->{values}->{$key} }, @added; return map {@$_} @added; }; } # Resource handling my %lc_resource = map { $_ => 1 } qw{ homepage license bugtracker repository }; sub resources { my $self = shift; while ( @_ ) { my $name = shift or last; my $value = shift or next; if ( $name eq lc $name and ! $lc_resource{$name} ) { die("Unsupported reserved lowercase resource '$name'"); } $self->{values}->{resources} ||= []; push @{ $self->{values}->{resources} }, [ $name, $value ]; } $self->{values}->{resources}; } # Aliases for build_requires that will have alternative # meanings in some future version of META.yml. sub test_requires { shift->build_requires(@_) } sub install_requires { shift->build_requires(@_) } # Aliases for installdirs options sub install_as_core { $_[0]->installdirs('perl') } sub install_as_cpan { $_[0]->installdirs('site') } sub install_as_site { $_[0]->installdirs('site') } sub install_as_vendor { $_[0]->installdirs('vendor') } sub dynamic_config { my $self = shift; my $value = @_ ? shift : 1; if ( $self->{values}->{dynamic_config} ) { # Once dynamic we never change to static, for safety return 0; } $self->{values}->{dynamic_config} = $value ? 1 : 0; return 1; } # Convenience command sub static_config { shift->dynamic_config(0); } sub perl_version { my $self = shift; return $self->{values}->{perl_version} unless @_; my $version = shift or die( "Did not provide a value to perl_version()" ); # Normalize the version $version = $self->_perl_version($version); # We don't support the really old versions unless ( $version >= 5.005 ) { die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n"; } $self->{values}->{perl_version} = $version; } sub all_from { my ( $self, $file ) = @_; unless ( defined($file) ) { my $name = $self->name or die( "all_from called with no args without setting name() first" ); $file = join('/', 'lib', split(/-/, $name)) . '.pm'; $file =~ s{.*/}{} unless -e $file; unless ( -e $file ) { die("all_from cannot find $file from $name"); } } unless ( -f $file ) { die("The path '$file' does not exist, or is not a file"); } $self->{values}{all_from} = $file; # Some methods pull from POD instead of code. # If there is a matching .pod, use that instead my $pod = $file; $pod =~ s/\.pm$/.pod/i; $pod = $file unless -e $pod; # Pull the different values $self->name_from($file) unless $self->name; $self->version_from($file) unless $self->version; $self->perl_version_from($file) unless $self->perl_version; $self->author_from($pod) unless @{$self->author || []}; $self->license_from($pod) unless $self->license; $self->abstract_from($pod) unless $self->abstract; return 1; } sub provides { my $self = shift; my $provides = ( $self->{values}->{provides} ||= {} ); %$provides = (%$provides, @_) if @_; return $provides; } sub auto_provides { my $self = shift; return $self unless $self->is_admin; unless (-e 'MANIFEST') { warn "Cannot deduce auto_provides without a MANIFEST, skipping\n"; return $self; } # Avoid spurious warnings as we are not checking manifest here. local $SIG{__WARN__} = sub {1}; require ExtUtils::Manifest; local *ExtUtils::Manifest::manicheck = sub { return }; require Module::Build; my $build = Module::Build->new( dist_name => $self->name, dist_version => $self->version, license => $self->license, ); $self->provides( %{ $build->find_dist_packages || {} } ); } sub feature { my $self = shift; my $name = shift; my $features = ( $self->{values}->{features} ||= [] ); my $mods; if ( @_ == 1 and ref( $_[0] ) ) { # The user used ->feature like ->features by passing in the second # argument as a reference. Accomodate for that. $mods = $_[0]; } else { $mods = \@_; } my $count = 0; push @$features, ( $name => [ map { ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_ } @$mods ] ); return @$features; } sub features { my $self = shift; while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) { $self->feature( $name, @$mods ); } return $self->{values}->{features} ? @{ $self->{values}->{features} } : (); } sub no_index { my $self = shift; my $type = shift; push @{ $self->{values}->{no_index}->{$type} }, @_ if $type; return $self->{values}->{no_index}; } sub read { my $self = shift; $self->include_deps( 'YAML::Tiny', 0 ); require YAML::Tiny; my $data = YAML::Tiny::LoadFile('META.yml'); # Call methods explicitly in case user has already set some values. while ( my ( $key, $value ) = each %$data ) { next unless $self->can($key); if ( ref $value eq 'HASH' ) { while ( my ( $module, $version ) = each %$value ) { $self->can($key)->($self, $module => $version ); } } else { $self->can($key)->($self, $value); } } return $self; } sub write { my $self = shift; return $self unless $self->is_admin; $self->admin->write_meta; return $self; } sub version_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->version( ExtUtils::MM_Unix->parse_version($file) ); # for version integrity check $self->makemaker_args( VERSION_FROM => $file ); } sub abstract_from { require ExtUtils::MM_Unix; my ( $self, $file ) = @_; $self->abstract( bless( { DISTNAME => $self->name }, 'ExtUtils::MM_Unix' )->parse_abstract($file) ); } # Add both distribution and module name sub name_from { my ($self, $file) = @_; if ( Module::Install::_read($file) =~ m/ ^ \s* package \s* ([\w:]+) \s* ; /ixms ) { my ($name, $module_name) = ($1, $1); $name =~ s{::}{-}g; $self->name($name); unless ( $self->module_name ) { $self->module_name($module_name); } } else { die("Cannot determine name from $file\n"); } } sub _extract_perl_version { if ( $_[0] =~ m/ ^\s* (?:use|require) \s* v? ([\d_\.]+) \s* ; /ixms ) { my $perl_version = $1; $perl_version =~ s{_}{}g; return $perl_version; } else { return; } } sub perl_version_from { my $self = shift; my $perl_version=_extract_perl_version(Module::Install::_read($_[0])); if ($perl_version) { $self->perl_version($perl_version); } else { warn "Cannot determine perl version info from $_[0]\n"; return; } } sub author_from { my $self = shift; my $content = Module::Install::_read($_[0]); if ($content =~ m/ =head \d \s+ (?:authors?)\b \s* ([^\n]*) | =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s* .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s* ([^\n]*) /ixms) { my $author = $1 || $2; # XXX: ugly but should work anyway... if (eval "require Pod::Escapes; 1") { # Pod::Escapes has a mapping table. # It's in core of perl >= 5.9.3, and should be installed # as one of the Pod::Simple's prereqs, which is a prereq # of Pod::Text 3.x (see also below). $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $Pod::Escapes::Name2character_number{$1} ? chr($Pod::Escapes::Name2character_number{$1}) : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) { # Pod::Text < 3.0 has yet another mapping table, # though the table name of 2.x and 1.x are different. # (1.x is in core of Perl < 5.6, 2.x is in core of # Perl < 5.9.3) my $mapping = ($Pod::Text::VERSION < 2) ? \%Pod::Text::HTML_Escapes : \%Pod::Text::ESCAPES; $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> } { defined $2 ? chr($2) : defined $mapping->{$1} ? $mapping->{$1} : do { warn "Unknown escape: E<$1>"; "E<$1>"; }; }gex; } else { $author =~ s{E}{<}g; $author =~ s{E}{>}g; } $self->author($author); } else { warn "Cannot determine author info from $_[0]\n"; } } #Stolen from M::B my %license_urls = ( perl => 'http://dev.perl.org/licenses/', apache => 'http://apache.org/licenses/LICENSE-2.0', apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1', artistic => 'http://opensource.org/licenses/artistic-license.php', artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php', lgpl => 'http://opensource.org/licenses/lgpl-license.php', lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php', lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html', bsd => 'http://opensource.org/licenses/bsd-license.php', gpl => 'http://opensource.org/licenses/gpl-license.php', gpl2 => 'http://opensource.org/licenses/gpl-2.0.php', gpl3 => 'http://opensource.org/licenses/gpl-3.0.html', mit => 'http://opensource.org/licenses/mit-license.php', mozilla => 'http://opensource.org/licenses/mozilla1.1.php', open_source => undef, unrestricted => undef, restrictive => undef, unknown => undef, ); sub license { my $self = shift; return $self->{values}->{license} unless @_; my $license = shift or die( 'Did not provide a value to license()' ); $license = __extract_license($license) || lc $license; $self->{values}->{license} = $license; # Automatically fill in license URLs if ( $license_urls{$license} ) { $self->resources( license => $license_urls{$license} ); } return 1; } sub _extract_license { my $pod = shift; my $matched; return __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?) (=head \d.*|=cut.*|)\z /xms ) || __extract_license( ($matched) = $pod =~ m/ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?) (=head \d.*|=cut.*|)\z /xms ); } sub __extract_license { my $license_text = shift or return; my @phrases = ( '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1, '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1, 'Artistic and GPL' => 'perl', 1, 'GNU general public license' => 'gpl', 1, 'GNU public license' => 'gpl', 1, 'GNU lesser general public license' => 'lgpl', 1, 'GNU lesser public license' => 'lgpl', 1, 'GNU library general public license' => 'lgpl', 1, 'GNU library public license' => 'lgpl', 1, 'GNU Free Documentation license' => 'unrestricted', 1, 'GNU Affero General Public License' => 'open_source', 1, '(?:Free)?BSD license' => 'bsd', 1, 'Artistic license 2\.0' => 'artistic_2', 1, 'Artistic license' => 'artistic', 1, 'Apache (?:Software )?license' => 'apache', 1, 'GPL' => 'gpl', 1, 'LGPL' => 'lgpl', 1, 'BSD' => 'bsd', 1, 'Artistic' => 'artistic', 1, 'MIT' => 'mit', 1, 'Mozilla Public License' => 'mozilla', 1, 'Q Public License' => 'open_source', 1, 'OpenSSL License' => 'unrestricted', 1, 'SSLeay License' => 'unrestricted', 1, 'zlib License' => 'open_source', 1, 'proprietary' => 'proprietary', 0, ); while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) { $pattern =~ s#\s+#\\s+#gs; if ( $license_text =~ /\b$pattern\b/i ) { return $license; } } return ''; } sub license_from { my $self = shift; if (my $license=_extract_license(Module::Install::_read($_[0]))) { $self->license($license); } else { warn "Cannot determine license info from $_[0]\n"; return 'unknown'; } } sub _extract_bugtracker { my @links = $_[0] =~ m#L<( https?\Q://rt.cpan.org/\E[^>]+| https?\Q://github.com/\E[\w_]+/[\w_]+/issues| https?\Q://code.google.com/p/\E[\w_\-]+/issues/list )>#gx; my %links; @links{@links}=(); @links=keys %links; return @links; } sub bugtracker_from { my $self = shift; my $content = Module::Install::_read($_[0]); my @links = _extract_bugtracker($content); unless ( @links ) { warn "Cannot determine bugtracker info from $_[0]\n"; return 0; } if ( @links > 1 ) { warn "Found more than one bugtracker link in $_[0]\n"; return 0; } # Set the bugtracker bugtracker( $links[0] ); return 1; } sub requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->requires( $module => $version ); } } sub test_requires_from { my $self = shift; my $content = Module::Install::_readperl($_[0]); my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg; while ( @requires ) { my $module = shift @requires; my $version = shift @requires; $self->test_requires( $module => $version ); } } # Convert triple-part versions (eg, 5.6.1 or 5.8.9) to # numbers (eg, 5.006001 or 5.008009). # Also, convert double-part versions (eg, 5.8) sub _perl_version { my $v = $_[-1]; $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e; $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e; $v =~ s/(\.\d\d\d)000$/$1/; $v =~ s/_.+$//; if ( ref($v) ) { # Numify $v = $v + 0; } return $v; } sub add_metadata { my $self = shift; my %hash = @_; for my $key (keys %hash) { warn "add_metadata: $key is not prefixed with 'x_'.\n" . "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/; $self->{values}->{$key} = $hash{$key}; } } ###################################################################### # MYMETA Support sub WriteMyMeta { die "WriteMyMeta has been deprecated"; } sub write_mymeta_yaml { my $self = shift; # We need YAML::Tiny to write the MYMETA.yml file unless ( eval { require YAML::Tiny; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.yml\n"; YAML::Tiny::DumpFile('MYMETA.yml', $meta); } sub write_mymeta_json { my $self = shift; # We need JSON to write the MYMETA.json file unless ( eval { require JSON; 1; } ) { return 1; } # Generate the data my $meta = $self->_write_mymeta_data or return 1; # Save as the MYMETA.yml file print "Writing MYMETA.json\n"; Module::Install::_write( 'MYMETA.json', JSON->new->pretty(1)->canonical->encode($meta), ); } sub _write_mymeta_data { my $self = shift; # If there's no existing META.yml there is nothing we can do return undef unless -f 'META.yml'; # We need Parse::CPAN::Meta to load the file unless ( eval { require Parse::CPAN::Meta; 1; } ) { return undef; } # Merge the perl version into the dependencies my $val = $self->Meta->{values}; my $perl = delete $val->{perl_version}; if ( $perl ) { $val->{requires} ||= []; my $requires = $val->{requires}; # Canonize to three-dot version after Perl 5.6 if ( $perl >= 5.006 ) { $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e } unshift @$requires, [ perl => $perl ]; } # Load the advisory META.yml file my @yaml = Parse::CPAN::Meta::LoadFile('META.yml'); my $meta = $yaml[0]; # Overwrite the non-configure dependency hashs delete $meta->{requires}; delete $meta->{build_requires}; delete $meta->{recommends}; if ( exists $val->{requires} ) { $meta->{requires} = { map { @$_ } @{ $val->{requires} } }; } if ( exists $val->{build_requires} ) { $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } }; } return $meta; } 1; HTML-Microformats-0.105/inc/Module/Install/AutoManifest.pm0000644000076400007640000000125711775403736021435 0ustar taitai#line 1 use strict; use warnings; package Module::Install::AutoManifest; use Module::Install::Base; BEGIN { our $VERSION = '0.003'; our $ISCORE = 1; our @ISA = qw(Module::Install::Base); } sub auto_manifest { my ($self) = @_; return unless $Module::Install::AUTHOR; die "auto_manifest requested, but no MANIFEST.SKIP exists\n" unless -e "MANIFEST.SKIP"; if (-e "MANIFEST") { unlink('MANIFEST') or die "Can't remove MANIFEST: $!"; } $self->postamble(<<"END"); create_distdir: manifest_clean manifest distclean :: manifest_clean manifest_clean: \t\$(RM_F) MANIFEST END } 1; __END__ #line 48 #line 131 1; # End of Module::Install::AutoManifest HTML-Microformats-0.105/inc/Module/Install/TrustMetaYml.pm0000644000076400007640000000162211775403724021441 0ustar taitai#line 1 package Module::Install::TrustMetaYml; use 5.005; use strict; BEGIN { $Module::Install::TrustMetaYml::AUTHORITY = 'cpan:TOBYINK'; $Module::Install::TrustMetaYml::VERSION = '0.002'; } use base qw(Module::Install::Base); sub trust_meta_yml { my ($self, $where) = @_; $where ||= 'META.yml'; $self->perl_version('5.005') unless defined $self->perl_version; $self->include_deps('YAML::Tiny', 0); return $self if $self->is_admin; require YAML::Tiny; my $data = YAML::Tiny::LoadFile($where); $self->perl_version($data->{requires}{perl} || '5.005'); KEY: foreach my $key (qw(requires recommends build_requires)) { next KEY unless ref $data->{$key} eq 'HASH'; my %deps = %{$data->{$key}}; DEP: while (my ($pkg, $ver) = each %deps) { next if $pkg eq 'perl'; $self->$key($pkg, $ver); } } return $self; } *trust_meta_yaml = \&trust_meta_yml; 1; __END__ =encoding utf8 HTML-Microformats-0.105/inc/Module/Install.pm0000644000076400007640000003013511775403716017031 0ustar taitai#line 1 package Module::Install; # For any maintainers: # The load order for Module::Install is a bit magic. # It goes something like this... # # IF ( host has Module::Install installed, creating author mode ) { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install # 3. The installed version of inc::Module::Install loads # 4. inc::Module::Install calls "require Module::Install" # 5. The ./inc/ version of Module::Install loads # } ELSE { # 1. Makefile.PL calls "use inc::Module::Install" # 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install # 3. The ./inc/ version of Module::Install loads # } use 5.005; use strict 'vars'; use Cwd (); use File::Find (); use File::Path (); use vars qw{$VERSION $MAIN}; BEGIN { # All Module::Install core packages now require synchronised versions. # This will be used to ensure we don't accidentally load old or # different versions of modules. # This is not enforced yet, but will be some time in the next few # releases once we can make sure it won't clash with custom # Module::Install extensions. $VERSION = '1.06'; # Storage for the pseudo-singleton $MAIN = undef; *inc::Module::Install::VERSION = *VERSION; @inc::Module::Install::ISA = __PACKAGE__; } sub import { my $class = shift; my $self = $class->new(@_); my $who = $self->_caller; #------------------------------------------------------------- # all of the following checks should be included in import(), # to allow "eval 'require Module::Install; 1' to test # installation of Module::Install. (RT #51267) #------------------------------------------------------------- # Whether or not inc::Module::Install is actually loaded, the # $INC{inc/Module/Install.pm} is what will still get set as long as # the caller loaded module this in the documented manner. # If not set, the caller may NOT have loaded the bundled version, and thus # they may not have a MI version that works with the Makefile.PL. This would # result in false errors or unexpected behaviour. And we don't want that. my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm'; unless ( $INC{$file} ) { die <<"END_DIE" } Please invoke ${\__PACKAGE__} with: use inc::${\__PACKAGE__}; not: use ${\__PACKAGE__}; END_DIE # This reportedly fixes a rare Win32 UTC file time issue, but # as this is a non-cross-platform XS module not in the core, # we shouldn't really depend on it. See RT #24194 for detail. # (Also, this module only supports Perl 5.6 and above). eval "use Win32::UTCFileTime" if $^O eq 'MSWin32' && $] >= 5.006; # If the script that is loading Module::Install is from the future, # then make will detect this and cause it to re-run over and over # again. This is bad. Rather than taking action to touch it (which # is unreliable on some platforms and requires write permissions) # for now we should catch this and refuse to run. if ( -f $0 ) { my $s = (stat($0))[9]; # If the modification time is only slightly in the future, # sleep briefly to remove the problem. my $a = $s - time; if ( $a > 0 and $a < 5 ) { sleep 5 } # Too far in the future, throw an error. my $t = time; if ( $s > $t ) { die <<"END_DIE" } Your installer $0 has a modification time in the future ($s > $t). This is known to create infinite loops in make. Please correct this, then run $0 again. END_DIE } # Build.PL was formerly supported, but no longer is due to excessive # difficulty in implementing every single feature twice. if ( $0 =~ /Build.PL$/i ) { die <<"END_DIE" } Module::Install no longer supports Build.PL. It was impossible to maintain duel backends, and has been deprecated. Please remove all Build.PL files and only use the Makefile.PL installer. END_DIE #------------------------------------------------------------- # To save some more typing in Module::Install installers, every... # use inc::Module::Install # ...also acts as an implicit use strict. $^H |= strict::bits(qw(refs subs vars)); #------------------------------------------------------------- unless ( -f $self->{file} ) { foreach my $key (keys %INC) { delete $INC{$key} if $key =~ /Module\/Install/; } local $^W; require "$self->{path}/$self->{dispatch}.pm"; File::Path::mkpath("$self->{prefix}/$self->{author}"); $self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self ); $self->{admin}->init; @_ = ($class, _self => $self); goto &{"$self->{name}::import"}; } local $^W; *{"${who}::AUTOLOAD"} = $self->autoload; $self->preload; # Unregister loader and worker packages so subdirs can use them again delete $INC{'inc/Module/Install.pm'}; delete $INC{'Module/Install.pm'}; # Save to the singleton $MAIN = $self; return 1; } sub autoload { my $self = shift; my $who = $self->_caller; my $cwd = Cwd::cwd(); my $sym = "${who}::AUTOLOAD"; $sym->{$cwd} = sub { my $pwd = Cwd::cwd(); if ( my $code = $sym->{$pwd} ) { # Delegate back to parent dirs goto &$code unless $cwd eq $pwd; } unless ($$sym =~ s/([^:]+)$//) { # XXX: it looks like we can't retrieve the missing function # via $$sym (usually $main::AUTOLOAD) in this case. # I'm still wondering if we should slurp Makefile.PL to # get some context or not ... my ($package, $file, $line) = caller; die <<"EOT"; Unknown function is found at $file line $line. Execution of $file aborted due to runtime errors. If you're a contributor to a project, you may need to install some Module::Install extensions from CPAN (or other repository). If you're a user of a module, please contact the author. EOT } my $method = $1; if ( uc($method) eq $method ) { # Do nothing return; } elsif ( $method =~ /^_/ and $self->can($method) ) { # Dispatch to the root M:I class return $self->$method(@_); } # Dispatch to the appropriate plugin unshift @_, ( $self, $1 ); goto &{$self->can('call')}; }; } sub preload { my $self = shift; unless ( $self->{extensions} ) { $self->load_extensions( "$self->{prefix}/$self->{path}", $self ); } my @exts = @{$self->{extensions}}; unless ( @exts ) { @exts = $self->{admin}->load_all_extensions; } my %seen; foreach my $obj ( @exts ) { while (my ($method, $glob) = each %{ref($obj) . '::'}) { next unless $obj->can($method); next if $method =~ /^_/; next if $method eq uc($method); $seen{$method}++; } } my $who = $self->_caller; foreach my $name ( sort keys %seen ) { local $^W; *{"${who}::$name"} = sub { ${"${who}::AUTOLOAD"} = "${who}::$name"; goto &{"${who}::AUTOLOAD"}; }; } } sub new { my ($class, %args) = @_; delete $INC{'FindBin.pm'}; { # to suppress the redefine warning local $SIG{__WARN__} = sub {}; require FindBin; } # ignore the prefix on extension modules built from top level. my $base_path = Cwd::abs_path($FindBin::Bin); unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) { delete $args{prefix}; } return $args{_self} if $args{_self}; $args{dispatch} ||= 'Admin'; $args{prefix} ||= 'inc'; $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author'); $args{bundle} ||= 'inc/BUNDLES'; $args{base} ||= $base_path; $class =~ s/^\Q$args{prefix}\E:://; $args{name} ||= $class; $args{version} ||= $class->VERSION; unless ( $args{path} ) { $args{path} = $args{name}; $args{path} =~ s!::!/!g; } $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm"; $args{wrote} = 0; bless( \%args, $class ); } sub call { my ($self, $method) = @_; my $obj = $self->load($method) or return; splice(@_, 0, 2, $obj); goto &{$obj->can($method)}; } sub load { my ($self, $method) = @_; $self->load_extensions( "$self->{prefix}/$self->{path}", $self ) unless $self->{extensions}; foreach my $obj (@{$self->{extensions}}) { return $obj if $obj->can($method); } my $admin = $self->{admin} or die <<"END_DIE"; The '$method' method does not exist in the '$self->{prefix}' path! Please remove the '$self->{prefix}' directory and run $0 again to load it. END_DIE my $obj = $admin->load($method, 1); push @{$self->{extensions}}, $obj; $obj; } sub load_extensions { my ($self, $path, $top) = @_; my $should_reload = 0; unless ( grep { ! ref $_ and lc $_ eq lc $self->{prefix} } @INC ) { unshift @INC, $self->{prefix}; $should_reload = 1; } foreach my $rv ( $self->find_extensions($path) ) { my ($file, $pkg) = @{$rv}; next if $self->{pathnames}{$pkg}; local $@; my $new = eval { local $^W; require $file; $pkg->can('new') }; unless ( $new ) { warn $@ if $@; next; } $self->{pathnames}{$pkg} = $should_reload ? delete $INC{$file} : $INC{$file}; push @{$self->{extensions}}, &{$new}($pkg, _top => $top ); } $self->{extensions} ||= []; } sub find_extensions { my ($self, $path) = @_; my @found; File::Find::find( sub { my $file = $File::Find::name; return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is; my $subpath = $1; return if lc($subpath) eq lc($self->{dispatch}); $file = "$self->{path}/$subpath.pm"; my $pkg = "$self->{name}::$subpath"; $pkg =~ s!/!::!g; # If we have a mixed-case package name, assume case has been preserved # correctly. Otherwise, root through the file to locate the case-preserved # version of the package name. if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) { my $content = Module::Install::_read($subpath . '.pm'); my $in_pod = 0; foreach ( split //, $content ) { $in_pod = 1 if /^=\w/; $in_pod = 0 if /^=cut/; next if ($in_pod || /^=cut/); # skip pod text next if /^\s*#/; # and comments if ( m/^\s*package\s+($pkg)\s*;/i ) { $pkg = $1; last; } } } push @found, [ $file, $pkg ]; }, $path ) if -d $path; @found; } ##################################################################### # Common Utility Functions sub _caller { my $depth = 0; my $call = caller($depth); while ( $call eq __PACKAGE__ ) { $depth++; $call = caller($depth); } return $call; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _read { local *FH; open( FH, '<', $_[0] ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_NEW sub _read { local *FH; open( FH, "< $_[0]" ) or die "open($_[0]): $!"; my $string = do { local $/; }; close FH or die "close($_[0]): $!"; return $string; } END_OLD sub _readperl { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s; $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg; return $string; } sub _readpod { my $string = Module::Install::_read($_[0]); $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg; return $string if $_[0] =~ /\.pod\z/; $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg; $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg; $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg; $string =~ s/^\n+//s; return $string; } # Done in evals to avoid confusing Perl::MinimumVersion eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@; sub _write { local *FH; open( FH, '>', $_[0] ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_NEW sub _write { local *FH; open( FH, "> $_[0]" ) or die "open($_[0]): $!"; foreach ( 1 .. $#_ ) { print FH $_[$_] or die "print($_[0]): $!"; } close FH or die "close($_[0]): $!"; } END_OLD # _version is for processing module versions (eg, 1.03_05) not # Perl versions (eg, 5.8.1). sub _version ($) { my $s = shift || 0; my $d =()= $s =~ /(\.)/g; if ( $d >= 2 ) { # Normalise multipart versions $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg; } $s =~ s/^(\d+)\.?//; my $l = $1 || 0; my @v = map { $_ . '0' x (3 - length $_) } $s =~ /(\d{1,3})\D?/g; $l = $l . '.' . join '', @v if @v; return $l + 0; } sub _cmp ($$) { _version($_[1]) <=> _version($_[2]); } # Cloned from Params::Util::_CLASS sub _CLASS ($) { ( defined $_[0] and ! ref $_[0] and $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s ) ? $_[0] : undef; } 1; # Copyright 2008 - 2012 Adam Kennedy. HTML-Microformats-0.105/inc/Module/Package/0000755000076400007640000000000011775404022016405 5ustar taitaiHTML-Microformats-0.105/inc/Module/Package/Dist/0000755000076400007640000000000011775404022017310 5ustar taitaiHTML-Microformats-0.105/inc/Module/Package/Dist/RDF.pm0000644000076400007640000000137411775403731020274 0ustar taitai#line 1 package Module::Package::Dist::RDF; my $explanation = q< This is the component of Module::Package::RDF which gets bundled with the distribution. >; use 5.005; use strict; BEGIN { $Module::Package::Dist::RDF::AUTHORITY = 'cpan:TOBYINK'; $Module::Package::Dist::RDF::VERSION = '0.008'; @Module::Package::Dist::RDF::ISA = 'Module::Package::Dist'; } sub _main { my ($self) = @_; $self->mi->trust_meta_yml; $self->mi->auto_install; } { package Module::Package::Dist::RDF::standard; use 5.005; use strict; BEGIN { $Module::Package::Dist::RDF::standard::AUTHORITY = 'cpan:TOBYINK'; $Module::Package::Dist::RDF::standard::VERSION = '0.008'; @Module::Package::Dist::RDF::standard::ISA = 'Module::Package::Dist::RDF'; } } 1; HTML-Microformats-0.105/t/0000755000076400007640000000000011775404022013317 5ustar taitaiHTML-Microformats-0.105/t/01basic.t0000644000076400007640000000010411663405777014737 0ustar taitaiuse Test::More tests => 1; BEGIN { use_ok('HTML::Microformats') }; HTML-Microformats-0.105/t/12hatom.t0000644000076400007640000000421411663405777014776 0ustar taitaiuse Test::More tests => 10; use HTML::Microformats; my $html = <<'HTML';

First

World (0, 0)

First

Hello

World

Second

Bob
Alice
HTML my $document = HTML::Microformats->new_document($html, 'http://example.com/'); $document->assume_all_profiles; my ($blog, $news) = sort { $a->element->getAttribute('id') cmp $b->element->getAttribute('id') } $document->objects('hAtom'); my @blog_entries = @{ $blog->get_entry }; is( scalar @blog_entries, 2, "Two entries found in blog."); my @news_entries = @{ $news->get_entry }; is( scalar @news_entries, 1, "One entry found in news."); ok($news_entries[0]->isa('HTML::Microformats::Format::hNews'), 'News item is a news item'); ok($news_entries[0]->isa('HTML::Microformats::Format::hEntry'), 'News item is an entry'); is($news_entries[0]->data->{title}, 'First', 'News item has correct entry-title'); is($news_entries[0]->get_author->[0]->get_fn, 'Alice', 'Implied author'); is($news_entries[0]->get_geo->[0]->get_latitude, '0', 'News item has a geo'); my ($votelink) = $document->objects('VoteLinks'); is($votelink->get_voter->[0]->get_fn, 'Alice', 'hEntry propagates authors to VoteLinks'); is($blog_entries[0]->data->{content}, 'HelloWorld', 'Multiple entry-content elements concatenated'); is($document->model->count_statements( undef, RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://bblfish.net/work/atom-owl/2006-06-06/#Entry'), ), 3, 'Three atom:Entry resources output (RDF)'); HTML-Microformats-0.105/t/11hcalendar.t0000644000076400007640000001012611663405777015605 0ustar taitaiuse Test::More tests => 13; # should add some more use HTML::Microformats; my $html = <<'HTML';

2001-02-03T01:02:03+0100 Event 01 - basic

3 Feb Event 02 - value-title

3 Feb Event 03 - value-title with space

2001-02-03 01:02:03 +0100 Event 04 - splitting things up

+0100 01:02:03 2001-02-03 Event 05 - mixing them up

Z 01:02:03 2001-02-03 Event 06 - testing 'Z' timezone

+0100 1am 2001-02-03 Event 07 - test 1am

+0100 1 pm 2001-02-03 Event 08 - test 1pm

+0100 01.02 p. M. 2001-02-03 Event 09 - test 01.02 p.M.

+0100 01.02.03 p.M. 2001-02-03 Event 10 - test 01.02.03 p.M.

+0100 01.02.03 p.M. 2001-02-03 1.7.3 pm Event 11 - dtend feedthrough from dtstart (with 'value')

+0100 01.02.03 p.M. 2001-02-03 13:07:03 Event 12 - dtend feedthrough from dtstart (no 'value')

XXX 3 Feb Todo 01 - invalid value-title

HTML my $document = HTML::Microformats->new_document($html, 'http://example.com/'); $document->assume_all_profiles; my ($calendar) = $document->objects('hCalendar'); my @events = sort { $a->data->{summary} cmp $b->data->{summary} } @{ $calendar->get_vevent }; is($events[0]->get_dtstart, '2001-02-03T01:02:03+0100', $events[0]->get_summary); is($events[1]->get_dtstart, '2001-02-03T01:02:03+0100', $events[1]->get_summary); is($events[2]->get_dtstart, '2001-02-03T01:02:03+0100', $events[2]->get_summary); is($events[3]->get_dtstart, '2001-02-03T01:02:03+0100', $events[3]->get_summary); is($events[4]->get_dtstart, '2001-02-03T01:02:03+0100', $events[4]->get_summary); is($events[5]->get_dtstart, '2001-02-03T01:02:03+0000', $events[5]->get_summary); is($events[6]->get_dtstart, '2001-02-03T01:00+0100', $events[6]->get_summary); is($events[7]->get_dtstart, '2001-02-03T13:00+0100', $events[7]->get_summary); is($events[8]->get_dtstart, '2001-02-03T13:02+0100', $events[8]->get_summary); is($events[9]->get_dtstart, '2001-02-03T13:02:03+0100', $events[9]->get_summary); is($events[10]->get_dtend, '2001-02-03T13:07:03+0100', $events[10]->get_summary); is($events[11]->get_dtend, '2001-02-03T13:07:03+0100', $events[11]->get_summary); my @todos = sort { $a->data->{summary} cmp $b->data->{summary} } @{ $calendar->get_vtodo }; is($todos[0]->get_dtstart, undef, $todos[0]->get_summary); HTML-Microformats-0.105/t/14reltag.t0000644000076400007640000000252311663405777015147 0ustar taitaiuse Test::More tests => 8; use HTML::Microformats; my $html = <<'HTML';

Neil Armstrong

Bee Keeping

Bees
HTML my $document = HTML::Microformats->new_document($html, 'http://example.com/'); $document->assume_all_profiles; my @tags = sort { $a->get_tag cmp $b->get_tag } $document->objects('RelTag'); is($tags[0]->get_tag, 'Astronaut', 'tag Astronaut found'); is($tags[1]->get_tag, 'Bees', 'tag Bees found'); is($tags[2]->get_tag, 'Cats', 'tag Cats found'); for my $i (0..2) { is($tags[$i]->get_tagspace, 'http://example.com/tag/', 'tag has correct tag space'); } my $model = $document->model; is($model->count_statements( RDF::Trine::Node::Resource->new('http://example.com/'), RDF::Trine::Node::Resource->new('http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'), undef), 3, 'Page tagged with three tags.'); my ($armstrong) = $document->objects('hCard'); is($model->count_statements( $armstrong->id(1), RDF::Trine::Node::Resource->new('http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'), undef), 1, 'VCard tagged.'); HTML-Microformats-0.105/t/13xfn.t0000644000076400007640000000431011663405777014457 0ustar taitaiuse Test::More tests => 6; use HTML::Microformats; my $html = <<'HTML';
Alice
Bob Carol HTML my $document = HTML::Microformats->new_document($html, 'http://alice.example.com/'); $document->assume_all_profiles; my $model = $document->model; ok($model->count_statements( RDF::Trine::Node::Resource->new('http://alice.example.com/'), RDF::Trine::Node::Resource->new('http://vocab.sindice.com/xfn#met-hyperlink'), RDF::Trine::Node::Resource->new('mailto:bob@example.com'), ), "XFN vocab *-hyperlink works." ); my $iter = $model->get_statements( undef, RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/page'), RDF::Trine::Node::Resource->new('http://carol.example.com/'), ); my $st = $iter->next; my $carol = $st->subject; ok($model->count_statements( undef, RDF::Trine::Node::Resource->new('http://vocab.sindice.com/xfn#met'), $carol, ), "Alice met Carol." ); ok($model->count_statements( $carol, RDF::Trine::Node::Resource->new('http://vocab.sindice.com/xfn#met'), undef, ), "Carol met Alice." ); ok($model->count_statements( undef, RDF::Trine::Node::Resource->new('http://buzzword.org.uk/rdf/xen#nemesis'), $carol, ), "XEN profile detected." ); ok($model->count_statements( undef, RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/knows'), $carol, ), "Infer foaf:knowses." ); ok($model->count_statements( undef, RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/mbox'), RDF::Trine::Node::Resource->new('mailto:bob@example.com'), ), "mailto: links treated as mbox rather than page." ); #use RDF::TrineShortcuts; #$RDF::TrineShortcuts::Namespaces->{'vx'} = 'http://buzzword.org.uk/rdf/vcardx#'; #$RDF::TrineShortcuts::Namespaces->{'hcard'} = 'http://purl.org/uF/hCard/terms/'; #$RDF::TrineShortcuts::Namespaces->{'xfn'} = 'http://vocab.sindice.com/xfn#'; #$RDF::TrineShortcuts::Namespaces->{'xen'} = 'http://buzzword.org.uk/rdf/xen#'; #diag rdf_string($model => 'rdfxml'); HTML-Microformats-0.105/t/15rellicense.t0000644000076400007640000000265011663405777016020 0ustar taitaiuse Test::More tests => 8; use HTML::Microformats; my $html = <<'HTML'; License HTML my $document = HTML::Microformats->new_document($html, 'http://example.com/'); $document->assume_all_profiles; my ($l) = $document->objects('RelLicense'); is($l->get_href, 'http://example.com/l', 'License URI correct.'); is($l->get_title, 'License', 'License title correct'); is($l->get_label, 'Lic', 'License label correct'); my $model = $document->model; foreach my $uri (qw(http://creativecommons.org/ns#license http://www.w3.org/1999/xhtml/vocab#license http://purl.org/dc/terms/license)) { ok($model->count_statements( RDF::Trine::Node::Resource->new('http://example.com/'), RDF::Trine::Node::Resource->new($uri), RDF::Trine::Node::Resource->new('http://example.com/l')), "RDF Predicate <$uri> set"); } ok($model->count_statements( RDF::Trine::Node::Resource->new('http://example.com/'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://creativecommons.org/ns#Work')), "cc:Work set"); ok($model->count_statements( RDF::Trine::Node::Resource->new('http://example.com/l'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://creativecommons.org/ns#License')), "cc:License set"); HTML-Microformats-0.105/t/10hcard.t0000644000076400007640000000420211663405777014742 0ustar taitaiuse Test::More tests => 10; use HTML::Microformats; my $html = <<'HTML';

My Org

General Enquiries: +44 1234 567 890

Fax: +44 1234 567 891

Help Desk +44 1234 567 899

HTML my $document = HTML::Microformats->new_document($html, 'http://example.com/'); $document->assume_all_profiles; my @cards = sort { $a->data->{fn} cmp $b->data->{fn} } $document->objects('hCard'); is($cards[0]->get_kind, 'group', 'Auto-detect group kind.'); is($cards[1]->get_kind, 'org', 'Auto-detect organisation kind.'); is($cards[0]->element->tagName, 'p', 'Can get links back to elements.'); is($cards[1]->get_tel->[0]->get_value, 'tel:+441234567890', 'Parsed tel without type+value'); is($cards[1]->get_tel->[1]->get_value, 'tel:+441234567891', 'Parsed tel with type+value'); is($cards[1]->get_agent->[0], $cards[0], 'Agent works OK'); my $model = $document->model; ok($model->count_statements( $cards[1]->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/2006/vcard/ns#agent'), $cards[0]->id(1), ), "Agent works OK (RDF)" ); ok($model->count_statements( $cards[1]->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/2006/vcard/ns#fn'), RDF::Trine::Node::Literal->new('My Org', 'en'), ), "Languages work OK (RDF)" ); ok($model->count_statements( $cards[1]->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://purl.org/uF/hCard/terms/hasCard'), $cards[1]->id(1), ), "Differentiates between vcards and their holders (RDF)" ); ok($model->count_statements( $cards[1]->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/name'), RDF::Trine::Node::Literal->new('My Org', 'en'), ), "Infers information about vcard holder from the vcard (RDF)" ); HTML-Microformats-0.105/README0000644000076400007640000002162211775403731013745 0ustar taitaiNAME HTML::Microformats - parse microformats in HTML SYNOPSIS use HTML::Microformats; my $doc = HTML::Microformats ->new_document($html, $uri) ->assume_profile(qw(hCard hCalendar)); print $doc->json(pretty => 1); use RDF::TrineShortcuts qw(rdf_query); my $results = rdf_query($sparql, $doc->model); DESCRIPTION The HTML::Microformats module is a wrapper for parser and handler modules of various individual microformats (each of those modules has a name like HTML::Microformats::Format::Foo). The general pattern of usage is to create an HTML::Microformats object (which corresponds to an HTML document) using the "new_document" method; then ask for the data, as a Perl hashref, a JSON string, or an RDF::Trine model. Constructor "$doc = HTML::Microformats->new_document($html, $uri, %opts)" Constructs a document object. $html is the HTML or XHTML source (string) or an XML::LibXML::Document. $uri is the document URI, important for resolving relative URL references. %opts are additional parameters; currently only one option is defined: $opts{'type'} is set to 'text/html' or 'application/xhtml+xml', to control how $html is parsed. Profile Management HTML::Microformats uses HTML profiles (i.e. the profile attribute on the HTML element) to detect which Microformats are used on a page. Any microformats which do not have a profile URI declared will not be parsed. Because many pages fail to properly declare which profiles they use, there are various profile management methods to tell HTML::Microformats to assume the presence of particular profile URIs, even if they're actually missing. "$doc->profiles" This method returns a list of profile URIs declared by the document. "$doc->has_profile(@profiles)" This method returns true if and only if one or more of the profile URIs in @profiles is declared by the document. "$doc->add_profile(@profiles)" Using "add_profile" you can add one or more profile URIs, and they are treated as if they were found on the document. For example: $doc->add_profile('http://microformats.org/profile/rel-tag') This is useful for adding profile URIs declared outside the document itself (e.g. in HTTP headers). Returns a reference to the document. "$doc->assume_profile(@microformats)" For example: $doc->assume_profile(qw(hCard adr geo)) This method acts similarly to "add_profile" but allows you to use names of microformats rather than URIs. Microformat names are case sensitive, and must match HTML::Microformats::Format::Foo module names. Returns a reference to the document. "$doc->assume_all_profiles" This method is equivalent to calling "assume_profile" for all known microformats. Returns a reference to the document. Parsing Microformats Generally speaking, you can skip this. The "data", "json" and "model" methods will automatically do this for you. "$doc->parse_microformats" Scans through the document, finding microformat objects. On subsequent calls, does nothing (as everything is already parsed). Returns a reference to the document. "$doc->clear_microformats" Forgets information gleaned by "parse_microformats" and thus allows "parse_microformats" to be run again. This is useful if you've modified added some profiles between runs of "parse_microformats". Returns a reference to the document. Retrieving Data These methods allow you to retrieve the document's data, and do things with it. "$doc->objects($format);" $format is, for example, 'hCard', 'adr' or 'RelTag'. Returns a list of objects of that type. (If called in scalar context, returns an arrayref.) Each object is, for example, an HTML::Microformat::hCard object, or an HTML::Microformat::RelTag object, etc. See the relevent documentation for details. "$doc->all_objects" Returns a hashref of data. Each hashref key is the name of a microformat (e.g. 'hCard', 'RelTag', etc), and the values are arrayrefs of objects. Each object is, for example, an HTML::Microformat::hCard object, or an HTML::Microformat::RelTag object, etc. See the relevent documentation for details. "$doc->json(%opts)" Returns data roughly equivalent to the "all_objects" method, but as a JSON string. %opts is a hash of options, suitable for passing to the JSON module's to_json function. The 'convert_blessed' and 'utf8' options are enabled by default, but can be disabled by explicitly setting them to 0, e.g. print $doc->json( pretty=>1, canonical=>1, utf8=>0 ); "$doc->model" Returns data as an RDF::Trine::Model, suitable for serialising as RDF or running SPARQL queries. "$object->serialise_model(as => $format)" As "model" but returns a string. "$doc->add_to_model($model)" Adds data to an existing RDF::Trine::Model. Returns a reference to the document. Utility Functions "HTML::Microformats->modules" Returns a list of Perl modules, each of which implements a specific microformat. "HTML::Microformats->formats" As per "modules", but strips 'HTML::Microformats::Format::' off the module name, and sorts alphabetically. WHY ANOTHER MICROFORMATS MODULE? There already exist two microformats packages on CPAN (see Text::Microformat and Data::Microformat), so why create another? Firstly, HTML::Microformats isn't being created from scratch. It's actually a fork/clean-up of a non-CPAN application (Swignition), and in that sense predates Text::Microformat (though not Data::Microformat). It has a number of other features that distinguish it from the existing packages: * It supports more formats. HTML::Microformats supports hCard, hCalendar, rel-tag, geo, adr, rel-enclosure, rel-license, hReview, hResume, hRecipe, xFolk, XFN, hAtom, hNews and more. * It supports more patterns. HTML::Microformats supports the include pattern, abbr pattern, table cell header pattern, value excerpting and other intricacies of microformat parsing better than the other modules on CPAN. * It offers RDF support. One of the key features of HTML::Microformats is that it makes data available as RDF::Trine models. This allows your application to benefit from a rich, feature-laden Semantic Web toolkit. Data gleaned from microformats can be stored in a triple store; output in RDF/XML or Turtle; queried using the SPARQL or RDQL query languages; and more. If you're not comfortable using RDF, HTML::Microformats also makes all its data available as native Perl objects. BUGS Please report any bugs to . SEE ALSO HTML::Microformats::Documentation::Notes. Individual format modules: * HTML::Microformats::Format::adr * HTML::Microformats::Format::figure * HTML::Microformats::Format::geo * HTML::Microformats::Format::hAtom * HTML::Microformats::Format::hAudio * HTML::Microformats::Format::hCalendar * HTML::Microformats::Format::hCard * HTML::Microformats::Format::hListing * HTML::Microformats::Format::hMeasure * HTML::Microformats::Format::hNews * HTML::Microformats::Format::hProduct * HTML::Microformats::Format::hRecipe * HTML::Microformats::Format::hResume * HTML::Microformats::Format::hReview * HTML::Microformats::Format::hReviewAggregate * HTML::Microformats::Format::OpenURL_COinS * HTML::Microformats::Format::RelEnclosure * HTML::Microformats::Format::RelLicense * HTML::Microformats::Format::RelTag * HTML::Microformats::Format::species * HTML::Microformats::Format::VoteLinks * HTML::Microformats::Format::XFN * HTML::Microformats::Format::XMDP * HTML::Microformats::Format::XOXO Similar modules: RDF::RDFa::Parser, HTML::HTML5::Microdata::Parser, XML::Atom::Microformats, Text::Microformat, Data::Microformats. Related web sites: , . AUTHOR Toby Inkster . COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. HTML-Microformats-0.105/lib/0000755000076400007640000000000011775404022013622 5ustar taitaiHTML-Microformats-0.105/lib/HTML/0000755000076400007640000000000011775404022014366 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats.pm0000644000076400007640000003034411775403507017404 0ustar taitaipackage HTML::Microformats; use strict qw(subs vars); no warnings; use 5.010; use HTML::HTML5::Parser; use HTML::HTML5::Sanity qw(fix_document); use HTML::Microformats::DocumentContext; use HTML::Microformats::Datatype; use HTML::Microformats::Format; use JSON; use RDF::Trine 0.130; use XML::LibXML; use Object::AUTHORITY; BEGIN { $HTML::Microformats::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::VERSION = '0.105'; } sub new_document { my $class = shift; my $document = shift; my $uri = shift; my %opts = @_; my $self = bless {}, $class; $self->modules; # force modules to be loaded if (ref $document && $document->isa('XML::LibXML::Document')) { } elsif ($opts{'type'} =~ /x(ht)?ml/i) { my $parser = XML::LibXML->new; $document = $parser->parse_string($document); } else { my $parser = HTML::HTML5::Parser->new; $document = fix_document( $parser->parse_string($document) ); } $self->{'context'} = HTML::Microformats::DocumentContext->new($document, $uri); return $self; } sub profiles { my $self = shift; return $self->{'context'}->profiles(@_); } sub has_profile { my $self = shift; return $self->{'context'}->has_profile(@_); } sub add_profile { my $self = shift; $self->{'context'}->add_profile(@_); return $self; } sub assume_profile { my $self = shift; foreach my $fmt (@_) { my $profile = $fmt; ($profile) = "HTML::Microformats::Format::${fmt}"->profiles if $fmt !~ ':'; $self->add_profile($profile); } return $self; } sub assume_all_profiles { my $self = shift; $self->assume_profile($self->formats); return $self; } sub parse_microformats { my $self = shift; return if $self->{'parsed'}; foreach my $fmt ($self->formats) { my @profiles = "HTML::Microformats::Format::${fmt}"->profiles; if ($self->has_profile(@profiles)) { my @objects = "HTML::Microformats::Format::${fmt}"->extract_all( $self->{'context'}->document->documentElement, $self->{'context'}); $self->{'objects'}->{$fmt} = \@objects; } } $self->{'parsed'} = 1; return $self; } sub clear_microformats { my $self = shift; $self->{'objects'} = undef; $self->{'context'}->cache->clear; $self->{'parsed'} = 0; return $self; } sub objects { my $self = shift; my $fmt = shift; $self->parse_microformats; return @{ $self->{'objects'}->{$fmt} } if wantarray; return $self->{'objects'}->{$fmt}; } sub all_objects { my $self = shift; $self->parse_microformats; return $self->{'objects'}; } sub TO_JSON { return $_[0]->all_objects; } sub json { my $self = shift; my %opts = @_; $opts{'convert_blessed'} = 1 unless defined $opts{'convert_blessed'}; $opts{'utf8'} = 1 unless defined $opts{'utf8'}; return to_json($self->all_objects, \%opts); } sub model { my $self = shift; my $model = RDF::Trine::Model->temporary_model; $self->add_to_model($model); return $model; } sub serialise_model { my $self = shift; my %opts = ref $_[0] ? %{ $_[0] } : @_; $opts{as} ||= 'Turtle'; my $ser = RDF::Trine::Serializer->new(delete $opts{as}, %opts); return $ser->serialize_model_to_string($self->model); } sub add_to_model { my $self = shift; my $model = shift; $self->parse_microformats; foreach my $fmt ($self->formats) { foreach my $object (@{ $self->{'objects'}->{$fmt} }) { $object->add_to_model($model); } } return $self; } use Module::Pluggable require => 1, inner => 0, search_path => ['HTML::Microformats::Format'], only => qr/^HTML::Microformats::Format::[^:]+$/, sub_name => 'modules', ; sub formats { my $class = shift || __PACKAGE__; return sort { lc $a cmp lc $b } map { s/^HTML::Microformats::Format:://; $_ } $class->modules; } 1; __END__ =head1 NAME HTML::Microformats - parse microformats in HTML =head1 SYNOPSIS use HTML::Microformats; my $doc = HTML::Microformats ->new_document($html, $uri) ->assume_profile(qw(hCard hCalendar)); print $doc->json(pretty => 1); use RDF::TrineShortcuts qw(rdf_query); my $results = rdf_query($sparql, $doc->model); =head1 DESCRIPTION The HTML::Microformats module is a wrapper for parser and handler modules of various individual microformats (each of those modules has a name like HTML::Microformats::Format::Foo). The general pattern of usage is to create an HTML::Microformats object (which corresponds to an HTML document) using the C method; then ask for the data, as a Perl hashref, a JSON string, or an RDF::Trine model. =head2 Constructor =over 4 =item C<< $doc = HTML::Microformats->new_document($html, $uri, %opts) >> Constructs a document object. $html is the HTML or XHTML source (string) or an XML::LibXML::Document. $uri is the document URI, important for resolving relative URL references. %opts are additional parameters; currently only one option is defined: $opts{'type'} is set to 'text/html' or 'application/xhtml+xml', to control how $html is parsed. =back =head2 Profile Management HTML::Microformats uses HTML profiles (i.e. the profile attribute on the HTML element) to detect which Microformats are used on a page. Any microformats which do not have a profile URI declared will not be parsed. Because many pages fail to properly declare which profiles they use, there are various profile management methods to tell HTML::Microformats to assume the presence of particular profile URIs, even if they're actually missing. =over 4 =item C<< $doc->profiles >> This method returns a list of profile URIs declared by the document. =item C<< $doc->has_profile(@profiles) >> This method returns true if and only if one or more of the profile URIs in @profiles is declared by the document. =item C<< $doc->add_profile(@profiles) >> Using C you can add one or more profile URIs, and they are treated as if they were found on the document. For example: $doc->add_profile('http://microformats.org/profile/rel-tag') This is useful for adding profile URIs declared outside the document itself (e.g. in HTTP headers). Returns a reference to the document. =item C<< $doc->assume_profile(@microformats) >> For example: $doc->assume_profile(qw(hCard adr geo)) This method acts similarly to C but allows you to use names of microformats rather than URIs. Microformat names are case sensitive, and must match HTML::Microformats::Format::Foo module names. Returns a reference to the document. =item C<< $doc->assume_all_profiles >> This method is equivalent to calling C for all known microformats. Returns a reference to the document. =back =head2 Parsing Microformats Generally speaking, you can skip this. The C, C and C methods will automatically do this for you. =over 4 =item C<< $doc->parse_microformats >> Scans through the document, finding microformat objects. On subsequent calls, does nothing (as everything is already parsed). Returns a reference to the document. =item C<< $doc->clear_microformats >> Forgets information gleaned by C and thus allows C to be run again. This is useful if you've modified added some profiles between runs of C. Returns a reference to the document. =back =head2 Retrieving Data These methods allow you to retrieve the document's data, and do things with it. =over 4 =item C<< $doc->objects($format); >> $format is, for example, 'hCard', 'adr' or 'RelTag'. Returns a list of objects of that type. (If called in scalar context, returns an arrayref.) Each object is, for example, an HTML::Microformat::hCard object, or an HTML::Microformat::RelTag object, etc. See the relevent documentation for details. =item C<< $doc->all_objects >> Returns a hashref of data. Each hashref key is the name of a microformat (e.g. 'hCard', 'RelTag', etc), and the values are arrayrefs of objects. Each object is, for example, an HTML::Microformat::hCard object, or an HTML::Microformat::RelTag object, etc. See the relevent documentation for details. =item C<< $doc->json(%opts) >> Returns data roughly equivalent to the C method, but as a JSON string. %opts is a hash of options, suitable for passing to the L module's to_json function. The 'convert_blessed' and 'utf8' options are enabled by default, but can be disabled by explicitly setting them to 0, e.g. print $doc->json( pretty=>1, canonical=>1, utf8=>0 ); =item C<< $doc->model >> Returns data as an RDF::Trine::Model, suitable for serialising as RDF or running SPARQL queries. =item C<< $object->serialise_model(as => $format) >> As C but returns a string. =item C<< $doc->add_to_model($model) >> Adds data to an existing RDF::Trine::Model. Returns a reference to the document. =back =head2 Utility Functions =over 4 =item C<< HTML::Microformats->modules >> Returns a list of Perl modules, each of which implements a specific microformat. =item C<< HTML::Microformats->formats >> As per C, but strips 'HTML::Microformats::Format::' off the module name, and sorts alphabetically. =back =head1 WHY ANOTHER MICROFORMATS MODULE? There already exist two microformats packages on CPAN (see L and L), so why create another? Firstly, HTML::Microformats isn't being created from scratch. It's actually a fork/clean-up of a non-CPAN application (Swignition), and in that sense predates Text::Microformat (though not Data::Microformat). It has a number of other features that distinguish it from the existing packages: =over 4 =item * It supports more formats. HTML::Microformats supports hCard, hCalendar, rel-tag, geo, adr, rel-enclosure, rel-license, hReview, hResume, hRecipe, xFolk, XFN, hAtom, hNews and more. =item * It supports more patterns. HTML::Microformats supports the include pattern, abbr pattern, table cell header pattern, value excerpting and other intricacies of microformat parsing better than the other modules on CPAN. =item * It offers RDF support. One of the key features of HTML::Microformats is that it makes data available as RDF::Trine models. This allows your application to benefit from a rich, feature-laden Semantic Web toolkit. Data gleaned from microformats can be stored in a triple store; output in RDF/XML or Turtle; queried using the SPARQL or RDQL query languages; and more. If you're not comfortable using RDF, HTML::Microformats also makes all its data available as native Perl objects. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. Individual format modules: =over 4 =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =item * L =back Similar modules: L, L, L, L, L. Related web sites: L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. HTML-Microformats-0.105/lib/HTML/Microformats/0000755000076400007640000000000011775404022017033 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Mixin/0000755000076400007640000000000011775404022020117 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Mixin/Parser.pm0000644000076400007640000006556111775403507021735 0ustar taitaipackage HTML::Microformats::Mixin::Parser; use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(/^search/); use HTML::Microformats::Format::adr; use HTML::Microformats::Datatype; use HTML::Microformats::Format::geo; use HTML::Microformats::Format::hAtom; use HTML::Microformats::Format::hCalendar; use HTML::Microformats::Format::hCard; use HTML::Microformats::Format::hMeasure; use HTML::Microformats::Format::RelEnclosure; use HTML::Microformats::Format::RelLicense; use HTML::Microformats::Format::RelTag; use HTML::Microformats::Format::species; use URI::URL; use XML::LibXML qw(:all); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Mixin::Parser::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Mixin::Parser::VERSION = '0.105'; } # Cleans away nested compound microformats. Any intentionally # nested microformats (e.g. vcard class="agent vcard") should be # dealt with BEFORE calling the destroyer! Because of the # destructive nature of this function, make sure that you only # use it on a clone of the real node. sub _destroyer { my $self = shift; my $element = shift; # Classes to be destroyed my @containers = qw(mfo vcard adr geo vcalendar vevent vtodo valarm vfreebusy hfeed hentry hslice hreview hresume xfolkentry biota haudio hmeasure hangle hmoney hlisting vtodo-list figure hproduct hnews); my %C; foreach my $c (@containers) { $C{$c}=1; } # Some classes may be retained, optionally. foreach my $c (@_) { $C{$c}=0; } # Assemble them all into the regular expression of death. @containers = (); foreach my $c (keys %C) { push @containers, $c if $C{$c}; } my $regexp = join '|', @containers; $regexp = "\\b($regexp)\\b"; $regexp =~ s/\-/\\\-/g; # Destroy child elements matching the regular expression. foreach my $e ($element->getElementsByTagName('*')) { next if $e == $element; if ($e->getAttribute('class') =~ /$regexp/) { $self->_destroy_element($e); my $newclass = $e->getAttribute('class'); $newclass =~ s/$regexp//g; $e->setAttribute('class', $newclass); $e->removeAttribute('class') unless length $newclass; } } } sub _destroy_element { my $self = shift; my $element = shift; foreach my $c ($element->getElementsByTagName('*')) { $c->removeAttribute('class'); $c->removeAttribute('rel'); $c->removeAttribute('rev'); } } sub _expand_patterns { my $self = shift; my $root = shift || $self->element; my $max_include_loops = shift || 2; # Expand microformat include pattern. my $incl_iterations = 0; my $replacements = 1; while (($incl_iterations < $max_include_loops) && $replacements) { $replacements = $self->_expand_include_pattern($root) + $self->_expand_include_pattern_2($root); $incl_iterations++; } # Table cell headers pattern. $self->_expand_table_header_pattern($root); # Magical data-X class pattern. $self->_expand_dataX_class_pattern($root); } sub _expand_dataX_class_pattern { my $self = shift; my $node = shift; return unless $self->context->has_profile('http://purl.org/uF/pattern-data-class/1'); foreach my $kid ($node->getElementsByTagName('*')) { my $classes = $kid->getAttribute('class'); $classes =~ s/(^\s+|\s+$)//g; $classes =~ s/\s+/ /g; my @classes = split / /, $classes; map s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg, @classes; my @dataClasses = grep /^data\-/, @classes; next unless (@dataClasses); my $val = ''; foreach my $d (@dataClasses) { $val = $d unless ((length $val) > (length $d)); } $val =~ s/^data\-//; $kid->setAttribute('data-cpan-html-microformats-content', $val); } } sub _expand_table_header_pattern { my $self = shift; my $node = shift; # Add node itself to list! my @elements = $node->getElementsByTagName('td'); if (('XML::LibXML::Element' eq ref $node) && $node->tagName =~ /^t[dh]$/i) { unshift @elements, $node; } foreach my $tag (@elements) { next unless length $tag->getAttribute('headers'); my $headers = $tag->getAttribute('headers'); $headers =~ s/(^\s+|\s+$)//g; $headers =~ s/\s+/ /g; my @headers = split / /, $headers; foreach my $H (@headers) { my $Htag = searchID($H, $self->context->document); next unless ($Htag); next unless ($Htag->tagName =~ /^t[dh]$/i); my $new = $self->context->document->createElement('div'); $new->setAttribute('class', $Htag->getAttribute('class')); foreach my $kid ($Htag->childNodes) { my $x = $kid->cloneNode(1); if ($kid->nodeType==XML_ELEMENT_NODE || $kid->nodeType==XML_TEXT_NODE) { my $r = $new->appendChild($x); } } $tag->appendChild($new); } $tag->setAttribute('headers', ''); } } sub _expand_include_pattern # Implements the standard microformats include pattern. { my $self = shift; my $node = shift; my $class = shift || 'include'; my $rv = 0; # For each link... my @links1 = $node->getElementsByTagName('a'); my @links2 = $node->getElementsByTagName('object'); my @links3 = $node->getElementsByTagName('area'); my @links = (@links1, @links2, @links3); foreach my $link (@links) { # Skip pattern if no class attribute found. my $classList = $link->getAttribute('class') || next; # We've found a use of the include pattern if ($classList =~ / (^|\s) $class (\s|$) /x) { my $href = $link->hasAttribute('href') ? $link->getAttribute('href') : $link->getAttribute('data') ; my $id = undef; if ($href =~ /^\#(.*)$/) { $id = $1; } else { next; } # find the included node my $replacement = searchID($id, $self->context->document); next unless $replacement; # do not include it if it's an ancestor my $link_xpath = $link->getAttribute('data-cpan-html-microformats'); my $repl_xpath = $replacement->getAttribute('data-cpan-html-microformats'); next if (substr($link_xpath, 0, length $repl_xpath) eq $repl_xpath); # replace the including element with the included element $replacement = $replacement->cloneNode(1); $link->getParentNode->replaceChild($replacement, $link) && $rv++; } } # Return number of replacements made. return $rv; } sub _expand_include_pattern_2 # Implements the alternative microformats include pattern. { my $self = shift; my $node = shift; my $classpfx = shift || '#'; my $rv = 0; # Add node itself to list! my @elements = $node->getElementsByTagName('*'); unshift @elements, $node; # For each element... foreach my $elem (@elements) { # Skip pattern if no class attribute found. my $classList; $classList = $elem->getAttribute('class') if 'XML::LibXML::Element' eq ref $elem; next unless ($classList =~ / $classpfx /x); my $atEnd = 0; $classList =~ s/(^\s|\s$)//g; $classList =~ s/\s+/ /g; my @classes = split / /, $classList; my @newClassList = (); foreach my $c (@classes) { if (substr($c,0,1) ne $classpfx && length($c)>=1) { push @newClassList, $c; $atEnd = 1; next; } my $id = $c; $id =~ s/^\#//x; my $replacement = searchID($id, $self->context->document) || next; # do not include it if it's an ancestor my $link_xpath = $elem->getAttribute('data-cpan-html-microformats'); my $repl_xpath = $replacement->getAttribute('data-cpan-html-microformats'); next if (substr($link_xpath, 0, length $repl_xpath) eq $repl_xpath); $replacement = $replacement->cloneNode(1); if ($atEnd) { $elem->appendChild($replacement) && $rv++; } else { $elem->insertBefore($replacement, $elem->getFirstChild) && $rv++; } } $elem->setAttribute('class', join(' ', @newClassList)) if 'XML::LibXML::Element' eq ref $elem; } # Return number of replacements made. return $rv; } sub _matching_nodes { my $self = shift; my $class = shift; my $type = shift; my $root = shift || $self->element; my @matching_nodes; if ($type =~ /r/i) { @matching_nodes = searchRel($class, $root); } elsif ($type =~ /t/i) { @matching_nodes = $root->getElementsByTagName($class); } if ($type !~ /[rt]/) { my @mn2 = searchClass($class, $root); push @matching_nodes, @mn2; } return @matching_nodes; } sub _simple_parse_found_error { my $self = shift; push @{ $self->{ERRORS} }, \@_; } # 1 = singular, required # ? = singular, optional # + = plural, required # * = plural, optional # ** = plural, optional, and funny behaviour with embedded microformats # d = date # D = duration # e = exrule/rrule # i = interval # h = HTML # H = HTML and Text (HTML value is prefixed 'html_') # m = embedded composite microformat # M = embedded composite microformat or text # MM = embedded composite microformat or text, if url use pseudo-microformat # n = numeric # r = rel, not class # R = rel *or* class # t = tag name, not class # T = tag name *or* class # u = URI # U = URI or fragment or text # & = concatenate strings # < = Also store node (in $self->{'DATA_'}) # # = _simple_parse should ignore this property # v = don't do 'value' excerption sub _simple_parse # This was not simple to implement, but should be simple to use. # This function takes on too much responsibility. # It should delegate stuff. { my $self = shift; my $root = shift || $self->element; my $classes = $self->format_signature->{'classes'}; my $options = $self->format_signature->{'options'} || {}; my $page = $self->context; # So far haven't needed any more than this. my $uf_roots = { 'hCard' => 'vcard', 'hEvent' => 'vevent', 'hAlarm' => 'valarm', 'hTodo' => 'vtodo', 'hFreebusy' => 'vfreebusy', 'hCalendar' => 'vcalendar', 'hMeasure' => 'hmeasure|hangle|hmoney', 'species' => 'biota', 'hAtom' => 'hfeed' }; # Derived from HTML::Tagset, but some modifications to the order of attrs. my $link_elements = { 'a' => ['href'], 'applet' => ['codebase', 'archive', 'code'], 'area' => ['href'], 'base' => ['href'], 'bgsound' => ['src'], 'blockquote' => ['cite'], # 'body' => ['background'], 'del' => ['cite'], 'embed' => ['src', 'pluginspage'], 'form' => ['action'], 'frame' => ['src', 'longdesc'], 'iframe' => ['src', 'longdesc'], # 'ilayer' => ['background'], 'img' => ['src', 'lowsrc', 'longdesc', 'usemap'], 'input' => ['src', 'usemap'], 'ins' => ['cite'], 'isindex' => ['action'], 'head' => ['profile'], 'layer' => ['src'], # 'background' 'link' => ['href'], 'object' => ['data', 'classid', 'codebase', 'archive', 'usemap'], 'q' => ['cite'], 'script' => ['src', 'for'], # 'table' => ['background'], # 'td' => ['background'], # 'th' => ['background'], # 'tr' => ['background'], 'xmp' => ['href'], }; foreach my $c (@$classes) { my $class = $c->[0]; my $type = $c->[1]; my $class_options = $c->[2] || {}; my @try_ufs = split / /, $class_options->{'embedded'}; next if $type =~ /#/; next unless $type =~ /m/i && defined $try_ufs[0]; my @parsed_objects; my @matching_nodes = $self->_matching_nodes($class, $type, $root); my @ok_matching_nodes; if ($class_options->{'nesting-ok'}) { @ok_matching_nodes = @matching_nodes; } else { # This is a little bit of extra code that checks for interleaving uF # root class elements and excludes them. For example, in the following, # the outer hCard should not have an agent: #
#

# #

#
my @mfos = qw(mfo vcard adr geo vcalendar vevent vtodo valarm vfreebusy hfeed hentry hslice hreview hresume xfolkentry biota haudio hmeasure hangle hmoney hlisting vtodo-list figure hproduct hnews); my $mfos = '\b('.(join '|', @mfos).')\b'; foreach my $u (@{$class_options->{'allow-interleaved'}}) { $mfos =~ s/\|$u//; } foreach my $mn (@matching_nodes) { my $is_ok = 1; my $ancestor = $mn->parentNode; while (length $ancestor->getAttribute('data-cpan-html-microformats-nodepath') > length $root->getAttribute('data-cpan-html-microformats-nodepath')) { if ($ancestor->getAttribute('class')=~$mfos) { $is_ok = 0; last; } $ancestor = $ancestor->parentNode; } push @ok_matching_nodes, $mn if ($is_ok); } } # For each matching node foreach my $node (@ok_matching_nodes) { my @node_parsed_objects; # Try each microformat until we find something no strict 'refs'; foreach my $uf (@try_ufs) { my $uf_class = (defined $uf_roots->{$uf}) ? $uf_roots->{$uf} : lc($uf); last if defined $node_parsed_objects[0]; if ($uf eq '!person') { # This is used as a last-ditch attempt to parse a person. my $obj = HTML::Microformats::Format::hCard->new_fallback($node, $self->context); push @node_parsed_objects, $obj; } elsif ($node->getAttribute('class') =~ /\b($uf_class)\b/) { my $pkg = 'HTML::Microformats::Format::'.$uf; my $obj = eval "${pkg}->new(\$node, \$self->context, in_hcalendar => \$class_options->{'is-in-cal'});"; push @node_parsed_objects, $obj; } else { my $pkg = 'HTML::Microformats::Format::'.$uf; my @all = eval "${pkg}->extract_all(\$node, \$self->context, in_hcalendar => \$class_options->{'is-in-cal'});"; push @node_parsed_objects, @all if @all; } $self->_simple_parse_found_error('W', "Multiple embedded $uf objects found in a single $class property. This is weird.") if defined $node_parsed_objects[1]; } use strict 'refs'; # If we've found something if (defined $node_parsed_objects[0] && ref $node_parsed_objects[0]) { unless ($class_options->{'again-again'}) { # Remove $class from $node's class list, lest we pick it up again # in the next giant loop! my $new_class_attr = $node->getAttribute('class'); $new_class_attr =~ s/\b($class)\b//; $node->setAttribute('class', $new_class_attr); $node->removeAttribute('class') unless $new_class_attr; } # If $type contains '**' then allow #
#

#

#
foreach my $p (@node_parsed_objects) { next unless ref $p; # Record parent property node in case we need it (hResume does)! $p->{'parent_property_node'} = $node; push @parsed_objects, $p; last unless $type =~ /\*\*/; } } } # What key should we use to store everything in $self? my $object_key = $class; $object_key = $class_options->{'use-key'} if defined $class_options->{'use-key'}; # Actually do the storing! if ($type =~ /[1\?]/ && !defined $self->{'DATA'}->{$object_key}) { $self->{'DATA'}->{$object_key} = $parsed_objects[0] if @parsed_objects; $self->{'DATA_'}->{$object_key} = $parsed_objects[0]->{'parent_property_node'} if @parsed_objects && $type =~ /\_simple_parse_found_error('W', "$class is singular, but multiple instances found. Only the first one will be used.") if defined $parsed_objects[1]; } else { foreach my $value (@parsed_objects) { push @{ $self->{'DATA'}->{$object_key} }, $value; push @{ $self->{'DATA_'}->{$object_key} }, $parsed_objects[0]->{'parent_property_node'} if $type =~ /\_destroyer($root, 'hmeasure', 'hangle', 'hmoney', @{ $options->{'no-destroy'} }); # hmeasure, and destroy each, unless saved by $options->{'no-destroy'}! my $do_destroy = { 'hmeasure' => 1, 'hangle' => 1, 'hmoney' => 1 }; foreach my $root (@{ $options->{'no-destroy'} }) { $do_destroy->{$root} = 0; } # embedded hmeasure if (defined $options->{'hmeasure'}) { my @measures = HTML::Microformats::Format::hMeasure->extract_all($root, $self->context); foreach my $m (@measures) { push @{ $self->{$options->{'hmeasure'}} }, $m unless defined $m->data->{'item'} || defined $m->data->{'item_link'} || defined $m->data->{'item_label'}; $self->destroy_element($m->{'element'}) if $do_destroy->{ $m->data->{'class'} } && defined $m->{'element'}; } } # embedded rel-tag if (defined $options->{'rel-tag'}) { my $key = $options->{'rel-tag'}; my @tags = HTML::Microformats::Format::RelTag->extract_all($root, $self->context); push @{ $self->{'DATA'}->{$key} }, @tags if @tags; } # embedded rel-license if (defined $options->{'rel-license'}) { my $key = $options->{'rel-license'}; my @licences = HTML::Microformats::Format::RelLicense->extract_all($root, $self->context); push @{ $self->{'DATA'}->{$key} }, @licences if @licences; } # embedded rel-enclosure if (defined $options->{'rel-enclosure'}) { my $key = $options->{'rel-enclosure'}; my @encs = HTML::Microformats::Format::RelEnclosure->extract_all($root, $self->context); push @{ $self->{'DATA'}->{$key} }, @encs if @encs; } # For each of the classes that we're looking for... foreach my $c (@$classes) { my $class = $c->[0]; my $type = $c->[1]; my $class_options = $c->[2] || {}; # We've already processed embedded microformats. next if $type =~ /m/; # These properties are too complex for _simple_parse. next if $type =~ /#/; my @matching_nodes = $self->_matching_nodes($class, $type, $root); # Parse each node that matched. my @parsed_values; my @parsed_values_nodes; my @parsed_values_alternatives; foreach my $node (@matching_nodes) { # Jump out of the loop if we were only expecting a single value and # have already found it! if ($type =~ /[1\?]/ && defined $parsed_values[0]) { $self->_simple_parse_found_error('W', "$class is singular, but multiple instances found. Only the first one will be used."); last; } # Avoid conflicts between rel=tag and class=category. next if (($class eq $options->{'rel-tag'}) && ($node->getAttribute('rel') =~ /\b(tag)\b/i)); # Ditto rel=license and class=license. next if (($class eq $options->{'rel-license'}) && ($node->getAttribute('rel') =~ /\b(license)\b/i)); # Ditto rel=enclosure and class=attach. next if (($class eq $options->{'rel-enclosure'}) && ($node->getAttribute('rel') =~ /\b(enclosure)\b/i)); # Parse URL types my ($u, $u_element); if ($type =~ /(u|U|MM)/) { my @value_elements; @value_elements = searchClass('value', $node) unless $type=~/v/; unshift @value_elements, $node; ELEMENT: foreach my $v (@value_elements) { if (defined $link_elements->{lc $v->tagName}) { ATTR: foreach my $attr (@{ $link_elements->{lc $v->tagName} }) { if (length $v->getAttribute($attr)) { $u = $v->getAttribute($attr); $u_element = $v; last ELEMENT; } } } if ($type =~ /U/ && length $v->getAttribute('id')) { $u = '#'.$v->getAttribute('id'); $u_element = $v; last ELEMENT; } } if (defined $u) { if ($type =~ /MM/) { ##TODO: post-0.001 die "Not implemented!"; # my $px = { uri => $page->uri($u) }; # bless $px, "Swignition::uF::Pseudo"; # push @parsed_values, $px; } else { push @parsed_values, $page->uri($u); } push @parsed_values_nodes, $node; if (length $options->{'rel-me'} && $u_element->getAttribute('rel') =~ /\b(me)\b/i) { $self->{'DATA'}->{$options->{'rel-me'}}++; } next; } else { push @parsed_values, $self->_stringify($node, { 'excerpt-class' => ($type=~/v/?undef:'value'), 'value-title' => defined $class_options->{'value-title'} ? $class_options->{'value-title'} : (($type=~/[Ddei]/ && $type!~/v/) ? 'allow' : undef), 'abbr-pattern' => 1, }); push @parsed_values_nodes, $node; next; } } # Extract text (and if needed, XML) string from node. if ($type =~ /H/) { push @parsed_values, $self->_stringify($node, ($type=~/v/?undef:'value')); push @parsed_values_alternatives, $self->_xml_stringify($node, undef, $class_options->{'include-self'}); push @parsed_values_nodes, $node; } elsif ($type =~ /h/) { push @parsed_values, $self->_xml_stringify($node, undef, $class_options->{'include-self'}); push @parsed_values_nodes, $node; } elsif ($type =~ /d/) { push @parsed_values, $self->_stringify($node, { 'value-title' => defined $class_options->{'value-title'} ? $class_options->{'value-title'} : (($type=~/[Ddei]/ && $type!~/v/) ? 'allow' : undef), 'excerpt-class' => ($type=~/v/?undef:'value'), 'abbr-pattern' => 1, 'datetime' => 1, 'joiner' => ' ', 'datetime-feedthrough' => defined $class_options->{'datetime-feedthrough'} ? $self->{'DATA'}->{ $class_options->{'datetime-feedthrough'} } : undef, }); push @parsed_values_nodes, $node; } elsif ($type =~ /u/) { push @parsed_values, $page->uri($self->_stringify($node, ($type=~/v/?undef:'value'))); push @parsed_values_nodes, $node; } else { push @parsed_values, $self->_stringify($node, { 'excerpt-class' => ($type=~/v/?undef:'value'), 'value-title' => defined $class_options->{'value-title'} ? $class_options->{'value-title'} : (($type=~/[Ddei]/ && $type!~/v/) ? 'allow' : undef), 'abbr-pattern' => 1, }); push @parsed_values_nodes, $node; } } # Now we have parsed values in @parsed_values. Sometimes these need to be # concatenated. if ($type =~ /\&/) { my $joiner = ($type =~ /u/i) ? ' ' : ''; $joiner = $class_options->{'concatenate-with'} if defined $class_options->{'concatenate-with'}; if (@parsed_values) { my $value = join $joiner, @parsed_values; @parsed_values = ($value); } if (@parsed_values_alternatives) { my $value = join $joiner, @parsed_values_alternatives; @parsed_values_alternatives = ($value); } } # Check which values are acceptable. my @acceptable_values; my @acceptable_values_nodes; for (my $i=0; defined $parsed_values[$i]; $i++) { my $value = $parsed_values[$i]; # Check date values are OK if ($type =~ /d/) { $value = HTML::Microformats::Datatype::DateTime->parse($value); if ($value) { if ($parsed_values_nodes[$i]->getAttribute('class') =~ /\b(approx)\b/) { $value->{datatype} = 'http://dbpedia.org/resource/Approximation'; } else { my @approx = searchClass('approx', $parsed_values_nodes[$i]); $value->{datatype} = 'http://dbpedia.org/resource/Approximation' if @approx; } push @acceptable_values, $value; push @acceptable_values_nodes, $parsed_values_nodes[$i]; next; } } # Check durations are OK elsif ($type =~ /D/) { my $D = undef; if (HTML::Microformats::Datatype::String::isms($value)) { $D = HTML::Microformats::Datatype::Duration->parse($value->{string}, $value->{dom}, $page) } else { $D = HTML::Microformats::Datatype::Duration->parse($value, undef, $page) } if (defined $D) { push @acceptable_values, $D; push @acceptable_values_nodes, $parsed_values_nodes[$i]; } else { $self->_simple_parse_found_error('E', "$class could not be parsed as a duration."); } next; } # Check intervals are OK elsif ($type =~ /i/) { my $D; if (HTML::Microformats::Datatype::String::isms($value)) { $D = HTML::Microformats::Datatype::Interval->parse($value->{string}, $value->{dom}, $page) } else { $D = HTML::Microformats::Datatype::Interval->parse($value, undef, $page) } if ($D) { push @acceptable_values, $D; push @acceptable_values_nodes, $parsed_values_nodes[$i]; } else { $self->_simple_parse_found_error('E', "$class could not be parsed as an interval."); } next; } # Check intervals are OK elsif ($type =~ /e/) { my $D; if (HTML::Microformats::Datatype::String::isms($value)) { $D = HTML::Microformats::Datatype::RecurringDateTime->parse($value->{string}, $value->{dom}, $page) } else { $D = HTML::Microformats::Datatype::RecurringDateTime->parse($value, undef, $page) } if ($D) { push @acceptable_values, $D; push @acceptable_values_nodes, $parsed_values_nodes[$i]; } else { $self->_simple_parse_found_error('E', "$class could not be parsed as an interval."); } next; } # Everything else we won't bother to check if it's OK. else { push @acceptable_values, $value; push @acceptable_values_nodes, $parsed_values_nodes[$i]; next; } } # What key should we use to store everything in $self? my $object_key = $class; $object_key = $class_options->{'use-key'} if (defined $class_options->{'use-key'}); # Actually do the storing! if ($type =~ /[1\?\&]/ && !defined $self->{$object_key}) { $self->{'DATA'}->{$object_key} = $acceptable_values[0] if @acceptable_values; $self->{'DATA_'}->{$object_key} = $acceptable_values_nodes[0] if @acceptable_values && $type =~ /\{'DATA'}->{$object_key} }, $acceptable_values[$i]; push @{ $self->{'DATA_'}->{$object_key} }, $acceptable_values_nodes[$i] if ($type =~ /\{$object_key}) { $self->_simple_parse_found_error('E', "$class is required, but no acceptable value was found."); } # Store HTML values too! if ($type =~ /H/) { if ($type =~ /[1\?\&]/ && defined $parsed_values_alternatives[0]) { $self->{'DATA'}->{'html_'.$object_key} = $parsed_values_alternatives[0]; } else { foreach my $value (@parsed_values_alternatives) { push @{ $self->{'DATA'}->{'html_'.$object_key} }, $value; } } } # for classes called 'uid', special handling. if ($class eq 'uid' and !defined $self->{'DATA'}->{$object_key}) { if ($root->hasAttribute('id') and length $root->getAttribute('id')) { $self->{'DATA'}->{$object_key} = $self->context->uri('#'.$root->getAttribute('id')); } } } } sub _stringify { my $self = shift; return HTML::Microformats::Utilities::stringify(@_); } sub _xml_stringify { my $self = shift; return HTML::Microformats::Utilities::xml_stringify(@_); } 1; __END__ =head1 NAME HTML::Microformats::Mixin::Parser - microformat parsing mixin =head1 DESCRIPTION HTML::Microformats::Mixin::Parser implements a number of private methods that take care of the bulk of parsing complex, compound microformats. Many of the individual microformat modules multi-inherit from this. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2010 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Mixin/RDF.pm0000644000076400007640000001040211775403507021074 0ustar taitaipackage HTML::Microformats::Mixin::RDF; use strict qw(subs vars); no warnings; use 5.010; use Encode qw(encode); use RDF::Trine; use Scalar::Util qw(); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Mixin::RDF::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Mixin::RDF::VERSION = '0.105'; } sub _simple_rdf { my $self = shift; my $model = shift; my $id = $self->id(1); return if $self->{'already_added'}->{"$model"}; $self->{'already_added'}->{"$model"}++; foreach my $rdftype (@{ $self->format_signature->{'rdf:type'} }) { $model->add_statement(RDF::Trine::Statement->new( $id, RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new($rdftype), )); } KEY: foreach my $key (sort keys %{ $self->format_signature->{'rdf:property'} }) { my $rdf = $self->format_signature->{'rdf:property'}->{$key}; next KEY unless defined $self->data->{$key}; my $vals = $self->data->{$key}; $vals = [$vals] unless ref $vals eq 'ARRAY'; foreach my $val (@$vals) { my $can_id = Scalar::Util::blessed($val) && $val->can('id'); my $seems_bnode = ($val =~ /^_:\S+$/); my $seems_uri = ($val =~ /^[a-z0-9\.\+\-]{1,20}:\S+$/); if ((defined $rdf->{'resource'}||defined $rdf->{'rev'}) && ($can_id || $seems_uri || $seems_bnode)) { my $val_node = undef; if ($can_id) { $val_node = $val->id(1); } else { $val_node = ($val =~ /^_:(.*)$/) ? RDF::Trine::Node::Blank->new($1) : RDF::Trine::Node::Resource->new($val); } foreach my $prop (@{ $rdf->{'resource'} }) { $model->add_statement(RDF::Trine::Statement->new( $id, RDF::Trine::Node::Resource->new($prop), $val_node )); } foreach my $prop (@{ $rdf->{'rev'} }) { $model->add_statement(RDF::Trine::Statement->new( $val_node, RDF::Trine::Node::Resource->new($prop), $id )); } if ($can_id and Scalar::Util::blessed($val) and $val->can('add_to_model')) { $val->add_to_model($model); } } elsif (defined $rdf->{'literal'} and !$can_id) { foreach my $prop (@{ $rdf->{'literal'} }) { $model->add_statement(RDF::Trine::Statement->new( $id, RDF::Trine::Node::Resource->new($prop), $self->_make_literal($val, $rdf->{'literal_datatype'}), )); } } } } } sub _make_literal { my ($self, $val, $dt) = @_; if (Scalar::Util::blessed($val) and $val->can('to_string') and $val->can('datatype')) { return RDF::Trine::Node::Literal->new( encode('utf8', $val->to_string), undef, $val->datatype); } elsif (Scalar::Util::blessed($val) and $val->can('to_string') and $val->can('lang')) { return RDF::Trine::Node::Literal->new( encode('utf8', $val->to_string), $val->lang); } else { if (defined $dt and length $dt and $dt !~ /:/) { $dt = 'http://www.w3.org/2001/XMLSchema#'.$dt; } if ($dt eq 'http://www.w3.org/2001/XMLSchema#integer') { $val = int $val; } return RDF::Trine::Node::Literal->new(encode('utf8', $val), undef, $dt); } } 1; __END__ =head1 NAME HTML::Microformats::Mixin::RDF - RDF output mixin =head1 DESCRIPTION HTML::Microformats::Mixin::RDF provides some utility code for microformat modules to more easily output RDF. It includes methods C<_simple_rdf> which takes an RDF::Trine model as a parameter and adds some basic triples to it based on the object's format signature; and C<_make_literal> taking either a string plus datatype as parameters, or any of the HTML::Microformats::Datatype objects, returning an RDF::Trine::Node::Literal. HTML::Microformats::Format inherits from this module, so by extension, all the microformat modules do too. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2010 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype.pm0000644000076400007640000000353111775403507021155 0ustar taitaipackage HTML::Microformats::Datatype; use HTML::Microformats::Datatype::DateTime; use HTML::Microformats::Datatype::Duration; use HTML::Microformats::Datatype::Interval; use HTML::Microformats::Datatype::RecurringDateTime; use HTML::Microformats::Datatype::String; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::VERSION = '0.105'; } 1; __END__ =head1 NAME HTML::Microformats::Datatype - representations of literal values =head1 DESCRIPTION Many places you'd expect a Perl scalar to appear, e.g.: $my_hcard->get_fn; What you actually get returned is an object from one of the Datatype modules. Why? Because using a scalar loses information. For example, most strings have associated language information (from HTML lang and xml:lang attributes). Using an object allows this information to be kept. The Datatype modules overload stringification, which means that for the most part, you can use them as strings (subjecting them to regular expressions, concatenating them, printing them, etc) and everything will work just fine. But they're not strings. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L. L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/0000755000076400007640000000000011775404022020263 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Format/hReviewAggregate.pm0000644000076400007640000001101211775403507024043 0ustar taitai=head1 NAME HTML::Microformats::Format::hReviewAggregate - the hReview-aggregate microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hReviewAggregate; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @reviews = HTML::Microformats::Format::hReviewAggregate->extract_all( $dom->documentElement, $context); foreach my $review (@reviews) { print Dumper($review->data) . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hReviewAggregate inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hReviewAggregate; use base qw(HTML::Microformats::Format::hReview); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify searchClass); use HTML::Microformats::Format::hReview::rating; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hReviewAggregate::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hReviewAggregate::VERSION = '0.105'; } sub new { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.holder' => $context->make_bnode , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $self->_fallback_item($clone)->_auto_detect_type; $self->{'DATA'}->{'rating'} = [ HTML::Microformats::Format::hReview::rating->extract_all($clone, $context) ]; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $self = shift; my $rev = 'http://www.purl.org/stuff/rev#'; my $hreview = 'http://ontologi.es/hreview#'; my $rv = { 'root' => 'hreview-aggregate', 'classes' => [ ['item', 'm1', {'embedded'=>'hProduct hAudio hEvent hCard'}], # lowercase 'm' = don't try plain string. ['summary', '1'], ['type', '?'], ['bookmark', 'ru?', {'use-key'=>'permalink'}], ['description', 'H*'], ['rating', '*#'], ['count', 'n?'], ['votes', 'n?'], ], 'options' => { 'rel-tag' => 'tag', 'rel-license' => 'license', }, 'rdf:type' => ["${hreview}Aggregate"] , 'rdf:property' => { 'description' => { 'literal' => ["${rev}text"] }, 'type' => { 'literal' => ["${rev}type"] }, 'summary' => { 'literal' => ["${rev}title", "http://www.w3.org/2000/01/rdf-schema#label"] }, 'rating' => { 'resource' => ["${hreview}rating"] }, 'tag' => { 'resource' => ['http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] }, 'license' => { 'resource' => ["http://www.iana.org/assignments/relation/license", "http://creativecommons.org/ns#license"] }, 'permalink' => { 'resource' => ["http://www.iana.org/assignments/relation/self"] }, 'count' => { 'literal' => ["${hreview}count"] }, 'votes' => { 'literal' => ["${hreview}votes"] }, }, }; return $rv; } sub profiles { my $class = shift; return qw(http://microformats.org/wiki/hreview-aggregate); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hReviewAggregate supports hReview-aggregate 0.2 as described at L with the following differences: =over 4 =item * hAudio hAudio microformats can be used as the reviewed item. =item * hReview properties A few properties are supported from (non-aggregate) hReview - e.g. 'bookmark', 'tag', 'description' and 'type'. =back =head1 RDF OUTPUT L, L. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hNews.pm0000644000076400007640000001215211775403507021715 0ustar taitai=head1 NAME HTML::Microformats::Format::hNews - the hNews microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hNews; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::hNews->extract_all( $dom->documentElement, $context); foreach my $article (@objects) { printf("%s %s\n", $article->get_link, $article->get_dateline); } =head1 DESCRIPTION HTML::Microformats::Format::hNews inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hNews; use base qw(HTML::Microformats::Format::hEntry); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass); use HTML::Microformats::Format::hCard; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hNews::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hNews::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $self->_hentry_parse; # hNews has a source-org which is probably an hCard. $self->_source_org_fallback($clone); $self->{'DATA'}->{'class'} = 'hnews'; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _source_org_fallback { my ($self, $clone) = @_; unless (@{ $self->{'DATA'}->{'source-org'} }) { ##TODO: Should really only use the nearest-in-parent. post-0.001 my @so_elements = searchClass('source-org', $self->context->document->documentElement); foreach my $so (@so_elements) { next unless $so->getAttribute('class') =~ /\b(vcard)\b/; push @{ $self->{'DATA'}->{'source-org'} }, HTML::Microformats::Format::hCard->new($so, $self->context); } } } sub format_signature { my $rv = HTML::Microformats::Format::hEntry->format_signature; $rv->{'root'} = 'hnews'; push @{ $rv->{'classes'} }, ( ['source-org', 'm?', {embedded=>'hCard'}], ['dateline', 'M?', {embedded=>'hCard adr'}], ['geo', 'm*', {embedded=>'geo'}], ['item-license', 'ur*'], ['principles', 'ur*'], ); my $hnews = 'http://ontologi.es/hnews#'; my $iana = 'http://www.iana.org/assignments/relation/'; # $rv->{'rdf:property'}->{'source-org'}->{'resource'} = ["${hnews}source-org"]; # $rv->{'rdf:property'}->{'dateline'}->{'resource'} = ["${hnews}dateline"]; $rv->{'rdf:property'}->{'dateline'}->{'literal'} = ["${hnews}dateline-literal"]; # $rv->{'rdf:property'}->{'geo'}->{'resource'} = ["${hnews}geo"]; $rv->{'rdf:property'}->{'item-license'}->{'resource'} = ["${iana}license", "http://creativecommons.org/ns#license"]; $rv->{'rdf:property'}->{'principles'}->{'resource'} = ["${hnews}principles"]; return $rv; } sub add_to_model { my $self = shift; my $model = shift; my $hnews = 'http://ontologi.es/hnews#'; $self->SUPER::add_to_model($model); if ($self->_isa($self->data->{'source-org'}, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hnews}source-org"), $self->data->{'source-org'}->id(1, 'holder'), )); } if ($self->_isa($self->data->{'dateline'}, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hnews}dateline"), $self->data->{'source-org'}->id(1, 'holder'), )); } foreach my $geo (@{ $self->data->{'geo'} }) { if ($self->_isa($geo, 'HTML::Microformats::Format::geo')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hnews}geo"), $geo->id(1, 'location'), )); } } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/hNews/0.1/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hNews supports hNews as described at L. =head1 RDF OUTPUT hNews is an extension of hAtom; data is returned using the same vocabularies as hAtom, with additional news-specific terms from L. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/RelLicense.pm0000644000076400007640000000615511775403507022664 0ustar taitai=head1 NAME HTML::Microformats::Format::RelLicense - the rel-license microformat =head1 SYNOPSIS my @licences = HTML::Microformats::Format::RelLicense->extract_all( $doc->documentElement, $context); foreach my $licence (@licences) { print $licence->get_href . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::RelLicense inherits from HTML::Microformats::Format_Rel. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::RelLicense; use base qw(HTML::Microformats::Format_Rel); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::RelLicense::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::RelLicense::VERSION = '0.105'; } sub format_signature { return { 'rel' => 'license' , 'classes' => [ ['href', '1#'] , ['label', '1#'] , ['title', '1#'] , ] , 'rdf:type' => [] , 'rdf:property' => {} , } } sub profiles { return qw(http://microformats.org/profile/rel-license http://ufs.cc/x/rel-license http://microformats.org/profile/specs http://ufs.cc/x/specs http://purl.org/uF/rel-license/1.0/ http://purl.org/uF/2008/03/); } sub add_to_model { my $self = shift; my $model = shift; $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("http://creativecommons.org/ns#Work"), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->data->{'href'}), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("http://creativecommons.org/ns#License"), )); foreach my $uri (qw(http://creativecommons.org/ns#license http://www.w3.org/1999/xhtml/vocab#license http://purl.org/dc/terms/license)) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new($uri), RDF::Trine::Node::Resource->new($self->data->{'href'}), )); } return $self; } 1; =head1 MICROFORMAT HTML::Microformats::Format::RelLicense supports rel-license as described at L. =head1 RDF OUTPUT Data is returned using the Creative Commons vocabulary (L) and occasional other terms. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/0000755000076400007640000000000011775404022021304 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/n.pm0000644000076400007640000000514411775403507022112 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::n - helper for hCards; handles the n property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::n; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Format::hCard; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::n::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::n::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); return $self; } sub format_signature { my $self = shift; my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $vx = 'http://buzzword.org.uk/rdf/vcardx#'; return { 'root' => 'n', 'classes' => [ ['additional-name', '*'], ['family-name', '*'], ['given-name', '*'], ['honorific-prefix', '*'], ['honorific-suffix', '*'], ['initial', '*'], # extension ], 'options' => { 'no-destroy' => ['adr', 'geo'] }, 'rdf:type' => ["${vcard}Name"] , 'rdf:property' => { 'additional-name' => { 'literal' => ["${vcard}additional-name"] } , 'family-name' => { 'literal' => ["${vcard}family-name"] } , 'given-name' => { 'literal' => ["${vcard}given-name"] } , 'honorific-prefix' => { 'literal' => ["${vcard}honorific-prefix"] } , 'honorific-suffix' => { 'literal' => ["${vcard}honorific-suffix"] } , 'honorific-initial' => { 'literal' => ["${vx}initial"] } , }, }; } sub profiles { return HTML::Microformats::Format::hCard::profiles(@_); } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/impp.pm0000644000076400007640000000234411775403507022621 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::impp - helper for hCards; handles the impp property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format::hCard::TypedField, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::impp; use base qw(HTML::Microformats::Format::hCard::TypedField); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::impp::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::impp::VERSION = '0.105'; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/TypedField.pm0000644000076400007640000001012411775403507023700 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::TypedField - helper for hCards; handles value plus type properties =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::TypedField; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Format::hCard; use HTML::Microformats::Utilities qw(searchClass stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::TypedField::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::TypedField::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $hclass = 'tel'; $hclass = $1 if $class =~ /::([^:]+)$/; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); unless (length $self->{'DATA'}->{'value'} or $hclass eq 'label') { if ($element->hasAttribute('href')) { $self->{'DATA'}->{'value'} = $self->context->uri( $element->getAttribute('href') ); } elsif ($element->hasAttribute('src')) { $self->{'DATA'}->{'value'} = $self->context->uri( $element->getAttribute('src') ); } } unless (length $self->{'DATA'}->{'value'}) { my @types = searchClass('type', $clone); foreach my $type (@types) { $type->parentNode->removeChild($type); } $self->{'DATA'}->{'value'} = stringify($clone, {'value-title'=>'allow'}); $self->{'DATA'}->{'value'} =~ s/(^\s+|\s+$)//g; } $self->_fix_value_uri; return $self; } sub _fix_value_uri { my $self = shift; # no-op. override in descendent classes. } sub format_signature { my $self = shift; my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $vx = 'http://buzzword.org.uk/rdf/vcardx#'; my $package = $self; $package = ref $package if ref $package; my $hclass = 'tel'; $hclass = $1 if $package =~ /::([^:]+)$/; my $u = $hclass =~ m'^(tel|email)$'i ? 'u' : ''; return { 'root' => $hclass, 'classes' => [ ['type', '*', {'value-title'=>'allow'}], ['value', '&v'.$u, {'value-title'=>($hclass eq 'tel' ? 'allow' : undef)}], ], 'options' => { 'no-destroy' => ['adr', 'geo'] }, 'rdf:type' => [ (($hclass =~ /^(tel|email|label)$/) ? $vcard : $vx).ucfirst $hclass ] , 'rdf:property' => { 'type' => { 'literal' => ["${vx}usage"] } , 'value' => { 'literal' => ["http://www.w3.org/1999/02/22-rdf-syntax-ns#value"] , 'resource' => ["http://www.w3.org/1999/02/22-rdf-syntax-ns#value"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my @types; foreach my $type (@{ $self->data->{'type'} }) { if ($type =~ /^(dom|home|intl|parcel|postal|pref|work|video|x400|voice|PCS|pager|msg|modem|ISDN|internet|fax|cell|car|BBS)$/i) { my $canon = ucfirst lc $1; $canon = uc $canon if $canon=~ /(pcs|bbs|isdn)/i; push @types, { 'value' => 'http://www.w3.org/2006/vcard/ns#'.$canon, 'type' => 'uri', }; } } if (@types) { $model->add_hashref({ $self->id => { 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' => \@types } }); } return $self; } sub profiles { return HTML::Microformats::Format::hCard::profiles(@_); } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/tel.pm0000644000076400007640000000370611775403507022443 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::tel - helper for hCards; handles the tel property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format::hCard::TypedField, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::tel; use base qw(HTML::Microformats::Format::hCard::TypedField); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::tel::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::tel::VERSION = '0.105'; } sub _fix_value_uri { my $self = shift; my $uri; return if $self->{'DATA'}->{'value'} =~ /^(tel|modem|fax):\S+$/i; my $number = $self->{'DATA'}->{'value'}; $number =~ s/[^\+\*\#x0-9]//gi; ($number, my $extension) = split /x/i, $number, 2; if ($number =~ /^\+/ and $number !~ /[\*\#]/) # global number { if (length $extension) { $uri = sprintf('tel:%s;ext=%s', $number, $extension); } else { $uri = sprintf('tel:%s', $number); } } else #local number { if (length $extension) { $uri = sprintf('tel:%s;ext=%s;phone-context=localhost.localdomain', $number, $extension); } else { $uri = sprintf('tel:%s;phone-context=localhost.localdomain', $number); } } $self->{'DATA'}->{'value'} = $uri; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/email.pm0000644000076400007640000000313311775403507022740 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::email - helper for hCards; handles the email property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format::hCard::TypedField, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::email; use base qw(HTML::Microformats::Format::hCard::TypedField); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::email::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::email::VERSION = '0.105'; } sub _fix_value_uri { my $self = shift; return if $self->{'DATA'}->{'value'} =~ /^(mailto):\S+\@\S+$/i; # I only know how to fix SMTP addresses... return unless $self->{'DATA'}->{'value'} =~ /.+\@.+/i; my $email = $self->{'DATA'}->{'value'}; $email =~ s/\s//g; $email = "mailto:$email" unless $email =~ /^mailto:/i; $self->{'DATA'}->{'value'} = $email; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/org.pm0000644000076400007640000000624011775403507022442 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::org - helper for hCards; handles the org property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::org; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Format::hCard; use HTML::Microformats::Utilities qw(stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::org::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::org::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); if ($self->element->getAttribute('class') =~ /\b(org)\b/) { unless (defined $self->data->{'organization-name'} or defined $self->data->{'organization-unit'} or defined $self->data->{'x-vat-number'} or defined $self->data->{'x-charity-number'} or defined $self->data->{'x-company-number'}) { $self->{'DATA'}->{'organization-name'} = stringify($clone, 'value'); } } return $self; } sub format_signature { my $self = shift; my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $vx = 'http://buzzword.org.uk/rdf/vcardx#'; return { 'root' => 'org', 'classes' => [ ['organization-name', '?'], ['organization-unit', '*'], ['x-vat-number', '?'], ['x-charity-number', '?'], ['x-company-number', '?'], ['vat-number', '?', {'use-key'=>'x-vat-number'}], ['charity-number', '?', {'use-key'=>'x-charity-number'}], ['company-number', '?', {'use-key'=>'x-company-number'}], ], 'options' => { 'no-destroy' => ['adr', 'geo'] }, 'rdf:type' => ["${vcard}Organization"] , 'rdf:property' => { 'organization-name' => { 'literal' => ["${vcard}organization-name"] } , 'organization-unit' => { 'literal' => ["${vcard}organization-unit"] } , 'x-vat-number' => { 'literal' => ["${vx}x-vat-number"] } , 'x-charity-number' => { 'literal' => ["${vx}x-charity-number"] } , 'x-company-number' => { 'literal' => ["${vx}x-company-number"] } , }, }; } sub profiles { return HTML::Microformats::Format::hCard::profiles(@_); } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard/label.pm0000644000076400007640000000235111775403507022731 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard::label - helper for hCards; handles the label property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format::hCard::TypedField, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hCard::label; use base qw(HTML::Microformats::Format::hCard::TypedField); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::label::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::label::VERSION = '0.105'; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/XOXO.pm0000644000076400007640000002725311775403507021436 0ustar taitai=head1 NAME HTML::Microformats::Format::XOXO - the XOXO microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::XOXO; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::XOXO->extract_all( $dom->documentElement, $context); my $list = $objects[0]; # Let's assume this structure: # #
    #
  1. # Toby Inkster #
    #
    Eye colour
    #
    Blue #
    Hair colour
    #
    Blonde #
    Brown #
    #
    2. #
print $list->data->as_array->[0]->get_link_title; # Toby Inkster print $list->data->as_array->[0]->get_properties ->get_value('Eye colour')->[0]; # Blue print join '-', $list->data->as_array->[0] ->get_value('Hair colour'); # Blonde-Brown =head1 DESCRIPTION HTML::Microformats::Format::XOXO inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. Unlike most of the modules in the HTML::Microformats suite, the C method returns an HTML::Microformats::Format::XOXO::UL, HTML::Microformats::Format::XOXO::OL or HTML::Microformats::Format::XOXO::DL object, rather than a plain hashref. =cut package HTML::Microformats::Format::XOXO; use base qw(HTML::Microformats::Format); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify xml_stringify); use JSON qw/to_json/; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::XOXO::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::XOXO::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , }; bless $self, $class; if ($element->hasAttribute('id') && length $element->getAttribute('id')) { $self->{'id'} = $context->uri('#' . $element->getAttribute('id')); } else { $self->{'id'} = $context->make_bnode($element); } return undef unless $element->localname =~ /^[DOU]L$/i; $self->{'DATA'} = $self->_parse_list($element->cloneNode(1)); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _parse_list { my ($self, $e) = @_; if (lc $e->localname eq 'ul') { return HTML::Microformats::Format::XOXO::UL->parse($e, $self); } elsif (lc $e->localname eq 'ol') { return HTML::Microformats::Format::XOXO::OL->parse($e, $self); } elsif (lc $e->localname eq 'dl') { return HTML::Microformats::Format::XOXO::DL->parse($e, $self); } return undef; } sub format_signature { return { 'root' => 'xoxo', 'classes' => [], 'options' => {}, 'rdf:type' => [] , 'rdf:property' => {}, }; } sub add_to_model { my $self = shift; my $model = shift; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://purl.org/dc/dcmitype/Dataset'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://open.vocab.org/terms/json'), $self->_make_literal( to_json($self, {canonical=>1,convert_blessed=>1}) ), )); return $self; } sub profiles { return qw(http://microformats.org/profile/xoxo http://ufs.org/x/xoxo http://microformats.org/profile/specs http://ufs.org/x/specs http://purl.org/uF/2008/03/); } 1; package HTML::Microformats::Format::XOXO::AbstractList; use strict qw(subs vars); no warnings; use 5.010; sub parse { my ($class, $e, $xoxo) = @_; my @items; foreach my $li ($e->getChildrenByTagName('li')) { push @items, HTML::Microformats::Format::XOXO::LI->parse($li, $xoxo); } bless \@items, $class; } sub TO_JSON { return [ @{$_[0]} ]; } sub as_array { my ($self) = @_; return wantarray ? @$self : $self; } 1; =head2 HTML::Microformats::Format::XOXO::DL Represents an HTML DL element. =over 4 =item C<< $dl->get_values($key) >> Treating a DL as a key-value structure, returns a list of values for a given key. Each value is an HTML::Microformats::Format::XOXO::DD object. =item C<< $dl->as_hash >> Returns a hash of keys pointing to arrayrefs of values, where each value is an HTML::Microformats::Format::XOXO::DD object. =item C<< $dl->as_array >> Logically what you think get_values("*") might do. =back =cut package HTML::Microformats::Format::XOXO::DL; use base qw[HTML::Microformats::Format::XOXO::AbstractList]; use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify xml_stringify); sub parse { my ($class, $e, $xoxo) = @_; my $dict = {}; my $term; foreach my $kid ($e->childNodes) { next unless $kid->isa('XML::LibXML::Element'); if ($kid->localname =~ /^DT$/i) { $term = stringify($kid); if ($kid->hasAttribute('id')) { $dict->{$term}->{'id'} = $kid->getAttribute('id'); } } elsif (defined $term) { push @{ $dict->{$term}->{'items'} }, HTML::Microformats::Format::XOXO::DD->parse($kid, $xoxo); } } bless $dict, $class; } sub TO_JSON { my $self = shift; my $rv = {}; while (my ($k, $v) = each %$self) { $rv->{$k} = $v->{'items'}; } return $rv; } sub get_values { my ($self, $key) = @_; return wantarray ? @{ $self->{$key}->{'items'} } : $self->{$key}->{'items'} if defined $self->{$key}->{'items'}; } sub as_hash { my ($self) = @_; return $self->TO_JSON; } sub as_array { my ($self, $key) = @_; my @rv; foreach my $key (sort keys %$self) { push @rv, @{ $self->{$key}->{'items'} }; } return wantarray ? @rv : \@rv; } 1; =head2 HTML::Microformats::Format::XOXO::UL Represents an HTML UL element. =over 4 =item C<< $ul->as_array >> Returns an array of values, where each is a HTML::Microformats::Format::XOXO::LI object. =back =cut package HTML::Microformats::Format::XOXO::UL; use base qw(HTML::Microformats::Format::XOXO::AbstractList); use strict qw(subs vars); no warnings; use 5.010; 1; =head2 HTML::Microformats::Format::XOXO::OL Represents an HTML OL element. =over 4 =item C<< $ol->as_array >> Returns an array of values, where each is a HTML::Microformats::Format::XOXO::LI object. =back =cut package HTML::Microformats::Format::XOXO::OL; use base qw(HTML::Microformats::Format::XOXO::AbstractList); use strict qw(subs vars); no warnings; use 5.010; 1; package HTML::Microformats::Format::XOXO::AbstractListItem; use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify xml_stringify); our $for_get_them_not = 'a|dl|li|ol|ul'; sub parse { my ($class, $e, $xoxo) = @_; my $self = bless {}, $class; my $a = $self->_get_them($e, 'a'); my $dl = $self->_get_them($e, 'dl'); my $l = $self->_get_them($e, 'ol|ul'); if ($a) { $self->{'url'} = $xoxo->context->uri($a->getAttribute('href')) if $a->hasAttribute('href'); $self->{'type'} = $a->getAttribute('type') if $a->hasAttribute('type'); $self->{'rel'} = $a->getAttribute('rel') if $a->hasAttribute('rel'); $self->{'title'} = $a->getAttribute('title') || stringify($a); } if ($dl) { $self->{'properties'} = HTML::Microformats::Format::XOXO::DL->parse($dl, $xoxo); $dl->parentNode->removeChild($dl); } if (defined $l && lc $l->localname eq 'ul') { $self->{'children'} = HTML::Microformats::Format::XOXO::UL->parse($l, $xoxo); $l->parentNode->removeChild($l); } elsif (defined $l && lc $l->localname eq 'ol') { $self->{'children'} = HTML::Microformats::Format::XOXO::OL->parse($l, $xoxo); $l->parentNode->removeChild($l); } $self->{'text'} = stringify($e); $self->{'html'} = xml_stringify($e); return $self; } sub _get_them { my ($self, $e, $pattern) = @_; my @rv; my @check = $e->childNodes; while (@check) { my $elem = shift @check; next unless $elem->isa('XML::LibXML::Element'); if ($elem->localname =~ /^($pattern)$/i) { if (wantarray) { push @rv, $elem; } else { return $elem; } } if ($elem->localname !~ /^($for_get_them_not)$/i) { unshift @check, $elem->childNodes; } } if (wantarray) { return @rv; } else { return undef; } } sub TO_JSON { my %rv = %{$_[0]}; delete $rv{'html'}; return \%rv; } sub get_link_href { my ($self) = @_; return $self->{'url'}; } sub get_link_rel { my ($self) = @_; return $self->{'rel'}; } sub get_link_type { my ($self) = @_; return $self->{'type'}; } sub get_link_title { my ($self) = @_; return $self->{'title'}; } sub get_text { my ($self) = @_; return $self->{'text'}; } sub get_html { my ($self) = @_; return $self->{'html'}; } sub get_properties { my ($self) = @_; return $self->{'properties'}; } sub get_children { my ($self) = @_; return $self->{'children'}; } sub get_value { my ($self, $key) = @_; return $self->get_properties->get_values($key) if $self->get_properties; } 1; =head2 HTML::Microformats::Format::XOXO::LI Represents an HTML LI element. =over 4 =item C<< $li->get_link_href >> Returns the URL linked to by the B link found within the item. =item C<< $li->get_link_rel >> Returns the value of the rel attribute of the first link found within the item. This is an unparsed string. =item C<< $li->get_link_type >> Returns the value of the type attribute of the first link found within the item. This is an unparsed string. =item C<< $li->get_link_title >> Returns the value of the rel attribute of the first link found within the item if present; the link text otherwise. =item C<< $li->get_text >> Returns the value of the text in the LI element B for the first DL element within the LI, and the first UL or OL element. =item C<< $li->get_html >> Returns the HTML code in the LI element B for the first DL element within the LI, and the first UL or OL element. =item C<< $li->get_properties >> Returns an HTML::Microformats::Format::XOXO::DL object representing the first DL element within the LI. =item C<< $li->get_children >> Returns an HTML::Microformats::Format::XOXO::OL or HTML::Microformats::Format::XOXO::UL object representing the first OL or UL element within the LI. =item C<< $li->get_value($key) >> A shortcut for C<< $li->get_properties->get_values($key) >>. =back =cut package HTML::Microformats::Format::XOXO::LI; use base qw(HTML::Microformats::Format::XOXO::AbstractListItem); use strict qw(subs vars); no warnings; use 5.010; 1; =head2 HTML::Microformats::Format::XOXO::DD This has an identical interface to HTML::Microformats::Format::XOXO::LI. =cut package HTML::Microformats::Format::XOXO::DD; use base qw(HTML::Microformats::Format::XOXO::AbstractListItem); use strict qw(subs vars); no warnings; use 5.010; 1; =head1 MICROFORMAT HTML::Microformats::Format::XOXO supports XOXO as described at L. =head1 RDF OUTPUT XOXO does not map especially naturally to RDF, so this module returns the data as a JSON literal using the property L. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hAtom.pm0000644000076400007640000001332311775403507021702 0ustar taitai=head1 NAME HTML::Microformats::Format::hAtom - the hAtom microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hAtom; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @feeds = HTML::Microformats::Format::hAtom->extract_all( $dom->documentElement, $context); foreach my $feed (@feeds) { foreach my $entry ($feed->get_entry) { print $entry->get_link . "\n"; } } =head1 DESCRIPTION HTML::Microformats::Format::hAtom inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_atom >> This method exports the data as an XML file containing an Atom . It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hAtom; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchAncestorClass); use HTML::Microformats::Datatype::String qw(isms); use HTML::Microformats::Format::hCard; use HTML::Microformats::Format::hEntry; use HTML::Microformats::Format::hNews; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hAtom::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hAtom::VERSION = '0.105'; } our $HAS_ATOM_EXPORT; BEGIN { local $@ = undef; eval 'use XML::Atom::FromOWL;'; $HAS_ATOM_EXPORT = 1 if XML::Atom::FromOWL->can('new'); } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $self->{'element'}->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub extract_all { my ($class, $element, $context) = @_; my @feeds = HTML::Microformats::Format::extract_all($class, $element, $context); if ($element->tagName eq 'html' || !@feeds) { my @entries = HTML::Microformats::Format::hEntry->extract_all($element, $context); my $orphans = 0; foreach my $entry (@entries) { $orphans++ unless searchAncestorClass('hfeed', $entry->element); } if ($orphans) { my $slurpy = $class->new($element, $context); unshift @feeds, $slurpy; } } return @feeds; } sub format_signature { my $awol = 'http://bblfish.net/work/atom-owl/2006-06-06/#'; my $ax = 'http://buzzword.org.uk/rdf/atomix#'; my $iana = 'http://www.iana.org/assignments/relation/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; return { 'root' => ['hfeed'], 'classes' => [ ['hentry', 'm*', {'embedded'=>'hEntry', 'use-key'=>'entry'}], ], 'options' => { 'rel-tag' => 'category', }, 'rdf:type' => ["${awol}Feed"] , 'rdf:property' => { 'entry' => { resource => ["${awol}entry"] } , 'category' => { resource => ["${awol}category"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $awol = 'http://bblfish.net/work/atom-owl/2006-06-06/#'; my $ax = 'http://buzzword.org.uk/rdf/atomix#'; my $iana = 'http://www.iana.org/assignments/relation/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; foreach my $author (@{ $self->data->{'author'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}author"), $author->id(1, 'holder'), )); $author->add_to_model($model); } return $self; } sub to_atom { my ($self) = @_; die "Need XML::Atom::FromOWL to export Atom.\n" unless $HAS_ATOM_EXPORT; my $exporter = XML::Atom::FromOWL->new; return $exporter->export_feed($self->model, $self->id(1))->as_xml; } sub profiles { my @p = qw(); push @p, HTML::Microformats::Format::hEntry->profiles; push @p, HTML::Microformats::Format::hNews->profiles; return @p; } 1; =head1 MICROFORMAT HTML::Microformats::Format::hAtom supports hAtom as described at L, with the following additions: =over 4 =item * Embedded rel-enclosure microformat hAtom entries may use rel-enclosure to specify entry enclosures. =item * Threading support An entry may use rel="in-reply-to" to indicate another entry or a document that this entry is considered a reply to. An entry may use class="replies hfeed" to provide an hAtom feed of responses to it. =back =head1 RDF OUTPUT Data is returned using Henry Story's AtomOWL vocabulary (L), Toby Inkster's AtomOWL extensions (L) and the IANA registered relationship URIs (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/XMDP.pm0000644000076400007640000001037211775403507021403 0ustar taitai=head1 NAME HTML::Microformats::Format::XMDP - the XMDP microformat =head1 SYNOPSIS use HTML::Microformats; use LWP::Simple qw[get]; use RDF::TrineShortcuts; my $uri = 'http://microformats.org/profile/hcard'; my $html = get($uri); my $doc = HTML::Microformats->new_document($html, $uri); $doc->assume_all_profiles; my @xmdp_objects = $doc->objects('XMDP'); foreach my $xo (@xmdp_objects) { print $xo->serialise_model( as => 'Turtle', namespaces => { rdfs => 'http://www.w3.org/2000/01/rdf-schema#', hcard => 'http://microformats.org/profile/hcard#', }, ); print "########\n\n"; } =head1 DESCRIPTION HTML::Microformats::Format::XMDP inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. HTML::Microformats::Format::XMDP also inherits from HTML::Microformats::Format::XOXO, and the C method returns the same structure. =cut package HTML::Microformats::Format::XMDP; use base qw(HTML::Microformats::Format::XOXO); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::XMDP::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::XMDP::VERSION = '0.105'; } sub new { my $class = shift; my $self = $class->SUPER::new(@_); return $self; } sub format_signature { return { 'root' => ['profile'] , 'classes' => [] , 'rdf:type' => [] , 'rdf:property' => {} , } } sub profiles { return qw(http://gmpg.org/xmdp/1); } sub add_to_model { my $self = shift; my $model = shift; $self->SUPER::add_to_model($model); while (my ($term, $data) = each %{ $self->data }) { $self->_add_term_to_model($model, $term, $data); } return $self; } sub _add_term_to_model { my ($self, $model, $term, $data) = @_; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $ident = RDF::Trine::Node::Blank->new( substr($self->context->make_bnode, 2)); if (defined $data->{'id'}) { $ident = RDF::Trine::Node::Resource->new( $self->context->uri('#'.$data->{'id'})); } $model->add_statement(RDF::Trine::Statement->new( $ident, RDF::Trine::Node::Resource->new("${rdfs}label"), $self->_make_literal($term), )); $model->add_statement(RDF::Trine::Statement->new( $ident, RDF::Trine::Node::Resource->new("${rdfs}isDefinedBy"), $self->id(1), )); foreach my $item (@{$data->{'items'}}) { $model->add_statement(RDF::Trine::Statement->new( $ident, RDF::Trine::Node::Resource->new("${rdfs}comment"), $self->_make_literal($item->{'text'}), )) if defined $item->{'text'}; if ($item->{'rel'} =~ /^(help|glossary)$/ && defined $item->{'url'}) { $model->add_statement(RDF::Trine::Statement->new( $ident, RDF::Trine::Node::Resource->new("http://www.w3.org/1999/xhtml/vocab#".lc $1), RDF::Trine::Node::Resource->new($item->{'url'}), )); } while (my ($child_term, $child_data) = each %{ $item->{'properties'} }) { my $child_ident = $self->_add_term_to_model($model, $child_term, $child_data); $model->add_statement(RDF::Trine::Statement->new( $ident, RDF::Trine::Node::Resource->new("${rdfs}seeAlso"), $child_ident, )); } } return $ident; } 1; =head1 MICROFORMAT HTML::Microformats::Format::XMDP supports XMDP as described at L. =head1 RDF OUTPUT Data is returned using RDFS. =head1 BUGS A limitation is that for any EddE element with EdlE children, only the first such EdlE is looked at. This means that the XFN 1.1 profile document is only partially parsable; most other microformat profile document can be properly parsed though. Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCard.pm0000644000076400007640000005551411775403507021663 0ustar taitai=head1 NAME HTML::Microformats::Format::hCard - the hCard microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCard; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cards = HTML::Microformats::Format::hCard->extract_all( $dom->documentElement, $context); foreach my $card (@cards) { print $card->get_fn . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hCard inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_vcard >> This method exports the hCard as a vCard 3.0. It requires L to work, and will throw an error at run-time if it's not available. =item * C<< to_vcard4 >> This method exports the hCard as a vCard 3.0. It requires L to work, and will throw an error at run-time if it's not available. =item * C<< to_vcard4_xml >> This method exports the hCard as a vCard XML. It requires L and L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hCard; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Datatype::String; use HTML::Microformats::Format::hCard::n; use HTML::Microformats::Format::hCard::org; use HTML::Microformats::Format::hCard::tel; use HTML::Microformats::Format::hCard::email; use HTML::Microformats::Format::hCard::label; use HTML::Microformats::Format::hCard::impp; use HTML::Microformats::Utilities qw(stringify searchClass); use Scalar::Util qw(); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCard::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCard::VERSION = '0.105'; } our $HAS_VCARD_EXPORT; our $HAS_VCARD_XML_EXPORT; BEGIN { local $@ = undef; eval 'use RDF::vCard;'; $HAS_VCARD_EXPORT = 1 if RDF::vCard::Exporter->can('new'); eval { $HAS_VCARD_XML_EXPORT = 1 if RDF::vCard::Exporter->can('new') && $RDF::vCard::WITH_XML; }; } sub new { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.holder' => $context->make_bnode , }; $self->{'in_hcalendar'} = $options{'in_hcalendar'}; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); # In hCalendar, 'cn' is used instead of 'fn'. if ($self->{'in_hcalendar'}) { $self->{'DATA'}->{'fn'} = $self->{'DATA'}->{'cn'} if defined $self->{'DATA'}->{'cn'} && !defined $self->{'DATA'}->{'fn'}; } # Find more complicated nested structures. # These can't be handled by _simple_parse. push @{ $self->{'DATA'}->{'n'} }, HTML::Microformats::Format::hCard::n->extract_all($clone, $context); push @{ $self->{'DATA'}->{'org'} }, HTML::Microformats::Format::hCard::org->extract_all($clone, $context); push @{ $self->{'DATA'}->{'tel'} }, HTML::Microformats::Format::hCard::tel->extract_all($clone, $context); push @{ $self->{'DATA'}->{'email'} }, HTML::Microformats::Format::hCard::email->extract_all($clone, $context); push @{ $self->{'DATA'}->{'impp'} }, HTML::Microformats::Format::hCard::impp->extract_all($clone, $context); push @{ $self->{'DATA'}->{'label'} }, HTML::Microformats::Format::hCard::label->extract_all($clone, $context); foreach my $p (qw(n org tel email impp label adr)) { delete $self->{'DATA'}->{$p} unless @{ $self->{'DATA'}->{$p} || [] }; } # Fallback if no 'org' is found. # Try looking directly for org-like properties in the hCard. unless (defined $self->{'DATA'}->{'org'} and @{ $self->{'DATA'}->{'org'} }) { my $org = HTML::Microformats::Format::hCard::org->new($element, $context); $org->{'id'} = $context->make_bnode; # don't share ID with $self!! if ($org->data->{'organization-name'} || $org->data->{'organization-unit'}) { push @{ $self->{'DATA'}->{'org'} }, $org; } } # Fallback if no 'n' is found. # Try looking directly for N-like properties in the hCard. unless (defined $self->{'DATA'}->{'n'} and @{ $self->{'DATA'}->{'n'} }) { my $n = HTML::Microformats::Format::hCard::n->new($element, $context); $n->{'id'} = $context->make_bnode; # don't share ID with $self!! if (@{ $n->data->{'family-name'} } || @{ $n->data->{'given-name'} } || @{ $n->data->{'additional-name'} } || @{ $n->data->{'initial'} } || @{ $n->data->{'honorific-prefix'} } || @{ $n->data->{'honorific-suffix'} }) { push @{ $self->{'DATA'}->{'n'} }, $n; } } # Detect kind ('individual', 'org', etc) $self->_detect_kind; # Perform N-optimisation. $self->_n_optimisation if lc $self->data->{'kind'} eq 'individual'; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub new_fallback { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.holder' => $context->make_bnode , }; bless $self, $class; $self->{'DATA'}->{'fn'} = stringify($element); if ($element->getAttribute('href') =~ /^mailto\:/i) { push @{$self->{'DATA'}->{'email'}}, HTML::Microformats::Format::hCard::email->new($element, $context); } elsif ($element->getAttribute('href') =~ /^(tel|fax|modem)\:/i) { push @{$self->{'DATA'}->{'tel'}}, HTML::Microformats::Format::hCard::email->new($element, $context); } elsif ($element->hasAttribute('href')) { push @{$self->{'DATA'}->{'url'}}, $context->uri( $element->getAttribute('href') ); } elsif ($element->tagName eq 'img' and $element->hasAttribute('src')) { push @{$self->{'DATA'}->{'photo'}}, $context->uri( $element->getAttribute('src') ); } return $self; } sub _n_optimisation { my $self = shift; if ($self->data->{'kind'} eq 'individual') { my $fnIsNick = (defined $self->{'DATA_'}->{'fn'}) && ($self->{'DATA_'}->{'fn'} =~ /\b(nickname)\b/); unless (@{ $self->data->{'n'} } || $fnIsNick) { my $fn = $self->data->{'fn'}; $fn =~ s/(^\s|\s$)//g; $fn =~ s/\s+/ /g; my @words = split / /, $fn; if (scalar @words == 1) { push @{ $self->data->{'nickname'} }, ms($words[0], $self->{'DATA_'}->{'fn'}) ; } elsif (scalar @words) { if (($words[0] =~ /^.*\,$/ || $words[1] =~ /^.\.?$/) && !defined $words[2]) { $words[0] =~ s/[\.\,]$//; $words[1] =~ s/[\.\,]$//; push @{ $self->{'DATA'}->{'n'} }, (bless { 'DATA' => { 'given-name' => [ ms($words[1], $self->{'DATA_'}->{'fn'}) ], 'family-name' => [ ms($words[0], $self->{'DATA_'}->{'fn'}) ], }, 'element' => $self->{'DATA_'}->{'fn'}, 'context' => $self->context, 'cache' => $self->cache, 'id' => $self->context->make_bnode($self->{'DATA_'}->{'fn'}), }, 'HTML::Microformats::Format::hCard::n'); } elsif (!defined $words[2]) { push @{ $self->{'DATA'}->{'n'} }, (bless { 'DATA' => { 'given-name' => [ ms($words[0], $self->{'DATA_'}->{'fn'}) ], 'family-name' => [ ms($words[1], $self->{'DATA_'}->{'fn'}) ], }, 'element' => $self->{'DATA_'}->{'fn'}, 'context' => $self->context, 'cache' => $self->cache, 'id' => $self->context->make_bnode($self->{'DATA_'}->{'fn'}), }, 'HTML::Microformats::Format::hCard::n'); } } } } } sub _detect_kind { my $self = shift; my $rv = $self->{'DATA'}; # If 'kind' class provided explicitly, trust it. if (length $rv->{'kind'}) { # With canonicalisation though. $rv->{'kind'} =~ s/(^\s|\s+$)//g; $rv->{'kind'} = lc $rv->{'kind'}; return; } # If an 'fn' has been provided, guess. if (length $rv->{'fn'}) { # Assume it's an individual. $rv->{'kind'} = 'individual'; # But check to see if the fn matches an org name or unit. ORGLOOP: foreach my $org (@{ $rv->{'org'} }) { if ("".$org->data->{'organization-name'} eq $rv->{'fn'}) { $rv->{'kind'} = 'org'; last ORGLOOP; } foreach my $ou (@{ $org->data->{'organization-unit'} }) { if ("$ou" eq $rv->{'fn'}) { $rv->{'kind'} = 'group'; last ORGLOOP; } } } # If not, then check to see if the fn matches an address part. if ($rv->{'kind'} eq 'individual') { ADRLOOP: foreach my $adr (@{ $rv->{'adr'} }) { my $isFirstPart = 1; foreach my $part (qw(post-office-box extended-address street-address locality region postal-code country-name)) { foreach my $line (@{ $adr->data->{$part} }) { if ("$line" eq $rv->{'fn'}) { $rv->{'kind'} = 'location'; $self->{'id.holder'} = $adr->id(0, 'place') if $isFirstPart; last ADRLOOP; } $isFirstPart = 0; } } } } return; } # Final assumption. $rv->{'kind'} = 'individual'; } sub format_signature { my $self = shift; my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $vx = 'http://buzzword.org.uk/rdf/vcardx#'; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $ix = 'http://buzzword.org.uk/rdf/icaltzdx#'; my $geo = 'http://www.w3.org/2003/01/geo/wgs84_pos#'; # vCard 4.0 introduces CLIENTPIDMAP - best to ignore? my $rv = { 'root' => 'vcard', 'classes' => [ ['adr', 'm*', {'embedded'=>'adr'}], ['agent', 'MM*', {'embedded'=>'hCard'}], ['anniversary', 'd?'], #extension ['bday', 'd?'], ['biota', 'm*', {'embedded'=>'species', 'use-key'=>'species'}], #extension ['birth', 'M?', {'embedded'=>'hCard adr geo'}], #extension ['caladruri', 'u*'], #extension ['caluri', 'MMu*', {'embedded'=>'hCalendar'}], #extension ['category', '*'], ['class', '?', {'value-title'=>'allow'}], ['dday', 'd?'], #extension ['death', 'M?', {'embedded'=>'hCard adr geo'}], #extension ['email', '*#'], ['fn', '1<'], ['fburl', 'MMu*', {'embedded'=>'hCalendar'}], #extension ['gender', '?'], #extension ['geo', 'm*', {'embedded'=>'geo'}], ['impp', '*#'], #extension ['kind', '?', {'value-title'=>'allow'}], #extension ['key', 'u*'], ['label', '*#'], ['lang', '*', {'value-title'=>'allow'}], #extension ['logo', 'u*'], ['mailer', '*'], ['n', '*#'], ['nickname', '*'], ['note', '*'], ['org', '*#'], ['photo', 'u*'], ['rev', 'd*'], ['role', '*'], ['sex', 'n?'], #extension (0=?,1=M,2=F,9=na) ['sort-string', '?'], ['sound', 'u*'], ['tel', '*#'], ['title', '*'], ['tz', '?', {'value-title'=>'allow'}], ['uid', 'U?'], ['url', 'u*'], ], 'options' => { 'rel-me' => '_has_relme', 'rel-tag' => 'category', 'hmeasure' => 'measures', #extension 'no-destroy' => ['adr', 'geo'], }, 'rdf:type' => ["${vcard}VCard"] , 'rdf:property' => { 'adr' => { 'resource' => ["${vcard}adr"] } , 'agent' => { 'resource' => ["${vcard}agent"] , 'literal' => ["${vx}agent-literal"] } , 'anniversary' => { 'literal' => ["${vx}anniversary"] }, 'bday' => { 'literal' => ["${vcard}bday"] }, 'birth' => { 'resource' => ["${vx}birth"] , 'literal' => ["${vx}birth-literal"] }, 'caladruri' => { 'resource' => ["${vx}caladruri"] }, 'caluri' => { 'resource' => ["${vx}caluri"] }, 'category' => { 'resource' => ["${vx}category", 'http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] , 'literal' => ["${vcard}category"]}, 'class' => { 'literal' => ["${vcard}class"] }, 'dday' => { 'literal' => ["${vx}dday"] }, 'death' => { 'resource' => ["${vx}death"] , 'literal' => ["${vx}death-literal"] }, 'email' => { 'resource' => ["${vcard}email"] }, 'fn' => { 'literal' => ["${vcard}fn", "http://www.w3.org/2000/01/rdf-schema#label"] }, 'fburl' => { 'resource' => ["${vx}fburl"] }, 'gender' => { 'literal' => ["${vx}gender"] }, 'geo' => { 'resource' => ["${vcard}geo"] } , 'impp' => { 'resource' => ["${vx}impp"] }, 'kind' => { 'literal' => ["${vx}kind"] }, 'key' => { 'resource' => ["${vcard}key"] }, 'label' => { 'resource' => ["${vcard}label"] }, 'lang' => { 'literal' => ["${vx}lang"] }, 'logo' => { 'resource' => ["${vcard}logo"] }, 'mailer' => { 'literal' => ["${vcard}mailer"] }, 'n' => { 'resource' => ["${vcard}n"] }, 'nickname' => { 'literal' => ["${vcard}nickname"] }, 'note' => { 'literal' => ["${vcard}note"] }, 'org' => { 'resource' => ["${vcard}org"] }, 'photo' => { 'resource' => ["${vcard}photo"] }, 'rev' => { 'literal' => ["${vcard}rev"] }, 'role' => { 'literal' => ["${vcard}role"] }, 'sex' => { 'literal' => ["${vx}sex"] }, 'sort-string' => { 'literal' => ["${vcard}sort-string"] }, 'sound' => { 'resource' => ["${vcard}sound"] }, 'species' => { 'resource' => ["${vx}x-species"] }, 'tel' => { 'resource' => ["${vcard}tel"] }, 'title' => { 'literal' => ["${vcard}title"] }, 'tz' => { 'literal' => ["${vcard}tz"] }, 'uid' => { 'resource' => ["${vcard}uid"], 'literal' => ["${vcard}uid"] }, 'url' => { 'resource' => ["${vcard}url"] }, 'cn' => { 'literal' => ["${ical}cn"] }, 'cutype' => { 'literal' => ["${ical}cutype"] }, 'rsvp' => { 'literal' => ["${ical}rsvp"] }, 'delegated-from' => { 'resource' => ["${ix}delegatedFrom"] , 'literal' => ["${ical}delegatedFrom"] }, 'sent-by' => { 'resource' => ["${ix}sentBy"] , 'literal' => ["${ical}sentBy"] }, }, }; if (ref $self and $self->{'in_hcalendar'}) { push @{ $rv->{'classes'} }, ( # these are ALL extensions ['cn', '?'], ['cutype', '?'], ['member', '?'], ['rsvp', '?'], ['delegated-from', 'Mu*',{'embedded'=>'hCard'}], ['sent-by', 'Mu*', {'embedded'=>'hCard'}], ); $rv->{'rdf:property'}->{'member'} = { 'resource' => ["${ix}member"] , 'literal' => ["${ix}member"] }; } else { push @{ $rv->{'classes'} }, ( ['member', 'Mu*', {'embedded'=>'hCard'}], #extension ); $rv->{'rdf:property'}->{'member'} = { 'resource' => ["${vx}member"] , 'literal' => ["${vx}member"] }; } return $rv; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); foreach my $property (qw(n org adr geo agent tel email label impp birth caluri death fburl delegated-from sent-by member species)) { foreach my $value (@{ $self->data->{$property} }) { if (Scalar::Util::blessed($value) and $value->can('add_to_model')) { $value->add_to_model($model); } } } # From the vCard we can infer data about its holder. { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://purl.org/uF/hCard/terms/hasCard'), $self->id(1), )); if (lc $self->data->{'kind'} eq 'individual') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/Person'), )); } elsif (lc $self->data->{'kind'} eq 'org') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/Organization'), )); } elsif (lc $self->data->{'kind'} eq 'group') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/Group'), )); } elsif (lc $self->data->{'kind'} eq 'location') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://www.w3.org/2003/01/geo/wgs84_pos#SpatialThing'), )); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/name'), $self->_make_literal($self->data->{'fn'}), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/gender'), $self->_make_literal($self->data->{'gender'}), )) if defined $self->data->{'gender'}; foreach my $url (@{ $self->data->{'url'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/page'), RDF::Trine::Node::Resource->new($url), )); } foreach my $tel (@{ $self->data->{'tel'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/phone'), RDF::Trine::Node::Resource->new($tel->get_value), )) if $tel->get_value =~ /^(tel|fax|modem):\S+$/i; } foreach my $e (@{ $self->data->{'email'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/mbox'), RDF::Trine::Node::Resource->new($e->get_value), )) if $e->get_value =~ /^(mailto):\S+$/i; } foreach my $photo (@{ $self->data->{'photo'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depiction'), RDF::Trine::Node::Resource->new($photo), )); } foreach my $geo (@{ $self->data->{'geo'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/based_near'), $geo->id(1, 'location'), )); } foreach my $species (@{ $self->data->{'species'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new('http://purl.org/NET/biol/ns#hasTaxonomy'), $species->id(1), )); } } $self->context->representative_hcard; if ($self->{'representative'}) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new('http://purl.org/uF/hCard/terms/representative'), $self->id(1), )); } $self->context->contact_hcard; if ($self->{'contact'}) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new('http://purl.org/uF/hCard/terms/contact'), $self->id(1), )); } return $self; } sub to_vcard { my ($self) = @_; die "Need RDF::vCard to export vCard.\n" unless $HAS_VCARD_EXPORT; my $exporter = RDF::vCard::Exporter->new(); return $exporter->export_card($self->model, $self->id(1))->to_string; } sub to_vcard4 { my ($self) = @_; die "Need RDF::vCard to export vCard.\n" unless $HAS_VCARD_EXPORT; my $exporter = RDF::vCard::Exporter->new( vcard_version => 4 ); return $exporter->export_card($self->model, $self->id(1))->to_string; } sub to_vcard4_xml { my ($self) = @_; die "Need RDF::vCard and XML::LibXML to export vCard.\n" unless $HAS_VCARD_XML_EXPORT; my $exporter = RDF::vCard::Exporter->new( vcard_version => 4 ); return $exporter->export_card($self->model, $self->id(1))->to_xml; } sub profiles { my $class = shift; return qw(http://microformats.org/profile/hcard http://ufs.cc/x/hcard http://microformats.org/profile/specs http://ufs.cc/x/specs http://www.w3.org/2006/03/hcard http://purl.org/uF/hCard/1.0/ http://purl.org/uF/2008/03/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hCard supports hCard as described at L, with the following additions: =over 4 =item * vCard 4.0 terms This module includes additional property terms taken from the latest vCard 4.0 drafts. For example the property 'impp' may be used to mark up instant messaging addresses for a contact. The vCard 4.0 property 'kind' is used to record the kind of contact described by the hCard (an individual, an organisation, etc). In many cases this is automatically inferred. =item * Embedded species microformat If the species microformat (see L) is found embedded within an hCard, then this is taken to be the species of a contact. =item * Embedded hMeasure If the hMeasure microformat (see L) is found embedded within an hCard, and no 'item' property is provided, then the measurement is taken to pertain to the contact described by the hCard. =back =head1 RDF OUTPUT Data is returned using the W3C's vCard vocabulary (L) with some supplemental terms from Toby Inkster's vCard extensions vocabulary (L) and occasional other terms. After long deliberation on the "has-a/is-a issue", the author of this module decided that the holder of a vCard and the vCard itself should be modelled as two separate resources, and this is how the data is returned. Some information about the holder of the vCard can be inferred from information about the vCard; for instance, the vCard's fn property can be used to determin the holder's foaf:name. This module uses FOAF (L) to represent information about the holder of the vCard. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/figure.pm0000644000076400007640000002024711775403507022116 0ustar taitai=head1 NAME HTML::Microformats::Format::figure - the figure microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::figure; use Scalar::Util qw(blessed); my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::figure->extract_all( $dom->documentElement, $context); foreach my $fig (@objects) { printf("<%s> %s\n", $fig->get_image, $fig->get_legend->[0]); foreach my $maker ($p->get_credit) { if (blessed($maker)) { printf(" - by %s\n", $maker->get_fn); } else { printf(" - by %s\n", $maker); } } } =head1 DESCRIPTION HTML::Microformats::Format::figure inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::figure; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass searchID stringify); use HTML::Microformats::Datatype::String qw(ms); use Locale::Country qw(country2code LOCALE_CODE_ALPHA_2); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::figure::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::figure::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_figure_parse($clone); if (defined $self->{'DATA'}->{'image'}) { $self->{'id'} = $self->{'DATA'}->{'image'}; } else { return undef; } $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _figure_parse { my ($self, $elem) = @_; my ($desc_node, $image_node); if ($elem->localname eq 'img' && $elem->getAttribute('class')=~/\b(image)\b/) { $image_node = $elem; } else { my @images = searchClass('image', $elem); @images = $elem->getElementsByTagName('img') unless @images; $image_node = $images[0] if @images; } if ($elem->localname eq 'img') { $image_node ||= $elem; } if ($image_node) { $self->{'DATA'}->{'image'} = $self->context->uri($image_node->getAttribute('src')); $self->{'DATA'}->{'alt'} = ms($image_node->getAttribute('alt'), $image_node) if $image_node->hasAttribute('alt'); $self->{'DATA'}->{'title'} = ms($image_node->getAttribute('title'), $image_node) if $image_node->hasAttribute('title'); if ($image_node->getAttribute('longdesc') =~ m'^#(.+)$') { $desc_node = searchID($1, $self->context->dom->documentElement); my $dnp = $desc_node->getAttribute('data-cpan-html-microformats-nodepath'); my $rnp = $elem->getAttribute('data-cpan-html-microformats-nodepath'); unless ($rnp eq substr $dnp, 0, length $rnp) { $elem->addChild($desc_node->clone(1)); } } } # Just does class=credit, class=subject and rel=tag. $self->_simple_parse($elem); my @legends; push @legends, $elem if $elem->getAttribute('class')=~/\b(legend)\b/; push @legends, searchClass('legend', $elem); foreach my $l ($elem->getElementsByTagName('legend')) { push @legends, $l unless $l->getAttribute('class')=~/\b(legend)\b/; # avoid duplicates } foreach my $legend_node (@legends) { my $legend; if ($legend_node == $image_node) { $legend = ms($legend_node->getAttribute('title'), $legend_node) if $legend_node->hasAttribute('title'); } else { $legend = stringify($legend_node, 'value'); } push @{ $self->{'DATA'}->{'legend'} }, $legend if defined $legend; } } sub extract_all { my ($class, $dom, $context, %options) = @_; my @rv; my @elements = searchClass('figure', $dom); foreach my $f ($dom->getElementsByTagName('figure')) { push @elements, $f unless $f->getAttribute('class')=~/\b(figure)\b/; } foreach my $e (@elements) { my $object = $class->new($e, $context, %options); next unless $object; next if grep { $_->id eq $object->id } @rv; # avoid duplicates push @rv, $object if ref $object; } return @rv; } sub format_signature { my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $geo = 'http://www.w3.org/2003/01/geo/wgs84_pos#'; my $foaf = 'http://xmlns.com/foaf/0.1/'; return { 'root' => 'figure', 'classes' => [ ['image', '1u#'], ['legend', '+#'], ['credit', 'M*', {embedded=>'hCard'}], ['subject', 'M*', {embedded=>'hCard adr geo hEvent'}], ], 'options' => { 'rel-tag' => 'category', }, 'rdf:type' => ["${foaf}Image"] , 'rdf:property' => { 'legend' => { literal => ['http://purl.org/dc/terms/description'] }, 'category' => { resource => ['http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] }, }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $i = 0; foreach my $subject (@{ $self->{'DATA'}->{'subject'} }) { if ($self->_isa($subject, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depicts'), $subject->id(1, 'holder'), )); } elsif ($self->_isa($subject, 'HTML::Microformats::Format::adr')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depicts'), $subject->id(1, 'place'), )); } elsif ($self->_isa($subject, 'HTML::Microformats::Format::geo')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depicts'), $subject->id(1, 'location'), )); } elsif ($self->_isa($subject, 'HTML::Microformats::Format::hEvent')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depicts'), $subject->id(1, 'event'), )); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/depicts'), $self->id(1, "subject.${i}"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "subject.${i}"), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/name'), $self->_make_literal($subject))); } $i++; } $i = 0; foreach my $credit (@{ $self->{'DATA'}->{'credit'} }) { if ($self->_isa($credit, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://purl.org/dc/terms/contributor'), $credit->id(1, 'holder'), )); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://purl.org/dc/terms/contributor'), $self->id(1, "credit.${i}"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "credit.${i}"), RDF::Trine::Node::Resource->new('http://xmlns.com/foaf/0.1/name'), $self->_make_literal($credit))); } $i++; } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/figure/draft); } 1; =head1 MICROFORMAT HTML::Microformats::Format::figure supports figure as described at L. =head1 RDF OUTPUT Data is returned using Dublin Core and FOAF. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hEvent.pm0000644000076400007640000003405011775403507022063 0ustar taitai=head1 NAME HTML::Microformats::Format::hEvent - an hCalendar event component =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCalendar; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cals = HTML::Microformats::Format::hCalendar->extract_all( $dom->documentElement, $context); foreach my $cal (@cals) { foreach my $ev ($cal->get_vevent) { printf("%s: %s\n", $ev->get_dtstart, $ev->get_summary); } } =head1 DESCRIPTION HTML::Microformats::Format::hEvent is a helper module for HTML::Microformats::Format::hCalendar. This class is used to represent event components within calendars. Generally speaking, you want to use HTML::Microformats::Format::hCalendar instead. HTML::Microformats::Format::hEvent inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_icalendar >> This method exports the data in iCalendar format. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hEvent; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass searchRel stringify); use HTML::Microformats::Format::species; use Scalar::Util qw[blessed]; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hEvent::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hEvent::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); # Embedded species - too tricky for _simple_parse(). my @nested = searchClass(HTML::Microformats::Format::species->format_signature->{'root'}, $clone); foreach my $h (@nested) { if ($h->getAttribute('class') =~ / (^|\s) (attendee) (\s|$) /x) { push @{ $self->{'DATA'}->{'x-sighting-of'} }, HTML::Microformats::Format::species->new($h, $context); } my $newClass = $h->getAttribute('class'); $newClass =~ s/\b(attendee|x.sighting.of)\b//g; $h->setAttribute('class', $newClass); } $self->_simple_parse($clone); $self->_parse_related($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _parse_related { my ($self, $element) = @_; # Related-to - too tricky for simple_parse() my @relations = searchClass('related-to', $element); foreach my $r (@relations) { if ($r->tagName !~ /^(a|area|link)$/i) { push @{$self->{'DATA'}->{'sibling'}}, stringify($r, 'value'); } elsif ($r->getAttribute('rel') =~ /vcalendar-parent/i && !defined $self->{'DATA'}->{'parent'}) { $self->{'DATA'}->{'parent'} = $self->context->uri($r->getAttribute('href')); } elsif ($r->getAttribute('rel') =~ /vcalendar-child/i) { push @{$self->{'DATA'}->{'child'}}, $self->context->uri($r->getAttribute('href')); } else { push @{$self->{'DATA'}->{'sibling'}}, $self->context->uri($r->getAttribute('href')); } } # If no parent, then try to find a link with rel="vcalendar-parent" but no # class="related-to". unless ($self->{'DATA'}->{'parent'}) { @relations = searchRel('vcalendar-parent', $element); my $r = shift @relations; $self->{'DATA'}->{'parent'} = $self->context->uri($r->getAttribute('href')) if ($r); } # Find additional siblings. @relations = searchRel('vcalendar-sibling', $element); foreach my $r (@relations) { push @{$self->{'DATA'}->{'sibling'}}, $self->context->uri($r->getAttribute('href')) unless $r->getAttribute('class') =~ /\b(related-to)\b/; } # Find additional children. @relations = searchRel('vcalendar-child', $element); foreach my $r (@relations) { push @{$self->{'DATA'}->{'child'}}, $self->context->uri($r->getAttribute('href')) unless $r->getAttribute('class') =~ /\b(related-to)\b/; } return $self; } sub format_signature { my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $icalx = 'http://buzzword.org.uk/rdf/icaltzdx#'; return { 'root' => 'vevent', 'classes' => [ ['attach', 'u*'], ['attendee', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['categories', '*'], ['category', '*', {'use-key'=>'categories'}], ['class', '?', {'value-title'=>'allow'}], ['comment', '*'], #['completed', 'd?'], ['contact', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['created', 'd?'], ['description', '?'], ['dtstamp', 'd?'], ['dtstart', 'd1'], ['dtend', 'd?', {'datetime-feedthrough' => 'dtstart'}], #['due', 'd?'], ['duration', 'D?'], ['exdate', 'd*'], ['exrule', 'e*'], ['geo', 'M*', {embedded=>'geo'}], ['last-modified', 'd?'], ['location', 'M*', {embedded=>'hCard adr geo'}], ['organizer', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], #['percent-complete', '?'], ['priority', '?', {'value-title'=>'allow'}], ['rdate', 'd*'], ['recurrance-id', 'U?'], ['resource', '*', {'use-key'=>'resources'}], ['resources', '*'], ['rrule', 'e*'], ['sequence', 'n?', {'value-title'=>'allow'}], ['status', '?', {'value-title'=>'allow'}], ['summary', '1'], ['transp', '?', {'value-title'=>'allow'}], ['uid', 'U?'], ['url', 'U?'], ['valarm', 'M*', {embedded=>'hAlarm'}], ['x-sighting-of', 'M*', {embedded=>'species'}] #extension ], 'options' => { 'rel-tag' => 'categories', 'rel-enclosure' => 'attach', 'hmeasure' => 'measures' }, 'rdf:type' => ["${ical}Vevent"] , 'rdf:property' => { # 'attach' => { 'resource' => ["${ical}attach"] } , 'attendee' => { 'resource' => ["${ical}attendee"], 'literal' => ["${icalx}attendee-literal"] } , 'categories' => { 'resource' => ["${icalx}category"], 'literal' => ["${ical}category"] }, 'class' => { 'literal' => ["${ical}class"] , 'literal_datatype' => 'string'} , 'comment' => { 'literal' => ["${ical}comment"] } , 'contact' => { 'resource' => ["${icalx}contact"], 'literal' => ["${ical}contact"] } , 'created' => { 'literal' => ["${ical}created"] } , 'description' => { 'literal' => ["${ical}description"] } , 'dtend' => { 'literal' => ["${ical}dtend"] } , 'dtstamp' => { 'literal' => ["${ical}dtstamp"] } , 'dtstart' => { 'literal' => ["${ical}dtstart"] } , 'duration' => { 'literal' => ["${ical}duration"] } , 'exdate' => { 'literal' => ["${ical}exdate"] } , 'geo' => { 'literal' => ["${icalx}geo"] } , 'last-modified' => { 'literal' => ["${ical}lastModified"] } , 'location' => { 'resource' => ["${icalx}location"], 'literal' => ["${ical}location"] } , 'organizer' => { 'resource' => ["${ical}organizer"], 'literal' => ["${icalx}organizer-literal"] } , 'priority' => { 'literal' => ["${ical}priority"] } , 'rdate' => { 'literal' => ["${ical}rdate"] } , 'recurrance-id' => { 'resource' => ["${ical}recurranceId"] , 'literal' => ["${ical}recurranceId"] , 'literal_datatype' => 'string' } , 'resources' => { 'literal' => ["${ical}resources"] } , 'sequence' => { 'literal' => ["${ical}sequence"] , 'literal_datatype' => 'integer' } , 'status' => { 'literal' => ["${ical}status"] , 'literal_datatype' => 'string' } , 'summary' => { 'literal' => ["${ical}summary"] } , 'transp' => { 'literal' => ["${ical}transp"] , 'literal_datatype' => 'string' } , 'uid' => { 'resource' => ["${ical}uid"] , 'literal' => ["${ical}uid"] , 'literal_datatype' => 'string' } , 'url' => { 'resource' => ["${ical}url"] } , 'valarm' => { 'resource' => ["${ical}valarm"] } , 'x-sighting-of' => { 'resource' => ["${ical}x-sighting-of"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; $self->_simple_rdf($model); _add_to_model_geo($self, $model); _add_to_model_related($self, $model); foreach my $prop (qw(exrule rrule)) { foreach my $val ( @{ $self->data->{$prop} } ) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}${prop}"), RDF::Trine::Node::Blank->new(substr($val->{'_id'},2)), )); $val->add_to_model($model); } } foreach my $val ( @{ $self->data->{attach} } ) { if (blessed($val) and $val->can('add_to_model')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}attach"), RDF::Trine::Node::Resource->new($val->data->{href}), )); $val->add_to_model($model); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}attach"), RDF::Trine::Node::Resource->new($val), )); } } return $self; } sub _add_to_model_geo { my ($self, $model) = @_; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; # GEO is an rdf:List of floating point numbers :-( foreach my $geo (@{ $self->data->{'geo'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}geo"), $geo->id(1, 'ical-list.0'), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.0'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#List"), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.0'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#first"), RDF::Trine::Node::Literal->new($geo->data->{'latitude'}, undef, 'http://www.w3.org/2001/XMLSchema#float'), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.0'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#next"), $geo->id(1, 'ical-list.1'), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.1'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#List"), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.1'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#first"), RDF::Trine::Node::Literal->new($geo->data->{'longitude'}, undef, 'http://www.w3.org/2001/XMLSchema#float'), )); $model->add_statement(RDF::Trine::Statement->new( $geo->id(1, 'ical-list.1'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#next"), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#nil"), )); } } sub _add_to_model_related { my ($self, $model) = @_; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; foreach my $relationship (qw(parent child sibling other)) { my @uids; if (ref $self->data->{$relationship} eq 'ARRAY') { @uids = @{$self->data->{$relationship}}; } else { push @uids, $self->data->{$relationship}; } for (my $i=0; defined $uids[$i]; $i++) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}relatedTo"), $self->id(1, "relationship.${relationship}.${i}"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "relationship.${relationship}.${i}"), RDF::Trine::Node::Resource->new("${ical}reltype"), RDF::Trine::Node::Literal->new($relationship, undef, 'http://www.w3.org/2001/XMLSchema#string'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "relationship.${relationship}.${i}"), RDF::Trine::Node::Resource->new("http://buzzword.org.uk/rdf/icaltzdx#related-component-uid"), RDF::Trine::Node::Literal->new($uids[$i]), )); } my @objects; if (ref $self->{'related'}->{$relationship} eq 'ARRAY') { @objects = @{$self->{'related'}->{$relationship}}; } else { push @objects, $self->{'related'}->{$relationship}; } for (my $i=0; defined $objects[$i]; $i++) { next unless ref $objects[$i]; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("http://buzzword.org.uk/rdf/icaltzdx#${relationship}-component"), $objects[$i]->id(1), )); } } } sub profiles { return HTML::Microformats::Format::hCalendar::profiles(@_); } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HTML::Microformats::Format::hCalendar::HAS_ICAL_EXPORT; my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_component($self->model, $self->id(1))->to_string; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/RelEnclosure.pm0000644000076400007640000000775411775403507023247 0ustar taitai=head1 NAME HTML::Microformats::Format::RelEnclosure - the rel-enclosure microformat =head1 SYNOPSIS my @enclosures = HTML::Microformats::Format::RelEnclosure->extract_all( $doc->documentElement, $context); foreach my $e (@enclosures) { my $type = $l->get_type || 'unknown'; printf("%s (%s)\n"), $l->get_href, $type); } =head1 DESCRIPTION HTML::Microformats::Format::RelEnclosure inherits from HTML::Microformats::Format_Rel. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over 4 =item C<< $relenc->get_type() >> Returns the media type (Content-Type) of the resource being linked to. This is taken from the HTML 'type' attribute, so if that's not present, returns undef. =back =cut package HTML::Microformats::Format::RelEnclosure; use base qw(HTML::Microformats::Format_Rel); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Datatype::String qw(isms); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::RelEnclosure::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::RelEnclosure::VERSION = '0.105'; } sub new { my $class = shift; my $self = $class->SUPER::new(@_); $self->{'DATA'}->{'type'} = $self->{'element'}->getAttribute('type') if $self->{'element'}->hasAttribute('type'); return $self; } sub format_signature { return { 'rel' => 'enclosure' , 'classes' => [ ['type', '?#'] , ['href', '1#'] , ['label', '1#'] , ['title', '1#'] , ] , 'rdf:type' => [] , 'rdf:property' => {} , } } sub profiles { return qw(http://purl.org/uF/rel-enclosure/0.1/); } sub add_to_model { my $self = shift; my $model = shift; my $enc = 'http://purl.oclc.org/net/rss_2.0/enc#'; $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new("${enc}enclosure"), RDF::Trine::Node::Resource->new($self->data->{'href'}), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->data->{'href'}), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("${enc}Enclosure"), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->data->{'href'}), RDF::Trine::Node::Resource->new("${enc}type"), RDF::Trine::Node::Literal->new(''.$self->data->{'type'}), )) if defined $self->data->{'type'}; $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->data->{'href'}), RDF::Trine::Node::Resource->new("http://www.w3.org/2000/01/rdf-schema#label"), $self->_make_literal($self->data->{'label'}), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->data->{'href'}), RDF::Trine::Node::Resource->new("http://purl.org/dc/terms/title"), $self->_make_literal($self->data->{'title'}), )); return $self; } 1; =head1 MICROFORMAT HTML::Microformats::Format::RelEnclosure supports rel-enclosure as described at L. The "title" attribute on the link, and the linked text are taken to be significant. =head1 RDF OUTPUT Data is returned using the RSS Enclosures vocabulary (L) and occasional other terms. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/geo.pm0000644000076400007640000002144111775403507021404 0ustar taitai=head1 NAME HTML::Microformats::Format::geo - the geo microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::geo; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @geos = HTML::Microformats::Format::geo->extract_all( $dom->documentElement, $context); foreach my $geo (@geos) { printf("%s;%s\n", $geo->get_latitude, $geo->get_longitude); } =head1 DESCRIPTION HTML::Microformats::Format::geo inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_kml >> This method exports the geo object as KML. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::geo; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::geo::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::geo::VERSION = '0.105'; } our $HAS_KML_EXPORT; BEGIN { local $@ = undef; eval 'use RDF::KML::Exporter;'; $HAS_KML_EXPORT = 1 if RDF::KML::Exporter->can('new'); } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); if (!defined($self->{'DATA'}->{'longitude'}) || !defined($self->{'DATA'}->{'latitude'})) { my $str = stringify($clone, { 'excerpt-class' => 'value', 'value-title' => 'allow', 'abbr-pattern' => 1, }); if ($str =~ / ^\s* \+?(\-?[0-9\.]+) \s* [\,\;] \s* \+?(\-?[0-9\.]+) \s*$ /x) { $self->{'DATA'}->{'latitude'} = $1; $self->{'DATA'}->{'longitude'} = $2; } # Last ditch attempt!! elsif ($clone->toString =~ / \s* \+?(\-?[0-9\.]+) \s* [\,\;] \s* \+?(\-?[0-9\.]+) \s* /x) { $self->{'DATA'}->{'latitude'} = $1; $self->{'DATA'}->{'longitude'} = $2; } } if (defined $self->data->{'body'} or (defined $self->data->{'reference-frame'} && $self->data->{'reference-frame'}!~ /wgs[-\s]?84/i)) { $self->{'id.location'} = $context->make_bnode; } elsif (defined $self->data->{'altitude'} and (!ref $self->data->{'altitude'} || $self->data->{'altitude'}->can('to_string'))) { $self->{'id.location'} = sprintf('geo:%s,%s,%s', $self->data->{'latitude'}, $self->data->{'longitude'}, $self->data->{'altitude'}, ); } else { $self->{'id.location'} = sprintf('geo:%s,%s', $self->data->{'latitude'}, $self->data->{'longitude'}, ); } $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $vx = 'http://buzzword.org.uk/rdf/vcardx#'; return { 'root' => 'geo', 'classes' => [ ['longitude', 'n?', {'value-title'=>'allow'}], ['latitude', 'n?', {'value-title'=>'allow'}], ['body', '?'], # extension ['reference-frame', '?'], # extension ['altitude', 'M?', {embedded=>'hMeasure'}] # extension ], 'options' => { }, 'rdf:type' => ["${vcard}Location"] , 'rdf:property' => { 'latitude' => { 'literal' => ["${vcard}latitude"] } , 'longitude' => { 'literal' => ["${vcard}longitude"] } , 'altitude' => { 'literal' => ["${vx}altitude"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; if (defined $self->data->{'body'} or (defined $self->data->{'reference-frame'} && $self->data->{'reference-frame'}!~ /wgs[-\s]?84/i)) { my $rdf = { $self->id(0,'location') => { 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' => [{ 'value'=>'http://buzzword.org.uk/rdf/ungeo#Point' , 'type'=>'uri' }] } }; foreach my $p (qw(altitude longitude latitude)) { if (defined $self->data->{$p}) { $rdf->{$self->id(0,'location')}->{'http://buzzword.org.uk/rdf/ungeo#'.$p} = [{ 'value'=>$self->data->{$p}, 'type'=>'literal' }]; } } $rdf->{$self->id(0,'location')}->{'http://buzzword.org.uk/rdf/ungeo#system'} = [{ 'value'=>$self->id(0,'system'), 'type'=>'bnode' }]; $rdf->{$self->id(0,'system')}->{'http://www.w3.org/1999/02/22-rdf-syntax-ns#type'} = [{ 'value'=>'http://buzzword.org.uk/rdf/ungeo#ReferenceSystem', 'type'=>'uri' }]; $rdf->{$self->id(0,'system')}->{'http://www.w3.org/2000/01/rdf-schema#label'} = [{ 'value'=>$self->data->{'reference-frame'}, 'type'=>'literal' }] if defined $self->data->{'reference-frame'}; $rdf->{$self->id(0,'system')}->{'http://buzzword.org.uk/rdf/ungeo#body'} = [{ 'value'=>$self->data->{'body'}, 'type'=>'literal' }] if defined $self->data->{'body'}; $model->add_hashref($rdf); } else { $self->_simple_rdf($model); my $geo = 'http://www.w3.org/2003/01/geo/wgs84_pos#'; $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'location'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new("${geo}Point"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'location'), RDF::Trine::Node::Resource->new("${geo}lat"), $self->_make_literal($self->data->{'latitude'}, 'decimal'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'location'), RDF::Trine::Node::Resource->new("${geo}long"), $self->_make_literal($self->data->{'longitude'}, 'decimal'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'location'), RDF::Trine::Node::Resource->new("${geo}alt"), $self->_make_literal($self->data->{'altitude'}, 'decimal'), )) if (defined $self->data->{'altitude'} and (!ref $self->data->{'altitude'} || $self->data->{'altitude'}->can('to_string'))); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://buzzword.org.uk/rdf/vcardx#represents-location'), $self->id(1, 'location'), )); return $self; } sub to_kml { my ($self) = @_; die "Need RDF::KML::Exporter to export KML.\n" unless $HAS_KML_EXPORT; my $exporter = RDF::KML::Exporter->new; return $exporter->export_kml($self->model)->render; } sub profiles { my $class = shift; return qw(http://purl.org/uF/geo/0.9/ http://microformats.org/profile/hcard http://ufs.cc/x/hcard http://microformats.org/profile/specs http://ufs.cc/x/specs http://www.w3.org/2006/03/hcard http://purl.org/uF/hCard/1.0/ http://purl.org/uF/2008/03/ ); } 1; =head1 MICROFORMAT HTML::Microformats::Format::geo supports geo as described at L, with the following additions: =over 4 =item * 'altitude' property You may provide an altitude as either a number (taken to be metres above sea level) or an embedded hMeasure. e.g.: lat: 12.34, long: 56.78, alt: 90 metres. lat: 12.34, long: 56.78, alt: 90 m . =item * 'body' and 'reference-frame' The geo microformat is normally only defined for WGS84 co-ordinates on Earth. Using 'body' and 'reference-frame' properties (each of which take string values), you may give co-ordinates on other planets, asteroids, moons, etc; or on Earth but using a non-WGS84 system. =back =head1 RDF OUTPUT Data is returned using the W3C's vCard vocabulary (L) and the W3C's WGS84 vocabulary (L). For non-WGS84 co-ordinates, UNGEO (L) is used instead. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hEntry.pm0000644000076400007640000004710311775403507022106 0ustar taitai=head1 NAME HTML::Microformats::Format::hEntry - an hAtom entry =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hAtom; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @feeds = HTML::Microformats::Format::hAtom->extract_all( $dom->documentElement, $context); foreach my $feed (@feeds) { foreach my $entry ($feed->get_entry) { print $entry->get_link . "\n"; } } =head1 DESCRIPTION HTML::Microformats::Format::hEntry is a helper module for HTML::Microformats::Format::hAtom. This class is used to represent entries within feeds. Generally speaking, you want to use HTML::Microformats::Format::hAtom instead. HTML::Microformats::Format::hEntry inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_atom >> This method exports the data as an XML file containing an Atom . It requires L to work, and will throw an error at run-time if it's not available. =item * C<< to_icalendar >> This method exports the data in iCalendar format (as a VJOURNAL). It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hEntry; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass searchAncestorClass stringify); use HTML::Microformats::Datatype::String qw(isms); use HTML::Microformats::Format::hCard; use HTML::Microformats::Format::hEvent; use HTML::Microformats::Format::hNews; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hEntry::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hEntry::VERSION = '0.105'; } our $HAS_ATOM_EXPORT; BEGIN { local $@ = undef; eval 'use XML::Atom::FromOWL;'; $HAS_ATOM_EXPORT = 1 if XML::Atom::FromOWL->can('new'); } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; # Use hNews if more appropriate. if ($element->getAttribute('class') =~ /\b(hnews)\b/) { return HTML::Microformats::Format::hNews->new($element, $context) if $context->has_profile( HTML::Microformats::Format::hNews->profiles ); } return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; $self->_hentry_parse; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _hentry_parse { my ($self) = @_; my $clone = $self->{'element'}->cloneNode(1); $self->_expand_patterns($clone); # Because of
element handling, process 'author' outside of # _simple_parse. $self->_author_parse($clone); # Parse other properties. $self->_simple_parse($clone); # Fallback for title - use the first element # or (if there's no hfeed) the page title. $self->_title_fallback($clone); # Fallback for permalink - use id attribute or page URI. $self->_link_fallback($self->{'element'}); # Handle replies hAtom feed $self->_reply_handler; if ($self->context->has_profile( HTML::Microformats::Format::VoteLinks->profiles )) { my @vls = HTML::Microformats::Format::VoteLinks->extract_all($clone, $self->context); foreach my $votelink (@vls) { next if defined $votelink->data->{'voter'}; my $ancestor = searchAncestorClass('hentry', $votelink->element) || searchAncestorClass('hnews', $votelink->element) || searchAncestorClass('hslice', $votelink->element); next unless defined $ancestor; next unless $ancestor->getAttribute('data-cpan-html-microformats-nodepath') eq $self->element->getAttribute('data-cpan-html-microformats-nodepath'); $votelink->data->{'voter'} = $self->data->{'author'}; } } return $clone; } sub _author_parse { my ($self, $clone) = @_; my @vcard_elements = searchClass('vcard', $clone); foreach my $ve (@vcard_elements) { next unless $ve->getAttribute('class') =~ /\b(author)\b/; next unless $clone->getAttribute('data-cpan-html-microformats-nodepath') eq searchAncestorClass('hentry', $ve)->getAttribute('data-cpan-html-microformats-nodepath'); push @{ $self->{'DATA'}->{'author'} }, HTML::Microformats::Format::hCard->new($ve, $self->context); } unless (@{ $self->{'DATA'}->{'author'} }) { foreach my $ve (@vcard_elements) { next unless $ve->tagName eq 'address'; next unless $clone->getAttribute('data-cpan-html-microformats-nodepath') eq searchAncestorClass('hentry', $ve)->getAttribute('data-cpan-html-microformats-nodepath'); push @{ $self->{'DATA'}->{'author'} }, HTML::Microformats::Format::hCard->new($ve, $self->context); } } unless (@{ $self->{'DATA'}->{'author'} }) { ##TODO: Should really only use the nearest-in-parent. post-0.001 my @address_elements = $self->context->document->getElementsByTagName('address'); foreach my $address (@address_elements) { next unless $address->getAttribute('class') =~ /\b(author)\b/; next unless $address->getAttribute('class') =~ /\b(vcard)\b/; push @{ $self->{'DATA'}->{'author'} }, HTML::Microformats::Format::hCard->new($address, $self->context); } } } sub _title_fallback { my ($self, $element) = @_; unless (defined $self->data->{'title'}) { ELEM: foreach my $tag ($element->getElementsByTagName('*')) { if ($tag->tagName =~ /^h[1-9]?$/i) { $self->data->{'title'} = stringify($tag, 'value'); last ELEM; } } } unless (defined $self->data->{'title'} or searchAncestorClass('hfeed', $element)) { TITLE: foreach my $tag ($self->context->document->getElementsByTagName('title')) { my $str = stringify($tag, 'value'); $self->data->{'title'} = $str; last TITLE if length $str; } } } sub _link_fallback { my ($self, $element) = @_; unless (defined $self->data->{'link'}) { if ($element->hasAttribute('id')) { $self->data->{'link'} = $self->context->uri('#'.$element->getAttribute('id')); } else { $self->data->{'link'} = $self->context->document_uri; } } } sub _reply_handler { my ($self) = @_; FEED: foreach my $feed (@{$self->data->{'replies'}}) { ENTRY: foreach my $entry (@{$feed->data->{'entry'}}) { push @{ $entry->data->{'in-reply-to'} }, $self->data->{'link'}, if defined $self->data->{'link'} && !defined $entry->data->{'in-reply-to'}; } } } sub format_signature { my $awol = 'http://bblfish.net/work/atom-owl/2006-06-06/#'; my $ax = 'http://buzzword.org.uk/rdf/atomix#'; my $iana = 'http://www.iana.org/assignments/relation/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; return { 'root' => ['hentry','hslice','hnews'], 'classes' => [ ['bookmark', 'ru?', {'use-key'=>'link'}], ['entry-content', 'H&', {'use-key'=>'content'}], ['entry-summary', 'H&', {'use-key'=>'summary'}], ['entry-title', '?', {'use-key'=>'title'}], ['in-reply-to', 'Ru*'], #extension ['published', 'd?'], ['replies', 'm*', {'embedded'=>'hAtom'}], #extension ['updated', 'd*', {'datetime-feedthrough' => 'published'}], ['author', '#*'], ], 'options' => { 'rel-tag' => 'category', 'rel-enclosure' => 'enclosure', #extension # 'rel-license' => 'license', #extension }, 'rdf:type' => ["${awol}Entry"] , 'rdf:property' => { 'link' => { resource => ["${iana}self"] } , 'title' => { literal => ["${rdfs}label"] } , 'in-reply-to' => { resource => ["${ax}in-reply-to"] } , 'published' => { literal => ["${awol}published"] } , 'updated' => { literal => ["${awol}updated"] } , 'category' => { resource => ["${awol}category"] } , # 'enclosure' => { resource => ["${iana}enclosure"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $awol = 'http://bblfish.net/work/atom-owl/2006-06-06/#'; my $ax = 'http://buzzword.org.uk/rdf/atomix#'; my $iana = 'http://www.iana.org/assignments/relation/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; foreach my $field (qw(title summary)) { next unless length $self->data->{"html_$field"}; $self->{'id.'.$field} = $self->context->make_bnode unless defined $self->{'id.'.$field}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}${field}"), $self->id(1, $field), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}TextContent"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}xhtml"), RDF::Trine::Node::Literal->new($self->data->{"html_$field"}, undef, "${rdf}XMLLiteral"), )); if (isms($self->data->{$field})) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}text"), RDF::Trine::Node::Literal->new($self->data->{$field}->to_string, $self->data->{$field}->lang), )) } elsif (defined $self->data->{$field}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}text"), RDF::Trine::Node::Literal->new($self->data->{$field}), )) } } foreach my $field (qw(content)) { next unless length $self->data->{"html_$field"}; $self->{'id.'.$field} = $self->context->make_bnode unless defined $self->{'id.'.$field}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}${field}"), $self->id(1, $field), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Content"), )); if (defined $self->data->{"html_$field"}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}type"), RDF::Trine::Node::Literal->new("application/xhtml+xml"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}body"), RDF::Trine::Node::Literal->new($self->data->{"html_$field"}, undef, "${rdf}XMLLiteral"), )); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}type"), RDF::Trine::Node::Literal->new("text/plain"), )); if (isms($self->data->{$field})) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}body"), RDF::Trine::Node::Literal->new($self->data->{$field}->to_string, $self->data->{$field}->lang), )); } elsif (defined $self->data->{$field}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}body"), RDF::Trine::Node::Literal->new($self->data->{$field}), )); } } } foreach my $author (@{ $self->data->{'author'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}author"), $author->id(1, 'holder'), )); $model->add_statement(RDF::Trine::Statement->new( $author->id(1, 'holder'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Person"), )); $model->add_statement(RDF::Trine::Statement->new( $author->id(1, 'holder'), RDF::Trine::Node::Resource->new("${awol}name"), $self->_make_literal($author->data->{fn}) )) if $author->data->{fn}; foreach my $u (@{ $author->data->{'url'} }) { $model->add_statement(RDF::Trine::Statement->new( $author->id(1, 'holder'), RDF::Trine::Node::Resource->new("${awol}uri"), RDF::Trine::Node::Resource->new($u), )); } foreach my $e (@{ $author->data->{'email'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new("${awol}email"), RDF::Trine::Node::Resource->new($e->get_value), )) if $e->get_value =~ /^(mailto):\S+$/i; } $author->add_to_model($model); } foreach my $field (qw(link)) { $self->{'id.'.$field} = $self->context->make_bnode unless defined $self->{'id.'.$field}; $self->{'id.'.$field.'-dest'} = $self->context->make_bnode unless defined $self->{'id.'.$field.'-dest'}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}link"), $self->id(1, $field), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Link"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}rel"), RDF::Trine::Node::Resource->new($iana . ($field eq 'link' ? 'self' : $field)), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field), RDF::Trine::Node::Resource->new("${awol}to"), $self->id(1, "${field}-dest"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "${field}-dest"), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Content"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "${field}-dest"), RDF::Trine::Node::Resource->new("${awol}src"), RDF::Trine::Node::Resource->new($self->data->{$field}), )); } foreach my $field (qw(enclosure)) { for (my $i=0; defined $self->data->{$field}->[$i]; $i++) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${iana}enclosure"), RDF::Trine::Node::Resource->new($self->data->{$field}->[$i]->data->{href}), )); $self->{'id.'.$field.'.'.$i} = $self->context->make_bnode unless defined $self->{'id.'.$field.'.'.$i}; $self->{'id.'.$field.'-dest.'.$i} = $self->context->make_bnode unless defined $self->{'id.'.$field.'-dest.'.$i}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${awol}link"), $self->id(1, $field.'.'.$i), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field.'.'.$i), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Link"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field.'.'.$i), RDF::Trine::Node::Resource->new("${awol}rel"), RDF::Trine::Node::Resource->new($iana . ($field eq 'link' ? 'self' : $field)), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, $field.'.'.$i), RDF::Trine::Node::Resource->new("${awol}to"), $self->id(1, "${field}-dest.${i}"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "${field}-dest.${i}"), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${awol}Content"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "${field}-dest.${i}"), RDF::Trine::Node::Resource->new("${awol}src"), RDF::Trine::Node::Resource->new($self->data->{$field}->[$i]), )); } } return $self; } sub get_uid { my $self = shift; return defined $self->data->{link} ? $self->data->{link} : undef; } sub add_to_model_ical { my $self = shift; my $model = shift; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $icalx= 'http://buzzword.org.uk/rdf/icaltzdx#'; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${ical}Vjournal"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}summary"), $self->_make_literal($self->data->{title}), )) if $self->data->{title}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}comment"), $self->_make_literal($self->data->{summary}), )) if $self->data->{summary}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}description"), $self->_make_literal($self->data->{content}), )) if $self->data->{content}; foreach my $author (@{ $self->data->{'author'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${icalx}organizer"), $author->id(1), )); $author->add_to_model($model); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}uid"), $self->_make_literal($self->data->{link} => 'anyURI'), )) if $self->data->{link}; foreach my $field (qw(enclosure)) { for (my $i=0; defined $self->data->{$field}->[$i]; $i++) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}attach"), RDF::Trine::Node::Resource->new($self->data->{$field}->[$i]->data->{href}), )); } } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}created"), $self->_make_literal($self->data->{published}), )) if $self->data->{published}; if ($self->data->{updated}) { foreach my $u (@{ $self->data->{updated} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}dtstamp"), $self->_make_literal($u), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}last-modified"), $self->_make_literal($u), )); } } # todo - CATEGORIES HTML::Microformats::Format::hEvent::_add_to_model_related($self, $model); return $self; } sub to_atom { my ($self) = @_; die "Need XML::Atom::FromOWL to export Atom.\n" unless $HAS_ATOM_EXPORT; my $exporter = XML::Atom::FromOWL->new; return $exporter->export_entry($self->model, $self->id(1))->as_xml; } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HTML::Microformats::Format::hCalendar::HAS_ICAL_EXPORT; my $model = $self->model; $self->add_to_model_ical($model); my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_component($model, $self->id(1))->to_string; } sub profiles { my @p = qw(http://microformats.org/profile/hatom http://ufs.cc/x/hatom http://purl.org/uF/hAtom/0.1/); push @p, HTML::Microformats::Format::hNews->profiles; return @p; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hReview/0000755000076400007640000000000011775404022021674 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Format/hReview/rating.pm0000644000076400007640000000773211775403507023536 0ustar taitai=head1 NAME HTML::Microformats::Format::hReview::rating - helper for hReviews; handles the rating property =head1 DESCRIPTION Technically, this inherits from HTML::Microformats::Format, so can be used in the same way as any of the other microformat module, though I don't know why you'd want to. It does not implement the include pattern, instead relying on the hReview implementation to do so. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Format::hReview::rating; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify searchClass); use XML::LibXML qw(:libxml); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hReview::rating::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hReview::rating::VERSION = '0.105'; } sub new { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.holder' => $context->make_bnode , }; bless $self, $class; # Find value - that's the easy part. $self->{'DATA'}->{'value'} = stringify($element, 'value'); # If element is a descendent of something with rel=tag, # then ascend the tree to find that. my $parent = $element; while (defined $parent && ref $parent && $parent->nodeType == XML_ELEMENT_NODE) { last if $parent->getAttribute('rel') =~ /\b(tag)\b/i; $parent = $parent->parentNode; } $parent = undef unless $parent->nodeType == XML_ELEMENT_NODE && $parent->getAttribute('rel') =~ /\b(tag)\b/i; # Search for class=best|worst within $element, # or in higher rel=tag element. my $root_node = $parent || $element; foreach my $limit (qw(best worst)) { my @elems = searchClass($limit, $root_node); $self->{'DATA'}->{$limit} = stringify($elems[0], {'abbr-pattern'=>1}); } # Default them to 0.0 and 5.0. $self->{'DATA'}->{'worst'} = '0.0' unless defined $self->{'DATA'}->{'worst'}; $self->{'DATA'}->{'best'} = '5.0' unless defined $self->{'DATA'}->{'best'}; if ($parent) # only defined if $element has a rel=tag ancestor { $self->{'DATA'}->{'tag'} = [ HTML::Microformats::Format::RelTag->new($parent, $context) ]; } else { $self->{'DATA'}->{'tag'} = [ HTML::Microformats::Format::RelTag->extract_all($element, $context) ]; } $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $self = shift; my $rev = 'http://www.purl.org/stuff/rev#'; my $hreview = 'http://ontologi.es/hreview#'; my $rv = { 'root' => 'rating', 'classes' => [ ['value', 'n?v#'], ['best', 'n?v#'], ['worst', 'n?v#'], ], 'options' => { 'rel-tag' => 'tag', }, 'rdf:type' => ["${hreview}Rating"] , 'rdf:property' => { 'value' => { 'literal' => ["http://www.w3.org/1999/02/22-rdf-syntax-ns#value"] , 'literal_datatype' => 'decimal' }, 'best' => { 'literal' => ["${hreview}best"] , 'literal_datatype' => 'decimal' }, 'worst' => { 'literal' => ["${hreview}worst"] , 'literal_datatype' => 'decimal' }, 'tag' => { 'resource' => ["${hreview}rated-on"] }, }, }; return $rv; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Format/XFN.pm0000644000076400007640000003376211775403507021276 0ustar taitai=head1 NAME HTML::Microformats::Format::XFN - the XFN microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::XFN; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @links = HTML::Microformats::Format::XFN->extract_all( $dom->documentElement, $context); foreach my $link (@links) { printf("<%s> %s\n", $link->get_href, join(" ", $link->get_rel)); } =head1 DESCRIPTION HTML::Microformats::Format::XFN inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::XFN; use base qw(HTML::Microformats::Format); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify searchAncestorClass); use HTML::Microformats::Format::hCard; use RDF::Trine; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::XFN::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::XFN::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = bless { 'element' => $element , 'context' => $context , 'cache' => $cache , }, $class; # Extract XFN-related @rel values. $self->_extract_xfn_relationships; # If none, then just return undef. return undef unless @{ $self->{'DATA'}->{'rel'} } || @{ $self->{'DATA'}->{'rev'} }; $self->{'DATA'}->{'href'} = $context->uri( $element->getAttribute('href') ); $self->{'DATA'}->{'label'} = stringify($element, 'value'); $self->{'DATA'}->{'title'} = $element->hasAttribute('title') ? $element->getAttribute('title') : $self->{'DATA'}->{'label'}; $self->{'id'} = $self->{'DATA'}->{'href'}; $self->{'id.person'} = $context->make_bnode; my $hcard_element = searchAncestorClass('vcard', $element, 0); if ($hcard_element) { $self->{'hcard'} = HTML::Microformats::Format::hCard->new($hcard_element, $context); if ($self->{'hcard'}) { $self->{'id.person'} = $self->{'hcard'}->id(0, 'holder'); } } $self->context->representative_hcard; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub extract_all { my ($class, $dom, $context) = @_; my @links = $dom->getElementsByTagName('link'); push @links, $dom->getElementsByTagName('a'); push @links, $dom->getElementsByTagName('area'); my @rv; foreach my $link (@links) { my $xfn = $class->new($link, $context); push @rv, $xfn if defined $xfn; } return @rv; } sub _extract_xfn_relationships { my ($self) = @_; my $R = $self->_xfn_relationship_types; my $regexp = join '|', keys %$R; $regexp = "($regexp)"; DIR: foreach my $direction (qw(rel rev)) { if ($self->{'element'}->hasAttribute($direction)) { my @matches = grep { $_ =~ /^($regexp)$/ } split /\s+/, $self->{'element'}->getAttribute($direction); next DIR unless @matches; $self->{'DATA'}->{$direction} = [ map { lc $_ } @matches ]; } } } sub add_to_model { my ($self, $model) = @_; my $R = $self->_xfn_relationship_types; foreach my $r (@{ $self->data->{'rel'} }) { next if lc $r eq 'me'; my ($page_link, $person_link); my ($flags, $other) = split /\:/, $R->{$r}, 2; if ($flags =~ /E/i) { $page_link = "http://buzzword.org.uk/rdf/xen#${r}-hyperlink"; $person_link = "http://buzzword.org.uk/rdf/xen#${r}"; } elsif ($flags =~ /R/i) { $page_link = "http://vocab.sindice.com/xfn#human-relationship-hyperlink"; $person_link = "http://purl.org/vocab/relationship/${r}"; } else { $page_link = "http://vocab.sindice.com/xfn#${r}-hyperlink"; $person_link = "http://vocab.sindice.com/xfn#${r}"; } $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new( $self->context->document_uri ), RDF::Trine::Node::Resource->new( $page_link ), RDF::Trine::Node::Resource->new( $self->data->{'href'} ), )); $model->add_statement(RDF::Trine::Statement->new( $self->context->representative_person_id(1), RDF::Trine::Node::Resource->new( $person_link ), $self->id(1, 'person'), )); if ($flags =~ /K/i) { $model->add_statement(RDF::Trine::Statement->new( $self->context->representative_person_id(1), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/knows' ), $self->id(1, 'person'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/knows' ), $self->context->representative_person_id(1), )) if $flags =~ /S/i; } $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( $person_link ), $self->context->representative_person_id(1), )) if $flags =~ /S/i; $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new($other), $self->context->representative_person_id(1), )) if $flags =~ /I/i && length $other; } foreach my $r (@{ $self->data->{'rev'} }) { next if lc $r eq 'me'; my $person_link; my ($flags, $other) = split /\:/, $R->{$r}, 2; if ($flags =~ /E/i) { $person_link = "http://buzzword.org.uk/rdf/xen#${r}"; } elsif ($flags =~ /R/i) { $person_link = "http://purl.org/vocab/relationship/${r}"; } else { $person_link = "http://vocab.sindice.com/xfn#${r}"; } $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( $person_link ), $self->context->representative_person_id(1), )); if ($flags =~ /K/i) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/knows' ), $self->context->representative_person_id(1), )); $model->add_statement(RDF::Trine::Statement->new( $self->context->representative_person_id(1), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/knows' ), $self->id(1, 'person'), )) if $flags =~ /S/i; } $model->add_statement(RDF::Trine::Statement->new( $self->context->representative_person_id(1), RDF::Trine::Node::Resource->new( $person_link ), $self->id(1, 'person'), )) if $flags =~ /S/i; $model->add_statement(RDF::Trine::Statement->new( $self->context->representative_person_id(1), RDF::Trine::Node::Resource->new($other), $self->id(1, 'person'), )) if $flags =~ /I/i && length $other; } $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' ), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/Person' ), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'person'), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/'.($self->data->{'href'} =~ /^mailto:/i ? 'mbox' : 'page') ), RDF::Trine::Node::Resource->new( $self->data->{'href'} ), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new( $self->data->{'href'} ), RDF::Trine::Node::Resource->new( 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' ), RDF::Trine::Node::Resource->new( 'http://xmlns.com/foaf/0.1/Document' ), )) unless $self->data->{'href'} =~ /^mailto:/i; if (grep /^me$/i, @{ $self->data->{'rel'} }) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new( $self->context->document_uri ), RDF::Trine::Node::Resource->new( 'http://vocab.sindice.com/xfn#me-hyperlink' ), RDF::Trine::Node::Resource->new( $self->data->{'href'} ), )); } if (grep /^me$/i, @{ $self->data->{'rev'} }) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new( $self->data->{'href'} ), RDF::Trine::Node::Resource->new( 'http://vocab.sindice.com/xfn#me-hyperlink' ), RDF::Trine::Node::Resource->new( $self->context->document_uri ), )); } } sub profiles { my $class = shift; return qw(http://gmpg.org/xfn/11 http://purl.org/uF/2008/03/ http://gmpg.org/xfn/1 http://microformats.org/profile/specs http://ufs.cc/x/specs http://xen.adactio.com/ http://purl.org/vocab/relationship/); } sub id { my ($self, $trine, $relation) = @_; if ($relation eq 'person') { if (grep /^me$/i, @{ $self->data->{'rel'} } or grep /^me$/i, @{ $self->data->{'rev'} }) { return $self->context->representative_person_id($trine); } } $self->SUPER::id($trine, $relation); } sub _xfn_relationship_types { my ($self) = @_; # FLAGS # ===== # # S = symmetric # K = foaf:knows # I = has inverse # T = transitive # E = enemies vocab # R = relationship vocab # my %xfn11 = ( 'contact' => ':', 'acquaintance' => 'K:', 'friend' => 'K:', 'met' => 'SK:', 'co-worker' => 'S:', 'colleague' => 'S:', 'co-resident' => 'SKT:', 'neighbor' => 'S:', 'child' => 'I:http://vocab.sindice.com/xfn#parent', 'parent' => 'I:http://vocab.sindice.com/xfn#child', 'sibling' => 'S:', 'spouse' => 'SK:', 'kin' => 'S:', 'muse' => ':', 'crush' => 'K:', 'date' => 'SK:', 'sweetheart' => 'SK:', 'me' => 'S:', ); my %R; # relationship types if ($self->context->has_profile('http://gmpg.org/xfn/11', 'http://purl.org/uF/2008/03/')) { %R = %xfn11; } elsif ($self->context->has_profile('http://gmpg.org/xfn/1')) { %R = ( 'acquaintance' => 'K:', 'friend' => 'K:', 'met' => 'SK:', 'co-worker' => 'S:', 'colleague' => 'S:', 'co-resident' => 'SKT:', 'neighbor' => 'S:', 'child' => 'I:http://vocab.sindice.com/xfn#parent', 'parent' => 'I:http://vocab.sindice.com/xfn#child', 'sibling' => 'S:', 'spouse' => 'SK:', 'muse' => ':', 'crush' => 'K:', 'date' => 'SK:', 'sweetheart' => 'SK:', ); } if ($self->context->has_profile('http://xen.adactio.com/')) { $R{'nemesis'} = 'SKE:'; $R{'enemy'} = 'KE:'; $R{'nuisance'} = 'KE:'; $R{'evil-twin'} = 'SE:'; $R{'rival'} = 'KE:'; $R{'fury'} = 'E:'; $R{'creep'} = 'E:'; } if ($self->context->has_profile('http://purl.org/vocab/relationship/')) { $R{'acquaintanceOf'} = 'KR:'; $R{'ambivalentOf'} = 'R:'; $R{'ancestorOf'} = 'RI:http://purl.org/vocab/relationship/descendantOf'; $R{'antagonistOf'} = 'KR:'; $R{'apprenticeTo'} = 'KR:'; $R{'childOf'} = 'KRI:http://purl.org/vocab/relationship/parentOf'; $R{'closeFriendOf'} = 'KR:'; $R{'collaboratesWith'} = 'SKR:'; $R{'colleagueOf'} = 'SKR:'; $R{'descendantOf'} = 'RI:http://purl.org/vocab/relationship/ancestorOf'; $R{'employedBy'} = 'KRI:http://purl.org/vocab/relationship/employerOf'; $R{'employerOf'} = 'KRI:http://purl.org/vocab/relationship/employedBy'; $R{'enemyOf'} = 'KR:'; $R{'engagedTo'} = 'SKR:'; $R{'friendOf'} = 'KR:'; $R{'grandchildOf'} = 'KRI:http://purl.org/vocab/relationship/grandparentOf'; $R{'grandparentOf'} = 'KRI:http://purl.org/vocab/relationship/grandchildOf'; $R{'hasMet'} = 'SKR:'; $R{'influencedBy'} = 'R:'; $R{'knowsByReputation'} = 'R:'; $R{'knowsInPassing'} = 'KR:'; $R{'knowsOf'} = 'R:'; $R{'lifePartnerOf'} = 'SKR:'; $R{'livesWith'} = 'SKR:'; $R{'lostContactWith'} = 'KR:'; $R{'mentorOf'} = 'KR:'; $R{'neighborOf'} = 'SKR:'; $R{'parentOf'} = 'KRI:http://purl.org/vocab/relationship/childOf'; $R{'siblingOf'} = 'SKR:'; $R{'spouseOf'} = 'SKR:'; $R{'worksWith'} = 'SKR:'; $R{'wouldLikeToKnow'} = 'R:'; } return \%R if %R; return \%xfn11; } =head2 Additional Public Methods =over 4 =item C<< $xfn->subject_hcard >> Returns the hCard for the subject of the relationship. e.g. if Mary has parent Sue, then Mary is the subject. If the subject could not be determined, may return undef. =cut sub subject_hcard { my $self = shift; return $self->context->representative_hcard; } =item C<< $xfn->object_hcard >> Returns the hCard for the object of the relationship. e.g. if Mary has parent Sue, then Sue is the object. The person that is the object of the relationship may not have an hCard on this page, or the parser may not be able to determine the correct hCard, in which case, may return undef. =back =cut sub object_hcard { my $self = shift; return $self->{'hcard'}; } 1; =head1 MICROFORMAT HTML::Microformats::Format::XFN supports XHTML Friends Network 1.0 and 1.1 as described at L and L; plus the relationship profile described at L; and XHTML Enemies Network 1.0 as described at L. By default, only XFN 1.1 is parsed, but if the context has profiles matching the other URIs above, then the other vocabularies are supported. =head1 RDF OUTPUT Data is returned using the DERI's XFN vocabulary (L) and when appropriate, Ian Davis' RDF relationship vocab (L) and Toby Inkster's XEN vocab (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hResume.pm0000644000076400007640000002404111775403507022241 0ustar taitai=head1 NAME HTML::Microformats::Format::hResume - the hResume microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hResume; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @resumes = HTML::Microformats::Format::hResume->extract_all( $dom->documentElement, $context); foreach my $resume (@resumes) { print $resume->get_contact->get_fn . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hResume inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hResume; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hResume::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hResume::VERSION = '0.105'; } sub new { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $self->{'DATA'}->{'contact'} = $self->{'DATA'}->{'address'} unless defined $self->{'DATA'}->{'contact'}; if (defined $self->{'DATA'}->{'contact'}) { $self->{'id.holder'} = $self->{'DATA'}->{'contact'}->id(0, 'holder'); } else { $self->{'id.holder'} = $context->make_bnode; } # # Create links between hCard and hCalendar events found within! # foreach my $prop (qw(education experience)) # { # foreach my $e ( @{$self->{'DATA'}->{$prop}} ) # { # foreach my $ehc ( @{$self->{'DATA'}->{$prop.'-hcard'}} ) # { # my $ehcxp = $ehc->{'parent_property_node'}->getAttribute('data-cpan-html-microformats-nodepath'); # if ($ehcxp eq $e->{'parent_property_node'}->getAttribute('data-cpan-html-microformats-nodepath')) # { # $e -> {'associated_hcard'} = $ehc; # $ehc -> {'associated_hevent'} = $e; # } # } # } # # foreach my $card ( @{$self->{'DATA'}->{$prop.'-hcard'}} ) # { # $card->{'id.holder'} = $self->id(0, 'holder'); # } # # delete $self->{'DATA'}->{$prop.'-hcard'}; # } $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $self = shift; my $cv = "http://purl.org/captsolo/resume-rdf/0.2/cv#"; my $cvx = "http://ontologi.es/hresume#"; # parsing hCards seems to do more harm than good! my $rv = { 'root' => 'hresume', 'classes' => [ ['summary', '?'], ['contact', 'm?', {'embedded'=>'hCard'}], ['address', 'tm?', {'embedded'=>'hCard'}], ['education', 'm*', {'embedded'=>'hEvent', 'allow-interleaved' => ['vcalendar']}], #}],, 'again-again'=>1}], #['education', 'm*', {'embedded'=>'hCard', 'allow-interleaved' => ['vcalendar', 'vevent'], 'use-key'=>'education-hcard'}], ['experience', 'm*', {'embedded'=>'hEvent', 'allow-interleaved' => ['vcalendar']}], #}],, 'again-again'=>1}], #['experience', 'm*', {'embedded'=>'hCard', 'allow-interleaved' => ['vcalendar', 'vevent'], 'use-key'=>'experience-hcard'}], ['skill', '*'], ['affiliation', 'M*', {'embedded'=>'hCard'}], ['cite', 't', {'use-key'=>'publication'}] ], 'options' => { }, 'rdf:type' => ["${cv}CV"] , 'rdf:property' => { 'summary' => { 'literal' => ["${cv}cvDescription"] }, 'experience' => { 'resource' => ["${cvx}experience"] }, 'education' => { 'resource' => ["${cvx}education"] }, 'contact' => { 'resource' => ["${cvx}contact"] }, 'affiliation' => { 'resource' => ["${cvx}affiliation"] }, 'publication' => { 'literal' => ["${cvx}publication"] }, 'skill' => { 'literal' => ["${cvx}skill"] }, }, }; return $rv; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $cv = "http://purl.org/captsolo/resume-rdf/0.2/cv#"; my $rdf = "http://www.w3.org/1999/02/22-rdf-syntax-ns#"; my $cvx = "http://ontologi.es/hresume#"; if (defined $self->data->{'contact'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${cv}aboutPerson"), $self->id(1, 'holder'), )); $self->data->{'contact'}->add_to_model($model); } foreach my $experience (@{$self->data->{'experience'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${cv}hasWorkHistory"), $experience->id(1, 'experience'), )); $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${cv}WorkHistory"), )); $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${cvx}ical-component"), $experience->id(1), )); $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${cvx}business-card"), $experience->{'associated_vcard'}->id(1), )) if defined $experience->{'associated_vcard'}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new("http://purl.org/uF/hCard/terms/hasHistoricCard"), $experience->{'associated_vcard'}->id(1), )) if defined $experience->{'associated_vcard'}; $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${cv}startDate"), $self->_make_literal($experience->data->{'dtstart'}, 'dateTime'), )) if defined $experience->data->{'dtstart'}; $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${cv}endDate"), $self->_make_literal($experience->data->{'dtend'}, 'dateTime'), )) if defined $experience->data->{'dtend'}; if (defined $experience->{'associated_hcard'} && defined $experience->{'associated_hcard'}->data->{'title'}) { $model->add_statement(RDF::Trine::Statement->new( $experience->id(1, 'experience'), RDF::Trine::Node::Resource->new("${cv}jobTitle"), $self->_make_literal($experience->{'associated_hcard'}->data->{'title'}), )); } $experience->add_to_model($model); $experience->{'associated_hcard'}->add_to_model($model) if defined $experience->{'associated_hcard'}; } foreach my $edu (@{$self->data->{'education'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${cv}hasEducation"), $edu->id(1, 'education'), )); $model->add_statement(RDF::Trine::Statement->new( $edu->id(1, 'education'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${cv}Education"), )); $model->add_statement(RDF::Trine::Statement->new( $edu->id(1, 'education'), RDF::Trine::Node::Resource->new("${cvx}ical-component"), $edu->id(1), )); $model->add_statement(RDF::Trine::Statement->new( $edu->id(1, 'education'), RDF::Trine::Node::Resource->new("${cvx}business-card"), $edu->{'associated_vcard'}->id(1), )) if defined $edu->{'associated_vcard'}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'holder'), RDF::Trine::Node::Resource->new("http://purl.org/uF/hCard/terms/hasHistoricCard"), $edu->{'associated_vcard'}->id(1), )) if defined $edu->{'associated_vcard'}; $model->add_statement(RDF::Trine::Statement->new( $edu->id(1, 'education'), RDF::Trine::Node::Resource->new("${cv}eduStartDate"), $self->_make_literal($edu->data->{'dtstart'}, 'dateTime'), )) if defined $edu->data->{'dtstart'}; $model->add_statement(RDF::Trine::Statement->new( $edu->id(1, 'education'), RDF::Trine::Node::Resource->new("${cv}eduGradDate"), $self->_make_literal($edu->data->{'dtend'}, 'dateTime'), )) if defined $edu->data->{'dtend'}; $edu->add_to_model($model); $edu->{'associated_hcard'}->add_to_model($model) if defined $edu->{'associated_hcard'}; } foreach my $skill (@{$self->data->{'skill'}}) { my $skill_bnode = $self->id(1, 'skill.'.$skill); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${cv}hasSkill"), $skill_bnode, )); $model->add_statement(RDF::Trine::Statement->new( $skill_bnode, RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${cv}Skill"), )); $model->add_statement(RDF::Trine::Statement->new( $skill_bnode, RDF::Trine::Node::Resource->new("${cv}skillName"), $self->_make_literal($skill), )); } return $self; } sub profiles { my $class = shift; return qw(http://microformats.org/profile/hresume http://ufs.cc/x/hresume http://purl.org/uF/hResume/0.1/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hResume supports hResume as described at L. =head1 RDF OUTPUT The RDF output is modelled on Uldis Bojars' ResumeRDF Ontology L, with some additional terms from Toby Inkster's hResume vocab . =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hAudio.pm0000644000076400007640000002104111775403507022037 0ustar taitai=head1 NAME HTML::Microformats::Format::hAudio - the hAudio microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hAudio; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @haudios = HTML::Microformats::Format::hAudio->extract_all( $dom->documentElement, $context); foreach my $haudio (@haudios) { print $haudio->get_fn . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hAudio inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hAudio; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hAudio::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hAudio::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); # Items - too tricky for simple_parse() to handle! my ($this_item, $last_item); my @items = searchClass('item', $clone); foreach my $i (@items) { # Deal with ".haudio .item .item", etc! This shuld work... if (length $last_item) { $this_item = $i->getAttribute('data-cpan-html-microformats-nodepath'); next if substr($this_item, 0, length $last_item) eq $last_item; } $last_item = $i->getAttribute('data-cpan-html-microformats-nodepath'); my $I = $class->new($i, $context); $I->{'DATA'}->{'title'} = stringify($i, 'value') unless defined $I->{'DATA'}->{'fn'} || defined $I->{'DATA'}->{'album'}; $I->{'related'}->{'parent'} = $self; push @{ $self->{'DATA'}->{'item'} }, $I; $self->_destroy_element($i); } $self->_simple_parse($clone); # Does this represent an album or a track? # http://microformats.org/wiki/haudio#More_Semantic_Equivalents if (defined $self->{'DATA'}->{'fn'} && defined $self->{'DATA'}->{'album'}) { $self->{'DATA'}->{'type'} = 'track'; } elsif (defined $self->{'DATA'}->{'album'}) { $self->{'DATA'}->{'type'} = 'album'; } else { $self->{'DATA'}->{'type'} = 'track'; } $self->_do_inheritance; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _do_inheritance { my $self = shift; ITEM: foreach my $item (@{ $self->{'DATA'}->{'item'} }) { PROPERTY: foreach my $property (qw(album contributor category published photo)) { next PROPERTY if defined $item->{'DATA'}->{$property}; $item->{'DATA'}->{$property} = $self->{'DATA'}->{$property}; } # Recursion. $item->_do_inheritance; } return $self; } sub format_signature { my $media = 'http://purl.org/media#'; my $audio = 'http://purl.org/media/audio#'; my $comm = 'http://purl.org/commerce#'; my $dc = 'http://purl.org/dc/terms/'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; return { 'root' => 'haudio', 'classes' => [ ['album', '?'], ['category', '*'], ['contributor', 'M*', {embedded=>'hCard'}], ['description', '&'], ['duration', 'D?'], ['enclosure', 'ru*'], ['fn', '?'], ['item', '*#'], ['payment', 'ru*'], ['position', 'n?'], ['photo', 'u*'], ['price', 'M?', {embedded=>'hMeasure'}], ['published', 'd*'], ['publisher', 'M*', {embedded=>'hCard'}], # extension ['sample', 'ru*'], ['title', '?', {'use-key'=>'fn'}], # fallback (historical) ['type', '?#'], # always inferred ['url', 'u*'] ], 'options' => { 'rel-tag' => 'category', }, 'rdf:type' => [] , 'rdf:property' => { 'category' => { resource => ["{$dc}type"] , literal => ["{$dc}type"] } , 'contributor' => { resource => ["{$dc}contributor"] } , 'description' => { literal => ["{$dc}description"] } , 'duration' => { literal => ["{$media}duration"] } , 'enclosure' => { resource => ["{$media}download"] } , 'item' => { resource => ["{$media}contains"] } , 'payment' => { resource => ["{$comm}payment"] } , 'photo' => { resource => ["{$media}depiction"] } , 'price' => { literal => ["{$comm}costs"] , resource => ['http://buzzword.org.uk/rdf/measure-aux#hasMeasurement'] } , 'publisher' => { resource => ["{$dc}publisher"] } , 'published' => { literal => ["{$dc}published"] } , 'sample' => { resource => ["{$media}sample"] } , 'url' => { resource => ['http://xmlns.com/foaf/0.1/page'] }, }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $media = 'http://purl.org/media#'; my $audio = 'http://purl.org/media/audio#'; my $comm = 'http://purl.org/commerce#'; my $dc = 'http://purl.org/dc/terms/'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; if ($self->get_type eq 'album') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${audio}Album"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rdfs}label"), $self->_make_literal($self->get_album), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${dc}title"), $self->_make_literal($self->get_album), )); } elsif ($self->get_type eq 'track') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${audio}Recording"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rdfs}label"), $self->_make_literal($self->get_fn), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${dc}title"), $self->_make_literal($self->get_fn), )); if (defined $self->get_album && (!defined $self->{'related'}->{'parent'} || $self->{'related'}->{'parent'}->get_album ne $self->get_album)) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'album'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${audio}Album"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'album'), RDF::Trine::Node::Resource->new("${rdfs}label"), $self->_make_literal($self->get_album), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'album'), RDF::Trine::Node::Resource->new("${dc}title"), $self->_make_literal($self->get_album), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'album'), RDF::Trine::Node::Resource->new("${media}contains"), $self->id(1), )); } } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/hAudio/0.9/ http://purl.org/NET/haudio); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hAudio supports hAudio 0.91 as described at L, plus: =over 4 =item * 'publisher' property A 'publisher' property with an embedded hCard can be used to indicate the publisher of the audio item (e.g. record label). =item * 'title' property In earlier drafts pf hAudio, the 'fn' property was called 'title'. This module supports the older class name for backwards compatibility. When both are provided, only 'fn' will be used. =back =head1 RDF OUTPUT RDF output uses Manu Sporny's audio vocabulary L. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/RelTag.pm0000644000076400007640000000740111775403507022010 0ustar taitai=head1 NAME HTML::Microformats::Format::RelTag - the rel-tag microformat =head1 SYNOPSIS my @tags = HTML::Microformats::Format::RelTag->extract_all( $doc->documentElement, $context); foreach my $tag (@tags) { print $tag->get_href . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::RelTag inherits from HTML::Microformats::Format_Rel. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Methods =over 4 =item C<< $reltag->get_tag() >> Returns the tag being linked to. Given the following link: http://example.com/foo/bar?baz=quux#xyzzy the tag is "bar". =item C<< $reltag->get_tagspace() >> Returns the tagspace of the tag being linked to. Given the following link: http://example.com/foo/bar?baz=quux#xyzzy the tagspace is "http://example.com/foo/". =back =cut package HTML::Microformats::Format::RelTag; use base qw(HTML::Microformats::Format_Rel); use strict qw(subs vars); no warnings; use 5.010; use CGI::Util qw(unescape); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::RelTag::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::RelTag::VERSION = '0.105'; } sub new { my $class = shift; my $self = $class->SUPER::new(@_); my $tag = $self->{'DATA'}->{'href'}; $tag =~ s/\#.*$//; $tag =~ s/\?.*$//; $tag =~ s/\/$//; if ($tag =~ m{^(.*/)([^/]+)$}) { $self->{'DATA'}->{'tagspace'} = $1; $self->{'DATA'}->{'tag'} = unescape($2); } return $self; } sub format_signature { my $t = 'http://www.holygoat.co.uk/owl/redwood/0.1/tags/'; my $awol = 'http://bblfish.net/work/atom-owl/2006-06-06/#'; return { 'rel' => 'tag' , 'classes' => [ ['tag', '1#'] , ['tagspace', '1#'] , ['href', '1#'] , ['label', '1#'] , ['title', '1#'] , ] , 'rdf:type' => ["${t}Tag","${awol}Category"] , 'rdf:property' => { 'tag' => { 'literal' => ["${awol}term", "${t}name", "http://www.w3.org/2000/01/rdf-schema#label"] }, 'tagspace' => { 'resource' => ["${awol}scheme"] }, 'href' => { 'resource' => ["http://xmlns.com/foaf/0.1/page"] }, } , } } sub profiles { return qw(http://microformats.org/profile/rel-tag http://ufs.cc/x/rel-tag http://microformats.org/profile/specs http://ufs.cc/x/specs http://purl.org/uF/rel-tag/1.0/ http://purl.org/uF/2008/03/); } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new('http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'), $self->id(1), )); return $self; } 1; =head1 MICROFORMAT HTML::Microformats::Format::RelTag supports rel-tag as described at L. The "title" attribute on the link, and the linked text are taken to be significant. =head1 RDF OUTPUT Data is returned using the Richard Newman's tag vocabulary (L), the Atom OWL vocabulary (L) and occasional other terms. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hTodo.pm0000644000076400007640000002310711775403507021710 0ustar taitai=head1 NAME HTML::Microformats::Format::hTodo - an hCalendar todo component =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCalendar; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cals = HTML::Microformats::Format::hCalendar->extract_all( $dom->documentElement, $context); foreach my $cal (@cals) { foreach my $todo ($cal->get_vtodo) { printf("%s: %s\n", $todo->get_due, $todo->get_summary); } } =head1 DESCRIPTION HTML::Microformats::Format::hTodo is a helper module for HTML::Microformats::Format::hCalendar. This class is used to represent todo components within calendars. Generally speaking, you want to use HTML::Microformats::Format::hCalendar instead. HTML::Microformats::Format::hTodo inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_icalendar >> This method exports the data in iCalendar format. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hTodo; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify searchClass); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hTodo::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hTodo::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $self->_parse_related($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _parse_related { HTML::Microformats::Format::hEvent::_parse_related(@_); } sub extract_all { my ($class, $element, $context) = @_; my @todos = HTML::Microformats::Format::extract_all($class, $element, $context); foreach my $list (searchClass('vtodo-list', $element)) { push @todos, $class->extract_all_xoxo($list, $context); } return @todos; } sub format_signature { my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $icalx = 'http://buzzword.org.uk/rdf/icaltzdx#'; return { 'root' => 'vtodo', 'classes' => [ ['attach', 'u*'], ['attendee', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['categories', '*'], ['category', '*', {'use-key'=>'categories'}], ['class', '?', {'value-title'=>'allow'}], ['comment', '*'], ['completed', 'd?'], ['contact', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['created', 'd?'], ['description', '?'], #['dtend', 'd?'], ['dtstamp', 'd?'], ['dtstart', 'd1'], ['due', 'd?'], ['duration', 'D?'], ['exdate', 'd*'], ['exrule', 'e*'], ['geo', 'M*', {embedded=>'geo'}], ['last-modified', 'd?'], ['location', 'M*', {embedded=>'hCard adr geo'}], ['organizer', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['percent-complete', '?'], ['priority', '?', {'value-title'=>'allow'}], ['rdate', 'd*'], ['recurrance-id', 'U?'], ['resource', '*', {'use-key'=>'resources'}], ['resources', '*'], ['rrule', 'e*'], ['sequence', 'n?', {'value-title'=>'allow'}], ['status', '?', {'value-title'=>'allow'}], ['summary', '1'], #['transp', '?'], ['uid', 'U?'], ['url', 'U?'], ['valarm', 'M*', {embedded=>'hAlarm'}], ['x-sighting-of', 'M*', {embedded=>'species'}] #extension ], 'options' => { 'rel-tag' => 'categories', 'rel-enclosure' => 'attach', 'hmeasure' => 'measures' }, 'rdf:type' => ["${ical}Vtodo"] , 'rdf:property' => { # 'attach' => { 'resource' => ["${ical}attach"] } , 'attendee' => { 'resource' => ["${ical}attendee"], 'literal' => ["${icalx}attendee-literal"] } , 'categories' => { 'resource' => ["${icalx}category"], 'literal' => ["${ical}category"] }, 'class' => { 'literal' => ["${ical}class"] , 'literal_datatype' => 'string'} , 'comment' => { 'literal' => ["${ical}comment"] } , 'completed' => { 'literal' => ["${ical}completed"] } , 'contact' => { 'resource' => ["${icalx}contact"], 'literal' => ["${ical}contact"] } , 'created' => { 'literal' => ["${ical}created"] } , 'description' => { 'literal' => ["${ical}description"] } , 'dtend' => { 'literal' => ["${ical}dtend"] } , 'dtstamp' => { 'literal' => ["${ical}dtstamp"] } , 'dtstart' => { 'literal' => ["${ical}dtstart"] } , 'due' => { 'literal' => ["${ical}due"] } , 'duration' => { 'literal' => ["${ical}duration"] } , 'exdate' => { 'literal' => ["${ical}exdate"] } , 'geo' => { 'literal' => ["${icalx}geo"] } , 'last-modified' => { 'literal' => ["${ical}lastModified"] } , 'location' => { 'resource' => ["${icalx}location"], 'literal' => ["${ical}location"] } , 'organizer' => { 'resource' => ["${ical}organizer"], 'literal' => ["${icalx}organizer-literal"] } , 'percent-complete' => { 'literal' => ["${ical}percentComplete"] , 'literal_datatype' => 'integer' } , 'priority' => { 'literal' => ["${ical}priority"] } , 'rdate' => { 'literal' => ["${ical}rdate"] } , 'recurrance-id' => { 'resource' => ["${ical}recurranceId"] , 'literal' => ["${ical}recurranceId"] , 'literal_datatype' => 'string' } , 'resources' => { 'literal' => ["${ical}resources"] } , 'sequence' => { 'literal' => ["${ical}sequence"] , 'literal_datatype' => 'integer' } , 'status' => { 'literal' => ["${ical}status"] , 'literal_datatype' => 'string' } , 'summary' => { 'literal' => ["${ical}summary"] } , 'transp' => { 'literal' => ["${ical}transp"] , 'literal_datatype' => 'string' } , 'uid' => { 'resource' => ["${ical}uid"] , 'literal' => ["${ical}uid"] , 'literal_datatype' => 'string' } , 'url' => { 'resource' => ["${ical}url"] } , 'valarm' => { 'resource' => ["${ical}valarm"] } , 'x-sighting-of' => { 'resource' => ["${ical}x-sighting-of"] } , }, }; } sub add_to_model { # essentially the same... return HTML::Microformats::Format::hEvent::add_to_model(@_); } sub profiles { return HTML::Microformats::Format::hCalendar::profiles(@_); } sub extract_all_xoxo { my ($class, $element, $context) = @_; return qw() unless $element->tagName =~ /^(ul|ol)$/i; my @all_items; foreach my $li ($element->getChildrenByTagName('li')) { my @these_items = $class->extract_all_xoxo_item($li, $context); push @all_items, @these_items; } return @all_items; } sub extract_all_xoxo_item { my ($class, $element, $context) = @_; return qw() unless $element->tagName eq 'li'; my $clone = $element->cloneNode(1); # Find any child XOXO-style lists. Parse then discard. my @child_items; foreach my $list ($clone->getChildrenByTagName('ol')) { my @these_items = $class->extract_all_xoxo($list, $context); push @child_items, @these_items; $clone->removeChild($list); } foreach my $list ($clone->getChildrenByTagName('ul')) { my @these_items = $class->extract_all_xoxo($list, $context); push @child_items, @these_items; $clone->removeChild($list); } my $self = $class->new($clone, $context); unless (length $self->data->{'summary'}) { $self->data->{'summary'} = stringify($clone); } my @rv = ($self); CHILD: foreach my $child (@child_items) { if (defined $child->{'related'}->{'parent'} or defined $child->{'DATA'}->{'parent'}) { push @{$child->{'related'}->{'other'}}, $self; push @{$self->{'related'}->{'other'}}, $child; } else { $child->{'related'}->{'parent'} = $self; push @{$self->{'related'}->{'child'}}, $child; } OTHERCHILD: foreach my $other_child (@child_items) { next OTHERCHILD if $child == $other_child; push @{$child->{'related'}->{'sibling'}}, $other_child; } push @rv, $child; } return @rv; } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HTML::Microformats::Format::hCalendar::HAS_ICAL_EXPORT; my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_component($self->model, $self->id(1))->to_string; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hCalendar.pm0000644000076400007640000002123611775403507022515 0ustar taitai=head1 NAME HTML::Microformats::Format::hCalendar - the hCalendar microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCalendar; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cals = HTML::Microformats::Format::hCalendar->extract_all( $dom->documentElement, $context); foreach my $cal (@cals) { foreach my $event ($cal->get_vevent) { printf("%s: %s\n", $ev->get_dtstart, $ev->get_summary); } } =head1 DESCRIPTION HTML::Microformats::Format::hCalendar inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_icalendar >> This method exports the data in iCalendar format. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hCalendar; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass searchAncestorClass); use HTML::Microformats::Format::hEntry; use HTML::Microformats::Format::hEvent; use HTML::Microformats::Format::hTodo; use HTML::Microformats::Format::hAlarm; use HTML::Microformats::Format::hFreebusy; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hCalendar::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hCalendar::VERSION = '0.105'; } our $HAS_ICAL_EXPORT; BEGIN { local $@ = undef; eval 'use RDF::iCalendar;'; $HAS_ICAL_EXPORT = 1 if RDF::iCalendar::Exporter->can('new'); } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); foreach my $todolist (searchClass('vtodo-list', $element)) { my $holder_calendar = searchAncestorClass('vcalendar', $todolist); if (!defined $holder_calendar or $element->getAttribute('data-cpan-html-microformats-nodepath') eq $holder_calendar->getAttribute('data-cpan-html-microformats-nodepath')) { push @{$self->{'DATA'}->{'vtodo'}}, HTML::Microformats::Format::hTodo->extract_all_xoxo($todolist, $context); } } $self->_calculate_relationships; $self->_cement_relationships; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _calculate_relationships { my $self = shift; my %xpath; foreach my $component (qw(vevent vtodo vjournal)) { foreach my $object (@{ $self->data->{$component} }) { my $xp = $object->element->getAttribute('data-cpan-html-microformats-nodepath'); $xpath{$xp} = $object; } } my @xpaths = keys %xpath; foreach my $xp (@xpaths) { unless (defined $xpath{$xp}->{'related'}->{'parent'} or defined $xpath{$xp}->data->{'parent'}) { my $parent = __findParent($xp, @xpaths); if ($parent) { $xpath{$xp}->{'related'}->{'parent'} = $xpath{$parent}; push @{ $xpath{$parent}->{'related'}->{'child'} }, $xpath{$xp}; } } } } sub __findParent { my $x = shift; my $longest = ''; foreach my $potential (@_) { if (__ancestorOf($potential, $x)) { $longest = $potential if (length($potential) > length($longest)); } } return $longest; } sub __ancestorOf { my ($a, $b) = @_; return if ($a eq $b); return (substr($b, 0, length($a)) eq $a); } sub _cement_relationships { my $self = shift; my @objects; foreach my $component (qw(vevent vtodo vjournal)) { push @objects, @{ $self->data->{$component} }; } foreach my $object (@objects) { # Share parent data between $obj->{'DATA'} and $obj->{'related'}. if (defined $object->{'related'}->{'parent'} and !defined $object->{'DATA'}->{'parent'}) { $object->{'DATA'}->{'parent'} = $object->{'related'}->{'parent'}->get_uid; } elsif (!defined $object->{'related'}->{'parent'} and defined $object->{'DATA'}->{'parent'}) { $object->{'related'}->{'parent'} = grep {$_->get_uid eq $object->{'DATA'}->{'parent'}} @objects; } # Share other data similarly. foreach my $relationship (qw(sibling other child)) { foreach my $related (@{ $object->{'related'}->{$relationship} }) { next unless defined $related->get_uid; push @{$object->{'DATA'}->{$relationship}}, $related->get_uid unless grep { $_ eq $related->get_uid } @{$object->{'DATA'}->{$relationship}}; $object->{'DATA'}->{$relationship} = undef unless @{ $object->{'DATA'}->{$relationship} }; } foreach my $related (@{ $object->{'DATA'}->{$relationship} }) { push @{$object->{'related'}->{$relationship}}, (grep { $_->get_uid eq $related } @objects); $object->{'related'}->{$relationship} = undef unless @{$object->{'related'}->{$relationship}}; } } } return $self; } sub extract_all { my ($class, $element, $context) = @_; my @cals = HTML::Microformats::Format::extract_all($class, $element, $context); if ($element->tagName eq 'html' || !@cals) { my @components = HTML::Microformats::Format::hEvent->extract_all($element, $context); push @components, HTML::Microformats::Format::hTodo->extract_all($element, $context); push @components, HTML::Microformats::Format::hFreebusy->extract_all($element, $context); push @components, HTML::Microformats::Format::hEntry->extract_all($element, $context); my $orphans = 0; foreach my $c (@components) { $orphans++ unless searchAncestorClass('hcalendar', $c->element); } if ($orphans) { my $slurpy = $class->new($element, $context); unshift @cals, $slurpy; } } return @cals; } sub format_signature { my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; return { 'root' => 'vcalendar', 'classes' => [ ['vevent', 'M*', {embedded=>'hEvent'}], ['vtodo', 'M*', {embedded=>'hTodo'}], ['hentry', 'M*', {embedded=>'hEntry', 'use-key'=>'vjournal'}], ['vfreebusy', 'M*', {embedded=>'hFreebusy'}], ['calscale', '?'], ['method', '?'], ], 'options' => { }, 'rdf:type' => ["${ical}Vcalendar"] , 'rdf:property' => { 'vevent' => { 'resource' => ["${ical}component"] } , 'vtodo' => { 'resource' => ["${ical}component"] } , 'vfreebusy' => { 'resource' => ["${ical}component"] } , 'vjournal' => { 'resource' => ["${ical}component"] } , 'calscale' => { 'literal' => ["${ical}calscale"] , 'literal_datatype' => 'string'} , 'method' => { 'literal' => ["${ical}method"] , 'literal_datatype' => 'string'} , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); foreach my $journal (@{ $self->data->{vjournal} }) { $journal->add_to_model_ical($model); } return $self; } sub profiles { return qw(http://purl.org/uF/hCalendar/1.1/ http://microformats.org/profile/hcalendar http://ufs.cc/x/hcalendar http://microformats.org/profile/specs http://ufs.cc/x/specs http://dannyayers.com/microformats/hcalendar-profile http://www.w3.org/2002/12/cal/hcal http://purl.org/uF/hCalendar/1.0/ http://purl.org/uF/2008/03/); } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HAS_ICAL_EXPORT; my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_calendar($self->model, $self->id(1))->to_string; } 1; =head1 MICROFORMAT HTML::Microformats::Format::hCalendar supports hCalendar as described at L. =head1 RDF OUTPUT Data is returned using the W3C's revised iCalendar vocabulary (L) with some supplemental terms from Toby Inkster's revised iCalendar extensions vocabulary (L) and occasional other terms. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/species.pm0000644000076400007640000004535611775403507022300 0ustar taitai=head1 NAME HTML::Microformats::Format::species - the species microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCard; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::species->extract_all( $dom->documentElement, $context); foreach my $species (@objects) { print $species->get_binomial . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::species inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::species; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Datatype::String qw(isms); use HTML::Microformats::Utilities qw(searchClass stringify); use RDF::Trine; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::species::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::species::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_species_parse($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $class = shift; my $ranks = $class->_ranks; my $biol = 'http://purl.org/NET/biol/ns#'; my $rv = { 'root' => 'biota', 'classes' => [ ['binomial', '*'], ['trinomial', '*'], ['authority', '*'], ['common-name', '*'], ], 'options' => {}, 'rdf:type' => ["${biol}Taxonomy"] , 'rdf:property' => {}, }; foreach my $term (keys %{ $ranks->{Terms} }) { push @{ $rv->{'classes'} }, [$term, '?']; } return $rv; } sub profiles { # placeholder return qw(http://purl.org/NET/cpan-uri/dist/HTML-Microformats/profile-species); } sub add_to_model { my ($self, $model) = @_; my $ranks = $self->_ranks; foreach my $term (keys %{ $ranks->{Terms} }) { next if $term eq 'rank'; # handle later. if (defined $self->data->{$term}) { my $prefuri; if ($self->{'type'} eq 'B') { $prefuri = $ranks->{'Terms'}->{$term}->{'URI.C'} || $ranks->{'Terms'}->{$term}->{'URI.B'} || $ranks->{'Terms'}->{$term}->{'URI.Z'}; } else { $prefuri = $ranks->{'Terms'}->{$term}->{'URI.C'} || $ranks->{'Terms'}->{$term}->{'URI.Z'} || $ranks->{'Terms'}->{$term}->{'URI.B'}; } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new( $prefuri ), RDF::Trine::Node::Literal->new(''.$self->data->{$term}), )); } } my %uri = ( authority => 'http://purl.org/NET/biol/ns#authority', commonName => 'http://purl.org/NET/biol/ns#commonName', binomial => 'http://purl.org/NET/biol/ns#name', trinomial => 'http://purl.org/NET/biol/ns#name', rank => 'http://purl.org/NET/biol/ns#rank', ); foreach my $term (qw(rank binomial trinomial)) { foreach my $value (@{ $self->data->{$term} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new($uri{$term}), RDF::Trine::Node::Literal->new("$value"), )); } } # Handle these separately, so that we can preserve language code. foreach my $term (qw(authority common-name)) { foreach my $value (@{ $self->data->{$term} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new($uri{$term}), $self->_make_literal($value), )); } } if ($self->{'type'} eq 'Z') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://purl.org/NET/biol/ns#ZooTaxonomy'), )); } elsif ($self->{'type'} eq 'B') { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://purl.org/NET/biol/ns#BotTaxonomy'), )); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://purl.org/NET/biol/ns#Taxonomy'), )); } sub _species_parse { my ($self, $root) = @_; my $ranks = $self->_ranks; my $implied_bot = 0; my $implied_zoo = 0; my $compact = 1; $self->_destroyer($root); foreach my $term (keys %{ $ranks->{Terms} }) { my @nodes = searchClass($term, $root, 'taxo'); # class=species has alias class=specific. push @nodes, searchClass('specific', $root, 'taxo') if $term eq 'species'; next unless @nodes; $compact = 0; $implied_bot = 1 if ($ranks->{Terms}->{$term}->{Type} eq 'B'); $implied_zoo = 1 if ($ranks->{Terms}->{$term}->{Type} eq 'Z'); $self->{'DATA'}->{$term} = stringify($nodes[0], 'value'); } foreach my $term (qw(binomial trinomial authority rank)) { my @nodes = searchClass($term, $root, 'taxo'); next unless @nodes; $compact = 0; foreach my $n (@nodes) { push @{$self->{'DATA'}->{$term}}, stringify($n, 'value'); } } foreach my $term (qw(vernacular common-name cname fn)) { my @nodes = searchClass($term, $root, 'taxo'); next unless @nodes; $compact = 0; foreach my $n (@nodes) { push @{$self->{'DATA'}->{'common-name'}}, stringify($n, 'value'); } } if ($compact) { $compact = stringify($root, 'value'); $compact =~ s/(^\s+|\s+$)//g; $compact =~ s/\s+/ /g; $self->{'DATA'}->{'binomial'} = [ $compact ] if length $compact; } if ($root->getAttribute('class') =~ /\b(zoology)\b/) { $self->{'type'} = 'Z'; } elsif ($root->getAttribute('class') =~ /\b(botany)\b/) { $self->{'type'} = 'B'; } elsif ($implied_zoo && !$implied_bot) { $self->{'type'} = 'Z'; } elsif ($implied_bot && !$implied_zoo) { $self->{'type'} = 'B'; } } sub _ranks { my $plain_n3 = ''; while () { chomp; next unless /[A-Za-z0-9]/; next if /^\s*\#/; $plain_n3 .= "$_\n"; } my $data = {}; foreach (split /\s+\.\s+/, $plain_n3) { s/(^\s+|\s+$)//g; s/\s+/ /g; my @word = split / /; if ($word[0] eq '@prefix') { my $code = $word[1]; my $uri = $word[2]; $code =~ s/\:$//; $uri =~ s/(^\<|\>$)//g; $data->{Prefixes}->{$code} = $uri; } elsif ($word[1] eq 'a' && $word[2] eq 'owl:DatatypeProperty') { my ($code, $term) = split /\:/, $word[0]; my $uri = $data->{Prefixes}->{$code} . $term; my $type = 'C'; $type = 'B' if ($uri =~ /botany/); $type = 'Z' if ($uri =~ /zoology/); my $hyphen = $term; $hyphen =~ s/([A-Z])/'-'.lc($1)/eg; $data->{Terms}->{$hyphen}->{Type} .= $type; $data->{Terms}->{$hyphen}->{Camel} = $term; $data->{Terms}->{$hyphen}->{Hyphen} = $hyphen; $data->{Terms}->{$hyphen}->{"URI.$type"} = $uri; } } # foreach my $term (sort keys %{$data->{Terms}}) # { # my $classes = ''; # $classes .= "core " if ($data->{Terms}->{$term}->{Type} =~ /C/); # $classes .= "botany " if ($data->{Terms}->{$term}->{Type} =~ /B/); # $classes .= "zoology " if ($data->{Terms}->{$term}->{Type} =~ /Z/); # $classes .= "botany-only " if ($data->{Terms}->{$term}->{Type} =~ /^[CB]*$/); # $classes .= "zoology-only " if ($data->{Terms}->{$term}->{Type} =~ /^[CZ]*$/); # print "
  • $term
    • \n"; # } return $data; } 1; =head1 MICROFORMAT The species documentation at L is very sketchy. This module aims to be roughly compatible with the implementation of species in the Operator extension for Firefox, and data published by the BBC and Wikipedia. Here are some brief notes on how is has been impemented: =over 4 =item * The root class name is 'biota'. =item * Important properties are 'vernacular' (alias 'common-name', 'cname' or 'fn'), 'binomial', 'trinomial', 'authority'. =item * Also recognised are 'class', 'division', 'family', 'genus', 'kingdom', 'order', 'phylum', 'species' and various other ranks. =item * Because some of these property names are fairly generic, you can alternatively use them in a prefixed form: 'taxo-class', 'taxo-division', etc. =item * If an element with class 'biota' has no recognised properties within it, the entire contents of the element are taken to be a binomial name. This allows for very simple markup: Homo sapiens =item * The meaning of some terminology differs when used by botanists and zoologists. You can add the class 'botany' or 'zoology' to the root element to clarify your usage. e.g. Homo sapiens =back An example: Homo sapiens sapiens (Linnaeus, 1758) a.k.a. Humans =head1 RDF OUTPUT RDF output uses the Biological Taxonomy Vocabulary 0.2 (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut __DATA__ # OK - the module doesn't really parse all this N3 properly. It only really # uses the prefixes, plus the property lists, and it's very sensitive to # whitespace changes. \@prefix core: . \@prefix bot: . \@prefix zoo: . \@prefix owl: . # Core core:class a owl:DatatypeProperty . core:division a owl:DatatypeProperty . core:family a owl:DatatypeProperty . core:genus a owl:DatatypeProperty . core:kingdom a owl:DatatypeProperty . core:order a owl:DatatypeProperty . core:phylum a owl:DatatypeProperty . core:rank a owl:DatatypeProperty . core:species a owl:DatatypeProperty . # Botany bot:aberration a owl:DatatypeProperty . bot:aggregate a owl:DatatypeProperty . bot:biovar a owl:DatatypeProperty . bot:branch a owl:DatatypeProperty . bot:breed a owl:DatatypeProperty . bot:class a owl:DatatypeProperty . bot:claudius a owl:DatatypeProperty . bot:cohort a owl:DatatypeProperty . bot:complex a owl:DatatypeProperty . bot:convariety a owl:DatatypeProperty . bot:cultivar a owl:DatatypeProperty . bot:cultivarGroup a owl:DatatypeProperty . bot:division a owl:DatatypeProperty . bot:domain a owl:DatatypeProperty . bot:empire a owl:DatatypeProperty . bot:falanx a owl:DatatypeProperty . bot:family a owl:DatatypeProperty . bot:familyGroup a owl:DatatypeProperty . bot:form a owl:DatatypeProperty . bot:genus a owl:DatatypeProperty . bot:genusGroup a owl:DatatypeProperty . bot:gigaorder a owl:DatatypeProperty . bot:grade a owl:DatatypeProperty . bot:grandorder a owl:DatatypeProperty . bot:group a owl:DatatypeProperty . bot:groupOfBreeds a owl:DatatypeProperty . bot:hybrid a owl:DatatypeProperty . bot:hyperorder a owl:DatatypeProperty . bot:infraclass a owl:DatatypeProperty . bot:infradomain a owl:DatatypeProperty . bot:infrafamily a owl:DatatypeProperty . bot:infraform a owl:DatatypeProperty . bot:infragenus a owl:DatatypeProperty . bot:infrakingdom a owl:DatatypeProperty . bot:infralegion a owl:DatatypeProperty . bot:infraorder a owl:DatatypeProperty . bot:infraphylum a owl:DatatypeProperty . bot:infrasection a owl:DatatypeProperty . bot:infraseries a owl:DatatypeProperty . bot:infraspecies a owl:DatatypeProperty . bot:infratribe a owl:DatatypeProperty . bot:infravariety a owl:DatatypeProperty . bot:interkingdom a owl:DatatypeProperty . bot:kingdom a owl:DatatypeProperty . bot:klepton a owl:DatatypeProperty . bot:legion a owl:DatatypeProperty . bot:lusus a owl:DatatypeProperty . bot:magnorder a owl:DatatypeProperty . bot:megaorder a owl:DatatypeProperty . bot:microspecies a owl:DatatypeProperty . bot:midkingdom a owl:DatatypeProperty . bot:midphylum a owl:DatatypeProperty . bot:mirorder a owl:DatatypeProperty . bot:nation a owl:DatatypeProperty . bot:order a owl:DatatypeProperty . bot:parvclass a owl:DatatypeProperty . bot:parvorder a owl:DatatypeProperty . bot:pathovar a owl:DatatypeProperty . bot:phylum a owl:DatatypeProperty . bot:population a owl:DatatypeProperty . bot:section a owl:DatatypeProperty . bot:sectionOfBreeds a owl:DatatypeProperty . bot:series a owl:DatatypeProperty . bot:serogroup a owl:DatatypeProperty . bot:serovar a owl:DatatypeProperty . bot:species a owl:DatatypeProperty . bot:speciesGroup a owl:DatatypeProperty . bot:speciesSubgroup a owl:DatatypeProperty . bot:strain a owl:DatatypeProperty . bot:subclass a owl:DatatypeProperty . bot:subcohort a owl:DatatypeProperty . bot:subdivision a owl:DatatypeProperty . bot:subdomain a owl:DatatypeProperty . bot:subfamily a owl:DatatypeProperty . bot:subfamilyGroup a owl:DatatypeProperty . bot:subform a owl:DatatypeProperty . bot:subgenus a owl:DatatypeProperty . bot:subgroup a owl:DatatypeProperty . bot:subkingdom a owl:DatatypeProperty . bot:sublegion a owl:DatatypeProperty . bot:suborder a owl:DatatypeProperty . bot:subphylum a owl:DatatypeProperty . bot:subsection a owl:DatatypeProperty . bot:subseries a owl:DatatypeProperty . bot:subspecies a owl:DatatypeProperty . bot:subtribe a owl:DatatypeProperty . bot:subvariety a owl:DatatypeProperty . bot:superclass a owl:DatatypeProperty . bot:supercohort a owl:DatatypeProperty . bot:superdomain a owl:DatatypeProperty . bot:superfamily a owl:DatatypeProperty . bot:superform a owl:DatatypeProperty . bot:supergenus a owl:DatatypeProperty . bot:superkingdom a owl:DatatypeProperty . bot:superlegion a owl:DatatypeProperty . bot:superorder a owl:DatatypeProperty . bot:superphylum a owl:DatatypeProperty . bot:supersection a owl:DatatypeProperty . bot:superseries a owl:DatatypeProperty . bot:superspecies a owl:DatatypeProperty . bot:supertribe a owl:DatatypeProperty . bot:supervariety a owl:DatatypeProperty . bot:suprakingdom a owl:DatatypeProperty . bot:supraphylum a owl:DatatypeProperty . bot:synklepton a owl:DatatypeProperty . bot:tribe a owl:DatatypeProperty . bot:variety a owl:DatatypeProperty . # Zoology zoo:aberration a owl:DatatypeProperty . zoo:aggregate a owl:DatatypeProperty . zoo:biovar a owl:DatatypeProperty . zoo:branch a owl:DatatypeProperty . zoo:breed a owl:DatatypeProperty . zoo:class a owl:DatatypeProperty . zoo:claudius a owl:DatatypeProperty . zoo:cohort a owl:DatatypeProperty . zoo:complex a owl:DatatypeProperty . zoo:convariety a owl:DatatypeProperty . zoo:cultivar a owl:DatatypeProperty . zoo:cultivarGroup a owl:DatatypeProperty . zoo:division a owl:DatatypeProperty . zoo:domain a owl:DatatypeProperty . zoo:empire a owl:DatatypeProperty . zoo:falanx a owl:DatatypeProperty . zoo:family a owl:DatatypeProperty . zoo:familyGroup a owl:DatatypeProperty . zoo:form a owl:DatatypeProperty . zoo:genus a owl:DatatypeProperty . zoo:genusGroup a owl:DatatypeProperty . zoo:gigaorder a owl:DatatypeProperty . zoo:grade a owl:DatatypeProperty . zoo:grandorder a owl:DatatypeProperty . zoo:group a owl:DatatypeProperty . zoo:groupOfBreeds a owl:DatatypeProperty . zoo:hybrid a owl:DatatypeProperty . zoo:hyperorder a owl:DatatypeProperty . zoo:infraclass a owl:DatatypeProperty . zoo:infradomain a owl:DatatypeProperty . zoo:infrafamily a owl:DatatypeProperty . zoo:infraform a owl:DatatypeProperty . zoo:infragenus a owl:DatatypeProperty . zoo:infrakingdom a owl:DatatypeProperty . zoo:infralegion a owl:DatatypeProperty . zoo:infraorder a owl:DatatypeProperty . zoo:infraphylum a owl:DatatypeProperty . zoo:infraspecies a owl:DatatypeProperty . zoo:infratribe a owl:DatatypeProperty . zoo:infravariety a owl:DatatypeProperty . zoo:interkingdom a owl:DatatypeProperty . zoo:kingdom a owl:DatatypeProperty . zoo:klepton a owl:DatatypeProperty . zoo:legion a owl:DatatypeProperty . zoo:lusus a owl:DatatypeProperty . zoo:magnorder a owl:DatatypeProperty . zoo:megaorder a owl:DatatypeProperty . zoo:microspecies a owl:DatatypeProperty . zoo:midkingdom a owl:DatatypeProperty . zoo:midphylum a owl:DatatypeProperty . zoo:mirorder a owl:DatatypeProperty . zoo:nation a owl:DatatypeProperty . zoo:order a owl:DatatypeProperty . zoo:parvclass a owl:DatatypeProperty . zoo:parvorder a owl:DatatypeProperty . zoo:pathovar a owl:DatatypeProperty . zoo:phylum a owl:DatatypeProperty . zoo:population a owl:DatatypeProperty . zoo:section a owl:DatatypeProperty . zoo:sectionOfBreeds a owl:DatatypeProperty . zoo:series a owl:DatatypeProperty . zoo:serogroup a owl:DatatypeProperty . zoo:serovar a owl:DatatypeProperty . zoo:species a owl:DatatypeProperty . zoo:speciesGroup a owl:DatatypeProperty . zoo:speciesSubgroup a owl:DatatypeProperty . zoo:strain a owl:DatatypeProperty . zoo:subclass a owl:DatatypeProperty . zoo:subcohort a owl:DatatypeProperty . zoo:subdivision a owl:DatatypeProperty . zoo:subdomain a owl:DatatypeProperty . zoo:subfamily a owl:DatatypeProperty . zoo:subfamilyGroup a owl:DatatypeProperty . zoo:subform a owl:DatatypeProperty . zoo:subgenus a owl:DatatypeProperty . zoo:subgroup a owl:DatatypeProperty . zoo:subkingdom a owl:DatatypeProperty . zoo:sublegion a owl:DatatypeProperty . zoo:suborder a owl:DatatypeProperty . zoo:subphylum a owl:DatatypeProperty . zoo:subsection a owl:DatatypeProperty . zoo:subseries a owl:DatatypeProperty . zoo:subspecies a owl:DatatypeProperty . zoo:subtribe a owl:DatatypeProperty . zoo:subvariety a owl:DatatypeProperty . zoo:superclass a owl:DatatypeProperty . zoo:supercohort a owl:DatatypeProperty . zoo:superdivision a owl:DatatypeProperty . zoo:superdomain a owl:DatatypeProperty . zoo:superfamily a owl:DatatypeProperty . zoo:superform a owl:DatatypeProperty . zoo:supergenus a owl:DatatypeProperty . zoo:superkingdom a owl:DatatypeProperty . zoo:superlegion a owl:DatatypeProperty . zoo:superorder a owl:DatatypeProperty . zoo:superphylum a owl:DatatypeProperty . zoo:superspecies a owl:DatatypeProperty . zoo:supertribe a owl:DatatypeProperty . zoo:supervariety a owl:DatatypeProperty . zoo:suprakingdom a owl:DatatypeProperty . zoo:supraphylum a owl:DatatypeProperty . zoo:synklepton a owl:DatatypeProperty . zoo:tribe a owl:DatatypeProperty . zoo:variety a owl:DatatypeProperty . HTML-Microformats-0.105/lib/HTML/Microformats/Format/OpenURL_COinS.pm0000644000076400007640000001724411775403507023157 0ustar taitai=head1 NAME HTML::Microformats::Format::OpenURL_COinS - the OpenURL COinS poshformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::OpenURL_COinS; use Data::Dumper; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::OpenURL_COinS->extract_all( $dom->documentElement, $context); my $object = $objects[0]; print Dumper($object->data); =head1 DESCRIPTION HTML::Microformats::Format::OpenURL_COinS inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::OpenURL_COinS; use base qw(HTML::Microformats::Format); use strict qw(subs vars); no warnings; use 5.010; use CGI; use CGI::Util qw(escape); use HTML::Microformats::Utilities qw(stringify xml_stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::OpenURL_COinS::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::OpenURL_COinS::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , }; bless $self, $class; my $success = $self->_parse_coins; return unless $success; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _parse_coins { my $self = shift; my $e = $self->{'element'}; my $openurl; if ($e->localname =~ /^(q|blockquote)$/i && $e->hasAttribute('cite')) { ($openurl = $e->getAttribute('cite')) =~ s/^([^\?]*\?)//; } elsif ($e->localname =~ /^(a|area|link)$/i && $e->hasAttribute('href')) { ($openurl = $e->getAttribute('href')) =~ s/^([^\?]*\?)//; } else { $openurl = $e->getAttribute('title'); } my $cgi = new CGI($openurl); return 0 unless ($cgi->param('ctx_ver') eq 'Z39.88-2004'); my $id = ''; foreach my $param (sort $cgi->param) { foreach my $value (sort $cgi->param($param)) { push @{$self->{'DATA'}->{'openurl_data'}->{$param}}, $value; $id .= sprintf('&%s=%s', escape($param), escape($value)); } } ($self->{'DATA'}->{'openurl'} = $id) =~ s|^&||; ($self->{'id.co'} = $id) =~ s|^&|http://ontologi.es/openurl?|; if ($e->localname =~ /^(q|blockquote)$/i) { $self->{'DATA'}->{'quote'} = xml_stringify($e); } elsif ($e->localname =~ /^(a|cite)$/i) { $self->{'DATA'}->{'label'} = stringify($e); } return 1; } sub format_signature { my $ov = 'http://open.vocab.org/terms/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $dc = 'http://purl.org/dc/terms/'; my $ou = 'http://www.openurl.info/registry/fmt/xml/rss10/ctx#'; return { 'root' => 'Z3988', 'rel' => 'Z3988', 'classes' => [ ['label', '?#'], ['quote', '?#'], ['openurl', '1#'], ['openurl_data', '1#'], ], 'options' => {}, 'rdf:type' => [] , 'rdf:property' => { 'label' => { literal => ["${rdfs}label"] }, 'quote' => { literal => ["${ov}quote"] }, 'openurl' => { literal => ["${dc}identifier"] , literal_datatype => 'string' }, }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $ov = 'http://open.vocab.org/terms/'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $dc = 'http://purl.org/dc/terms/'; my $ou = 'http://www.openurl.info/registry/fmt/xml/rss10/ctx#'; my $bibo = 'http://purl.org/ontology/bibo/'; $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Resource->new($self->context->document_uri), RDF::Trine::Node::Resource->new("${dc}references"), $self->id(1), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("http://ontologi.es/openurl#context"), $self->id(1, 'co'), )); # OpenURL's structure is very flat and difficult to # properly map to BIBO. Here is a partial mapping. my %bibokey = ( 'rft.btitle' => "${dc}title" , 'rft.coden' => "${bibo}coden" , 'rft.date' => "${dc}date" , 'rft.eissn' => "${bibo}eissn" , 'rft.isbn' => "${bibo}isbn" , 'rft.issn' => "${bibo}issn" , 'rft.sici' => "${bibo}sici" , ); my $au = 0; foreach my $key (keys %{$self->{'DATA'}->{'openurl_data'}}) { foreach my $val (@{$self->{'DATA'}->{'openurl_data'}->{$key}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'co'), RDF::Trine::Node::Resource->new($ou . $key), $self->_make_literal($val), )); if (defined $bibokey{$key}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new($bibokey{$key}), $self->_make_literal($val), )); } if ($key eq 'rft.au') { $au++; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${dc}contributor"), $self->id(1, 'au.'.$au), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'au.'.$au), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/name"), $self->_make_literal($val), )); } } } } sub profiles { return qw(http://ocoins.info/); } 1; =head1 MICROFORMAT OpenURL COinS is not technically a microformat. It was developed outside the microformats community and does not use many of the patterns developed by that community. Nevertheless it's an interesting format, and perhaps a useful one. HTML::Microformats::Format::OpenURL_COinS supports COinS as described at L, with the following addition: =over 4 =item * Support for additional elements and attributes OpenURL COinS is only specified to work on EspanE elements. This module allows its use on arbitrary HTML elements. When used with EqE or EblockquoteE the 'cite' attribute is consulted in preference to 'title'; when used with ElinkE, EaE or EareaE, 'href' is used in preference to 'title'. When either of the 'cite' or 'href' attributes is used, any leading string ending with a question mark is removed from the attribute value prior to OpenURL processing. This allows for the attibute values to be published as proper links. When EqE or EblockquoteE is used, the quote is taken to be sourced from the entity described by the context object. =back =head1 RDF OUTPUT Like how HTML::Microformats::Format::hCard differentiates between the business card and the entity represented by the card, this module differentiates between the OpenURL context object and the book, journal entry or other publication represented by it. The former is essentially a set of search parameters which can be used to find the latter. The RSS Context module (L) is used to describe the context object. The Bibo ontology (L) and Dublin Core (L) are used to describe the work itself, with data being "back-projected" from the context object where not too complicated. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hProduct.pm0000644000076400007640000001453511775403507022430 0ustar taitai=head1 NAME HTML::Microformats::Format::hProduct - the hProduct microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hProduct; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::hProduct->extract_all( $dom->documentElement, $context); foreach my $p (@objects) { printf("%s\n", $m->get_fn); if ($p->get_review) { foreach my $r ($p->get_review) { printf(" - reviewed by %s\n", $r->get_reviewer->get_fn); } } else { print " (no reviews yet)\n"; } } =head1 DESCRIPTION HTML::Microformats::Format::hProduct inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hProduct; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hProduct::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hProduct::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); foreach my $review (@{ $self->{'DATA'}->{'review'} }) { $review->{'DATA'}->{'item'} = $self unless $review->{'DATA'}->{'item'}; } foreach my $listing (@{ $self->{'DATA'}->{'listing'} }) { $listing->{'DATA'}->{'item'} = $self unless $listing->{'DATA'}->{'item'}; } ##TODO: class=identifier (type+value) post-0.001 $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $gr = 'http://purl.org/goodrelations/v1#'; my $hl = 'http://ontologi.es/hlisting-hproduct#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $foaf = 'http://xmlns.com/foaf/0.1/'; my $dc = 'http://purl.org/dc/terms/'; return { 'root' => 'hproduct', 'classes' => [ ['brand', 'M?', {'embedded'=>'hCard'}], ['category', '*'], ['price', '?', {'value-title'=>'allow'}], ['description', '?'], ['fn', '1'], ['photo', 'u*'], ['url', 'u?'], ['review', 'm*', {'embedded'=>'hReview hReviewAggregate'}], ['listing', 'm*', {'embedded'=>'hListing'}], ], 'options' => { 'rel-tag' => 'category', }, 'rdf:type' => ["${gr}ProductOrService"] , 'rdf:property' => { 'brand' => { literal =>["${hl}brand"] }, 'category' => { resource=>['http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] }, 'description' => { literal =>["${dc}description"] }, 'fn' => { literal =>["${rdfs}label"] }, 'photo' => { resource=>["${foaf}depiction"] }, 'url' => { resource=>["${foaf}page", "${rdfs}seeAlso"] }, 'review' => { resource=>['http://purl.org/stuff/rev#hasReview'] }, 'listing' => { rev =>["${hl}listing"] }, }, }; } sub add_to_model { my $self = shift; my $model = shift; my $gr = 'http://purl.org/goodrelations/v1#'; my $hl = 'http://ontologi.es/hlisting-hproduct#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $foaf = 'http://xmlns.com/foaf/0.1/'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; $self->_simple_rdf($model); if ($self->_isa($self->{'DATA'}->{'brand'}, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}brand"), $self->{'DATA'}->{'brand'}->id(1, 'holder'), )); } if ($self->{'DATA'}->{'price'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}price"), $self->id(1, 'price'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${gr}PriceSpecification"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${rdfs}comment"), $self->_make_literal($self->{'DATA'}->{'price'}), )); my ($curr, $val); if ($self->{'DATA'}->{'price'} =~ /^\s*([a-z]{3})\s*(\d*(?:[\,\.]\d\d))\s*$/i) { ($curr, $val) = ($1, $2); } elsif ($self->{'DATA'}->{'price'} =~ /^\s*(\d*(?:[\,\.]\d\d))\s*([a-z]{3})\s*$/i) { ($curr, $val) = ($2, $1); } if (defined $curr && defined $val) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${gr}hasCurrency"), $self->_make_literal($curr, 'string'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${gr}hasCurrencyValue"), $self->_make_literal($val, 'float'), )); } } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/hProduct/0.3/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hProduct supports hProduct 0.3 as described at L, with the following additions: =over 4 =item * 'item' propagation. If 'review' and 'listing' objects don't have an 'item' set, then their 'item' property is set to this object. =back =head1 RDF OUTPUT Product data is primarily output using GoodRelations v1 (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hRecipe.pm0000644000076400007640000001157411775403507022217 0ustar taitai=head1 NAME HTML::Microformats::Format::hRecipe - the hRecipe microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hRecipe; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @recipes = HTML::Microformats::Format::hRecipe->extract_all( $dom->documentElement, $context); foreach my $recipe (@recipes) { print $recipe->get_summary . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hRecipe inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hRecipe; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hRecipe::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hRecipe::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $lr = 'http://linkedrecipes.org/schema/'; my $hr = 'http://ontologi.es/hrecipe#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; return { 'root' => 'hrecipe', 'classes' => [ ['fn', '1'], ['ingredient', '+'], ['yield', '?'], ['instructions', 'H?'], ['duration', 'D*'], ['photo', 'u*'], ['summary', '?'], ['author', 'M*', {embedded=>'hCard !person'}], ['published', 'd?'], ['nutrition', '*'], ], 'options' => { 'rel-tag' => 'tag', }, 'rdf:type' => ["${lr}Recipe"] , 'rdf:property' => { 'fn' => { 'literal' => ["${rdfs}label"] } , 'yield' => { 'literal' => ["${lr}servings"] } , 'html_instructions' => { 'literal' => ["${hr}instructions"], 'literal_datatype'=>'http://www.w3.org/1999/02/22-rdf-syntax-ns#XMLLiteral' } , 'duration' => { 'literal' => ["${lr}time"] } , 'photo' => { 'resource' => ['http://xmlns.com/foaf/0.1/depiction'] }, 'summary' => { 'literal' => ["${rdfs}comment"] } , 'published' => { 'literal' => ['http://purl.org/dc/terms/issued'] }, 'nutrition' => { 'literal' => ["${lr}dietaryInformation"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $lr = 'http://linkedrecipes.org/schema/'; my $hr = 'http://ontologi.es/hrecipe#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; # Handle ingredients. my $i = 0; foreach my $ingredient (@{ $self->data->{'ingredient'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${lr}ingredient"), $self->id(1, "ingredient.${i}"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "ingredient.${i}"), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("${lr}IngredientPortion"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, "ingredient.${i}"), RDF::Trine::Node::Resource->new("${rdfs}label"), $self->_make_literal($ingredient), )); $i++; } foreach my $author (@{ $self->data->{'author'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/maker"), $author->id(1, "holder"), )); $author->add_to_model($model); } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/hRecipe/0.23/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hRecipe supports hRecipe 0.23 as described at L. =head1 RDF OUTPUT L, L. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hAlarm.pm0000644000076400007640000001141411775403507022035 0ustar taitai=head1 NAME HTML::Microformats::Format::hAlarm - an hCalendar alarm component =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCalendar; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cals = HTML::Microformats::Format::hCalendar->extract_all( $dom->documentElement, $context); foreach my $cal (@cals) { foreach my $ev ($cal->get_vevent) { foreach my $alarm ($ev->get_valarm) { print $alarm->get_description . "\n"; } } } =head1 DESCRIPTION HTML::Microformats::Format::hAlarm is a helper module for HTML::Microformats::Format::hCalendar. This class is used to represent alarm components within calendars. Generally speaking, you want to use HTML::Microformats::Format::hCalendar instead. HTML::Microformats::Format::hAlarm inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_icalendar >> This method exports the data in iCalendar format. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hAlarm; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hAlarm::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hAlarm::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $icalx = 'http://buzzword.org.uk/rdf/icaltzdx#'; return { 'root' => 'valarm', 'classes' => [ ['action', '?', {'value-title'=>'allow'}], ['attach', 'U?'], ['attendee', 'M*', {'embedded'=>'hCard', 'is-in-cal'=>1}], ['description', '?'], ['duration', 'D?'], ['repeat', 'n?', {'value-title'=>'allow'}], ['summary', '1'], ['trigger', 'D?'] # TODO: should really allow 'related' subproperty and allow datetime values too. post-0.001 ], 'options' => { 'rel-enclosure' => 'attach', }, 'rdf:type' => ["${ical}Valarm"] , 'rdf:property' => { 'action' => { 'literal' => ["${ical}action"] } , # 'attach' => { 'resource' => ["${ical}attach"] } , 'attendee' => { 'resource' => ["${ical}attendee"], 'literal' => ["${icalx}attendee"] } , 'description' => { 'literal' => ["${ical}description"] } , 'duration' => { 'literal' => ["${ical}duration"] } , 'repeat' => { 'literal' => ["${ical}repeat"] , 'literal_datatype'=>'integer' } , 'summary' => { 'literal' => ["${ical}summary"] } , 'trigger' => { 'literal' => ["${ical}trigger"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; $self->_simple_rdf($model); foreach my $val ( @{ $self->data->{attach} } ) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}attach"), RDF::Trine::Node::Resource->new($val->data->{href}), )); $val->add_to_model($model); } return $self; } sub profiles { return HTML::Microformats::Format::hCalendar::profiles(@_); } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HTML::Microformats::Format::hCalendar::HAS_ICAL_EXPORT; my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_component($self->model, $self->id(1))->to_string; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/VoteLinks.pm0000644000076400007640000000753411775403507022557 0ustar taitai=head1 NAME HTML::Microformats::Format::VoteLinks - the VoteLinks microformat =head1 SYNOPSIS my @vlinks = HTML::Microformats::Format::VoteLinks->extract_all( $doc->documentElement, $context); foreach my $link (@vlinks) { printf("%s (%s)\n", $link->get_href, $link->get_vote; } =head1 DESCRIPTION HTML::Microformats::Format::VoteLinks inherits from HTML::Microformats::Format_Rel. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Methods =over 4 =item C<< $link->get_vote() >> Returns the string 'for', 'against' or 'abstain'. =item C<< $link->get_voter() >> Returns the hCard of the person who authored the VoteLinks link, if it can be determined from context. (It usually can't unless the page is also using hAtom, and the hAtom on the page has already been parsed.) =back =cut package HTML::Microformats::Format::VoteLinks; use base qw(HTML::Microformats::Format_Rel); use strict qw(subs vars); no warnings; use 5.010; use CGI::Util qw(unescape); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::VoteLinks::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::VoteLinks::VERSION = '0.105'; } sub new { my $class = shift; my $self = $class->SUPER::new(@_); my $rev = $self->element->getAttribute('rev'); if ($rev =~ /\b(vote-for)\b/) { $self->{'DATA'}->{'vote'} = 'for'; } if ($rev =~ /\b(vote-against)\b/) { return undef if $self->{'DATA'}->{'vote'} eq 'for'; $self->{'DATA'}->{'vote'} = 'against'; } if ($rev =~ /\b(vote-abstain)\b/) { return undef if $self->{'DATA'}->{'vote'} eq 'for'; return undef if $self->{'DATA'}->{'vote'} eq 'against'; $self->{'DATA'}->{'vote'} = 'abstain'; } return $self; } sub format_signature { my $v = 'http://rdf.opiumfield.com/vote/'; return { 'rev' => ['vote-for', 'vote-abstain', 'vote-against'] , 'classes' => [ ['href', '1#'] , ['label', '1#'] , ['title', '1#'] , ['voter', '*#'] , ['vote', '1#'] , ] , 'rdf:type' => ["${v}VoteLink"] , 'rdf:property' => { 'href' => { resource => ["${v}voteResource"] } , } , } } sub profiles { return qw(http://microformats.org/profile/votelinks http://ufs.cc/x/relvotelinks http://purl.org/uF/VoteLinks/1.0/ http://tommorris.org/profiles/votelinks http://microformats.org/profile/specs http://ufs.cc/x/specs http://purl.org/uF/2008/03/); } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); my $v = 'http://rdf.opiumfield.com/vote/'; foreach my $voter (@{ $self->data->{'voter'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${v}voteBy"), $voter->id(1, 'holder'), )); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${v}voted"), RDF::Trine::Node::Resource->new("${v}vote" . ucfirst lc $self->data->{'vote'}), )); return $self; } 1; =head1 MICROFORMAT HTML::Microformats::Format::VoteLinks supports VoteLinks as described at L. =head1 RDF OUTPUT Data is returned using the Tom Morris' vote vocabulary (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hListing.pm0000644000076400007640000002034711775403507022417 0ustar taitai=head1 NAME HTML::Microformats::Format::hListing - the hListing microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hListing; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::hListing->extract_all( $dom->documentElement, $context); foreach my $x (@objects) { printf("%s <%s>\n", $x->get_summary, $x->get_permalink); } =head1 DESCRIPTION HTML::Microformats::Format::hListing inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hListing; use base qw(HTML::Microformats::Format::hReview); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hListing::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hListing::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $self->_fallback_item($clone)->_auto_detect_type; if ($element->getAttribute('class') =~ /\b(offer)\b/) { $self->{'DATA'}->{'action'} = 'offer'; } elsif ($element->getAttribute('class') =~ /\b(wanted)\b/) { $self->{'DATA'}->{'action'} = 'wanted'; } elsif (searchClass('offer', $element)) { $self->{'DATA'}->{'action'} = 'offer'; } elsif (searchClass('wanted', $element)) { $self->{'DATA'}->{'action'} = 'wanted'; } $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $gr = 'http://purl.org/goodrelations/v1#'; my $hl = 'http://ontologi.es/hlisting-hproduct#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; return { 'root' => 'hlisting', 'classes' => [ ['version', 'n?'], ['lister', 'm1', {embedded=>'hCard !person'}], ['dtlisted', 'd?'], ['dtexpired', 'd?', {'datetime-feedthrough'=>'dtlisted'}], ['price', '?', {'value-title'=>'allow'}], ['summary', '?'], ['description', 'h1'], ['bookmark', 'ru?', {'use-key'=>'permalink'}], ['type', '?', {'value-title'=>'allow'}], ['action', '#?'], ['item', 'm1', {'embedded'=>'hProduct hAudio hEvent hCard'}], # lowercase 'm' = don't try plain string. ], 'options' => { 'rel-tag' => 'category', }, 'rdf:type' => ["${gr}Offering"] , 'rdf:property' => { 'lister' => { resource=>["${hl}contact"] } , 'type' => { literal =>["${hl}type"] } , 'action' => { literal =>["${hl}action"] } , 'dtlisted' => { literal =>["${hl}dtlisted"] } , 'dtexpired' => { literal =>["${hl}dtexpired"] } , 'summary' => { literal =>["${rdfs}label", "${hl}summary"] }, 'description' => { literal =>["${hl}description"] }, 'permalink' => { resource=>["${rdfs}seeAlso"] }, 'category' => { resource=>['http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] }, }, }; } sub add_to_model { my $self = shift; my $model = shift; my $gr = 'http://purl.org/goodrelations/v1#'; my $hl = 'http://ontologi.es/hlisting-hproduct#'; my $rdfs = 'http://www.w3.org/2000/01/rdf-schema#'; my $rdf = 'http://www.w3.org/1999/02/22-rdf-syntax-ns#'; $self->_simple_rdf($model); if ($self->{'DATA'}->{'price'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${gr}hasPriceSpecification"), $self->id(1, 'price'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${rdf}type"), RDF::Trine::Node::Resource->new("${gr}PriceSpecification"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${rdfs}comment"), $self->_make_literal($self->{'DATA'}->{'price'}), )); my ($curr, $val); if ($self->{'DATA'}->{'price'} =~ /^\s*([a-z]{3})\s*(\d*(?:[\,\.]\d\d))\s*$/i) { ($curr, $val) = ($1, $2); } elsif ($self->{'DATA'}->{'price'} =~ /^\s*(\d*(?:[\,\.]\d\d))\s*([a-z]{3})\s*$/i) { ($curr, $val) = ($2, $1); } if (defined $curr && defined $val) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${gr}hasCurrency"), $self->_make_literal($curr, 'string'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'price'), RDF::Trine::Node::Resource->new("${gr}hasCurrencyValue"), $self->_make_literal($val, 'float'), )); } } if ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}item"), $self->{'DATA'}->{'item'}->id(1, 'holder'), )); } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hEvent')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}item"), $self->{'DATA'}->{'item'}->id(1, 'event'), )); } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hAudio')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}item"), $self->{'DATA'}->{'item'}->id(1), )); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${hl}item"), $self->id(1, 'item'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://www.w3.org/2000/01/rdf-schema#label"), $self->_make_literal($self->{'DATA'}->{'item'}->{'fn'}), )) if defined $self->{'DATA'}->{'item'}->{'fn'}; foreach my $url (@{$self->{'DATA'}->{'item'}->{'url'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/page"), RDF::Trine::Node::Resource->new($url), )); } foreach my $photo (@{$self->{'DATA'}->{'item'}->{'photo'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/depiction"), RDF::Trine::Node::Resource->new($photo), )); } } if ($self->{'DATA'}->{'action'} =~ /^\s*(wanted|offer)\s*$/i && defined $self->{'DATA'}->{'lister'}) { $model->add_statement(RDF::Trine::Statement->new( $self->{'DATA'}->{'lister'}->id(1, 'holder'), RDF::Trine::Node::Resource->new(lc $1 eq 'wanted' ? "${gr}seeks" : "${gr}offers"), $self->id(1), )); } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/hListing/0.0/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hListing supports hListing 0.0 as described at L, with the following additions: =over 4 =item * Supports partial datetimes for 'dtexpired'. If, say, only a time is provided, the date and timezone are filled in from 'dtlisted'. This is similar to the behaviour of 'dtstart' and 'dtend' in hCalendar. =back =head1 RDF OUTPUT Listing data is primarily output using GoodRelations v1 (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hReview.pm0000644000076400007640000002731511775403507022251 0ustar taitai=head1 NAME HTML::Microformats::Format::hReview - the hReview and xFolk microformats =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hReview; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @reviews = HTML::Microformats::Format::hReview->extract_all( $dom->documentElement, $context); foreach my $review (@reviews) { print $review->get_reviewer->get_fn . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::hReview inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hReview; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify searchClass); use HTML::Microformats::Format::hReview::rating; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hReview::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hReview::VERSION = '0.105'; } sub new { my ($class, $element, $context, %options) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.holder' => $context->make_bnode , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_xfolk_stuff($clone); $self->_simple_parse($clone); $self->{'DATA'}->{'version'} ||= '0.3' if $element->getAttribute('class') =~ /\b(hreview)\b/; ##TODO post-0.001 # If no "reviewer" is found inside the hReview, parsers should look # outside the hReview, in the context of the page, for the "reviewer". # If there is no "reviewer" outside either, then parsers should use the # author defined by the containing document language, e.g. for HTML # documents, the
    contact info for the page (which is ideally # marked up as an hCard as well) $self->_fallback_item($clone)->_auto_detect_type; $self->{'DATA'}->{'rating'} = [ HTML::Microformats::Format::hReview::rating->extract_all($clone, $context) ]; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _xfolk_stuff { my ($self, $element) = @_; # Handle xFolk. if ($element->getAttribute('class') =~ /\b(xfolkentry)\b/) { my @tl = searchClass('taggedlink', $element); return unless @tl; my ($item_url, $item_img); if ($tl[0]->localname eq 'a' || $tl[0]->localname eq 'area') { $item_url = $self->context->uri($tl[0]->getAttribute('href')); } elsif ($tl[0]->localname eq 'img') { $item_img = $self->context->uri($tl[0]->getAttribute('src')); } elsif ($tl[0]->localname eq 'object') { $item_url = $self->context->uri($tl[0]->getAttribute('data')); } $self->{'DATA'}->{'item'}->{'fn'} = stringify($tl[0], 'value'); $self->{'DATA'}->{'item'}->{'url'} = [$item_url]; $self->{'DATA'}->{'item'}->{'photo'} = [$item_img]; $self->{'DATA'}->{'type'} = 'url'; } return $self; } sub _fallback_item { my ($self, $element) = @_; my @items = searchClass('item', $element); return $self unless @items; my $item = $items[0]; my @fns = searchClass('fn', $item); unless (@fns) { my ($item_url, $item_img); if ($item->localname eq 'a' || $item->localname eq 'area') { $item_url = $self->context->uri($item->getAttribute('href')); } elsif ($item->localname eq 'img') { $item_img = $self->context->uri($item->getAttribute('src')); } elsif ($item->localname eq 'object') { $item_url = $self->context->uri($item->getAttribute('data')); } $self->{'DATA'}->{'item'}->{'fn'} = stringify($item, 'value'); $self->{'DATA'}->{'item'}->{'url'} = [$item_url]; $self->{'DATA'}->{'item'}->{'photo'} = [$item_img]; return $self; } $self->{'DATA'}->{'item'}->{'fn'} = stringify($fns[0], 'value'); foreach my $property (qw(url photo)) { my @urls = searchClass($property, $item); foreach my $url (@urls) { if ($item->localname eq 'a' || $item->localname eq 'area') { push @{$self->{'DATA'}->{'item'}->{$property}}, $self->context->uri($item->getAttribute('href')); } elsif ($item->localname eq 'img') { push @{$self->{'DATA'}->{'item'}->{$property}}, $self->context->uri($item->getAttribute('src')); } elsif ($item->localname eq 'object') { push @{$self->{'DATA'}->{'item'}->{$property}}, $self->context->uri($item->getAttribute('data')); } } } return $self; } sub _auto_detect_type { my $self = shift; if ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hCard') && !defined $self->{'DATA'}->{'type'}) { my $item_type = $self->{'DATA'}->{'item'}->get_kind . ''; if (lc $item_type eq 'individual') { $self->{'DATA'}->{'type'} = 'person'; } elsif ($item_type =~ m'^(group|org)$'i) { $self->{'DATA'}->{'type'} = 'business'; } elsif (lc $item_type eq 'location') { $self->{'DATA'}->{'type'} = 'place'; } else { $self->{'DATA'}->{'type'} = $item_type; } } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hAudio') && !defined $self->{'DATA'}->{'type'}) { $self->{'DATA'}->{'type'} = 'product'; } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hEvent') && !defined $self->{'DATA'}->{'type'}) { $self->{'DATA'}->{'type'} = 'event'; } return $self; } sub format_signature { my $self = shift; my $rev = 'http://www.purl.org/stuff/rev#'; my $hreview = 'http://ontologi.es/hreview#'; my $rv = { 'root' => [qw(hreview xfolkentry)], 'classes' => [ ['reviewer', 'M*', {'embedded'=>'hCard !person'}], # Note: for item we try hAudio first, as it will likely contain an hCard, # Then hEvent, as it may contain an hCard. Lastly try hCard, as it's unlikely # to contain anything else. ['item', 'm1', {'embedded'=>'hProduct hAudio hEvent hCard'}], # lowercase 'm' = don't try plain string. ['version', 'n?'], ['summary', '1'], ['type', '?'], ['bookmark', 'ru?', {'use-key'=>'permalink'}], ['description', 'H*'], ['dtreviewed', 'd?'], ['rating', '*#'], ], 'options' => { 'rel-tag' => 'tag', 'rel-license' => 'license', }, 'rdf:type' => ["${rev}Review"] , 'rdf:property' => { 'description' => { 'literal' => ["${rev}text"] }, 'type' => { 'literal' => ["${rev}type"] }, 'summary' => { 'literal' => ["${rev}title", "http://www.w3.org/2000/01/rdf-schema#label"] }, 'rating' => { 'resource' => ["${hreview}rating"] }, 'version' => { 'literal' => ["${hreview}version"], 'literal_datatype'=>'decimal' }, 'tag' => { 'resource' => ['http://www.holygoat.co.uk/owl/redwood/0.1/tags/taggedWithTag'] }, 'license' => { 'resource' => ["http://www.iana.org/assignments/relation/license", "http://creativecommons.org/ns#license"] }, 'permalink' => { 'resource' => ["http://www.iana.org/assignments/relation/self"] }, 'dtreviewed' => { 'literal' => ["http://purl.org/dc/terms/created"] }, }, }; return $rv; } sub add_to_model { my $self = shift; my $model = shift; my $rev = 'http://www.purl.org/stuff/rev#'; $self->_simple_rdf($model); foreach my $reviewer (@{$self->{'DATA'}->{'reviewer'}}) { if ($self->_isa($reviewer, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rev}reviewer"), $reviewer->id(1, 'holder'), )); } } if ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->{'DATA'}->{'item'}->id(1, 'holder'), RDF::Trine::Node::Resource->new("${rev}hasReview"), $self->id(1), )); } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hEvent')) { $model->add_statement(RDF::Trine::Statement->new( $self->{'DATA'}->{'item'}->id(1, 'event'), RDF::Trine::Node::Resource->new("${rev}hasReview"), $self->id(1), )); } elsif ($self->_isa($self->{'DATA'}->{'item'}, 'HTML::Microformats::Format::hAudio')) { $model->add_statement(RDF::Trine::Statement->new( $self->{'DATA'}->{'item'}->id(1), RDF::Trine::Node::Resource->new("${rev}hasReview"), $self->id(1), )); } else { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("${rev}hasReview"), $self->id(1), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://www.w3.org/2000/01/rdf-schema#label"), $self->_make_literal($self->{'DATA'}->{'item'}->{'fn'}), )) if defined $self->{'DATA'}->{'item'}->{'fn'}; foreach my $url (@{$self->{'DATA'}->{'item'}->{'url'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/page"), RDF::Trine::Node::Resource->new($url), )); } foreach my $photo (@{$self->{'DATA'}->{'item'}->{'photo'}}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/depiction"), RDF::Trine::Node::Resource->new($photo), )); } } foreach my $rating (@{$self->{'DATA'}->{'rating'}}) { if ($rating->get_best==5.0 && $rating->get_worst==0.0) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${rev}rating"), $self->_make_literal($rating->get_value, 'decimal'), )); } } return $self; } sub profiles { my $class = shift; return qw(http://microformats.org/profile/hreview http://ufs.cc/x/hreview http://microformats.org/profile/xfolk http://ufs.cc/x/xfolk http://www.purl.org/stuff/rev# http://microformats.org/wiki/xfolk-profile); } 1; =head1 MICROFORMAT HTML::Microformats::Format::hReview supports hReview 0.3 and xFolk as described at L and L, with the following differences: =over 4 =item * hAudio hAudio microformats can be used as the reviewed item. (At the time of writing this documentation however, HTML::Microformats didn't support hAudio!) =item * Jumbled-up Support for xFolk and hReview are bundled together, so properties are usually supported in both, even if only defined by one microformat spec. (e.g. reviewer is defined by hReview, but this module supports it in xFolk entries.) =back =head1 RDF OUTPUT L, L. =head1 BUGS Please report any bugs to L. Known limitations: =over 4 =item * If no "reviewer" is found inside the hReview, parsers should look outside the hReview, in the context of the page, for the "reviewer". If there is no "reviewer" outside either, then parsers should use the author defined by the containing document language, e.g. for HTML documents, the
    contact info for the page (which is ideally marked up as an hCard as well). =back =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/adr.pm0000644000076400007640000001541711775403507021406 0ustar taitai=head1 NAME HTML::Microformats::Format::adr - the adr microformat =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::adr; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @adrs = HTML::Microformats::Format::adr->extract_all( $dom->documentElement, $context); foreach my $adr (@adrs) { print Dumper($adr->data) . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format::adr inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::adr; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use Locale::Country qw(country2code LOCALE_CODE_ALPHA_2); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::adr::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::adr::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub format_signature { my $vcard = 'http://www.w3.org/2006/vcard/ns#'; my $geo = 'http://www.w3.org/2003/01/geo/wgs84_pos#'; return { 'root' => 'adr', 'classes' => [ ['geo', 'm*', {'embedded'=>'geo'}], # extension to the spec ['post-office-box', '*'], ['extended-address', '*'], ['street-address', '*'], ['locality', '*'], ['region', '*'], ['postal-code', '*'], ['country-name', '*'], ['type', '*'] # only allowed when used in hCard. still... ], 'options' => { 'no-destroy' => ['geo'] }, 'rdf:type' => ["${vcard}Address"] , 'rdf:property' => { 'post-office-box' => { 'literal' => ["${vcard}post-office-box"] } , 'extended-address' => { 'literal' => ["${vcard}extended-address"] } , 'locality' => { 'literal' => ["${vcard}locality"] } , 'region' => { 'literal' => ["${vcard}region"] } , 'postal-code' => { 'literal' => ["${vcard}postal-code"] } , 'country-name' => { 'literal' => ["${vcard}country-name"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; $self->_simple_rdf($model); # Map 'type' (only for valid hCard types though) my @types; foreach my $type (@{ $self->data->{'type'} }) { if ($type =~ /^(dom|home|intl|parcel|postal|pref|work)$/i) { push @types, { 'value' => 'http://www.w3.org/2006/vcard/ns#'.(ucfirst lc $1), 'type' => 'uri', }; } } if (@types) { $model->add_hashref({ $self->id => { 'http://www.w3.org/1999/02/22-rdf-syntax-ns#type' => \@types } }); } $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://buzzword.org.uk/rdf/vcardx#represents-location'), $self->id(1, 'place'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'place'), RDF::Trine::Node::Resource->new('http://www.w3.org/1999/02/22-rdf-syntax-ns#type'), RDF::Trine::Node::Resource->new('http://www.w3.org/2003/01/geo/wgs84_pos#SpatialThing'), )); foreach my $geo (@{ $self->data->{'geo'} }) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new('http://buzzword.org.uk/rdf/vcardx#geo'), $geo->id(1), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'place'), RDF::Trine::Node::Resource->new('http://www.w3.org/2003/01/geo/wgs84_pos#location'), $geo->id(1, 'location'), )); } # Some clever additional stuff: figure out what country code they meant! foreach my $country (@{ $self->data->{'country-name'} }) { my $code = country2code($country, LOCALE_CODE_ALPHA_2); if (defined $code) { $model->add_hashref({ $self->id(0, 'place') => { 'http://www.geonames.org/ontology#inCountry' => [{ 'type'=>'uri', 'value'=>'http://ontologi.es/place/'.(uc $code) }] } }); } } return $self; } sub profiles { my $class = shift; return qw(http://purl.org/uF/adr/0.9/ http://microformats.org/profile/hcard http://ufs.cc/x/hcard http://microformats.org/profile/specs http://ufs.cc/x/specs http://www.w3.org/2006/03/hcard http://purl.org/uF/hCard/1.0/ http://purl.org/uF/2008/03/); } 1; =head1 MICROFORMAT HTML::Microformats::Format::adr supports adr as described at L, with the following additions: =over 4 =item * 'type' property This module is used by HTML::Microformats::Format::hCard to handle addresses within the hCard microformat. hCard addresses include a 'type' property indicating the address type (e.g. home, work, etc). This module supports the 'type' property whether or the address is part of an hCard. =item * Embedded geo microformat If an instance of the geo microformat is found embedded within an address, that geographic location will be associated with the address. =back =head1 RDF OUTPUT Data is returned using the W3C's vCard vocabulary (L) and occasional other terms. Like how HTML::Microformats::Format::hCard differentiates between the business card and the entity represented by the card, this module differentiates between the address and the location represented by it. The former is an abstract social construction, its definition being affected by ephemeral political boundaries; the latter is a physical place. Theoretically multiple addresses could represent the same, or overlapping locations, though this module does not generate any data where that is the case. Where possible, the module uses Locale::Country to determine the two letter ISO code for the country of the location, and include this in the RDF output. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hFreebusy.pm0000644000076400007640000001504211775403507022566 0ustar taitai=head1 NAME HTML::Microformats::Format::hFreebusy - an hCalendar free/busy component =head1 SYNOPSIS use Data::Dumper; use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hCalendar; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @cals = HTML::Microformats::Format::hCalendar->extract_all( $dom->documentElement, $context); foreach my $cal (@cals) { foreach my $fb ($cal->get_vfreebusy) { printf("%s\n", $fb->get_summary); } } =head1 DESCRIPTION HTML::Microformats::Format::hFreebusy is a helper module for HTML::Microformats::hCalendar. This class is used to represent free/busy scheduling components within calendars, which (in practice) are never really published as hCalendar. Generally speaking, you want to use HTML::Microformats::hCalendar instead. HTML::Microformats::Format::hFreebusy inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Method =over =item * C<< to_icalendar >> This method exports the data in iCalendar format. It requires L to work, and will throw an error at run-time if it's not available. =back =cut package HTML::Microformats::Format::hFreebusy; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass stringify); use HTML::Microformats::Datatype::Interval; use RDF::Trine; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hFreebusy::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hFreebusy::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->_simple_parse($clone); $self->_parse_freebusy($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _parse_freebusy { my ($self, $elem) = @_; FREEBUSY: foreach my $fb (searchClass('freebusy', $elem)) { my @fbtype_nodes = searchClass('fbtype', $fb); next FREEBUSY unless @fbtype_nodes; my $FB = { fbtype => stringify($fbtype_nodes[0], {'value-title'=>'allow'}) }; my @value_nodes = searchClass('value', $fb); VALUE: foreach my $v (@value_nodes) { my $val = HTML::Microformats::Datatype::Interval->parse(stringify($v), $v, $self->context); push @{$FB->{'value'}}, $val if defined $val; } push @{$self->{'DATA'}->{'freebusy'}}, $FB; } return $self; } sub format_signature { my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; my $icalx = 'http://buzzword.org.uk/rdf/icaltzdx#'; return { 'root' => 'vtodo', 'classes' => [ ['attendee', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['contact', 'M*', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['comment', '*'], ['dtend', 'd?'], ['dtstamp', 'd?'], ['dtstart', 'd1'], ['duration', 'D?'], ['freebusy', '#+'], ['organizer', 'M?', {embedded=>'hCard !person', 'is-in-cal'=>1}], ['summary', '1'], ['uid', 'U?'], ['url', 'U?'], ], 'options' => { }, 'rdf:type' => ["${ical}Vfreebusy"] , 'rdf:property' => { 'attendee' => { 'resource' => ["${ical}attendee"], 'literal' => ["${icalx}attendee-literal"] } , 'comment' => { 'literal' => ["${ical}comment"] } , 'contact' => { 'resource' => ["${icalx}contact"], 'literal' => ["${ical}contact"] } , 'dtend' => { 'literal' => ["${ical}dtend"] } , 'dtstamp' => { 'literal' => ["${ical}dtstamp"] } , 'dtstart' => { 'literal' => ["${ical}dtstart"] } , 'duration' => { 'literal' => ["${ical}duration"] } , 'organizer' => { 'resource' => ["${ical}organizer"], 'literal' => ["${icalx}organizer-literal"] } , 'summary' => { 'literal' => ["${ical}summary"] } , 'uid' => { 'resource' => ["${ical}uid"] , 'literal' => ["${ical}uid"] , 'literal_datatype' => 'string' } , 'url' => { 'resource' => ["${ical}url"] } , }, }; } sub add_to_model { my $self = shift; my $model = shift; my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; $self->_simple_rdf($model); foreach my $fb (@{$self->data->{'freebusy'}}) { $fb->{'_id'} = $self->context->make_bnode unless defined $fb->{'_id'}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${ical}freebusy"), RDF::Trine::Node::Blank->new(substr $fb->{'_id'}, 2), )); $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Blank->new(substr $fb->{'_id'}, 2), RDF::Trine::Node::Resource->new("${ical}fbtype"), RDF::Trine::Node::Literal->new($fb->{'fbtype'}, undef, 'http://www.w3.org/2001/XMLSchema#string'), )); foreach my $val (@{$fb->{'value'}}) { $model->add_statement(RDF::Trine::Statement->new( RDF::Trine::Node::Blank->new(substr $fb->{'_id'}, 2), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#value"), RDF::Trine::Node::Literal->new($val->to_string, undef, $val->datatype), )); } } return $self; } sub profiles { return HTML::Microformats::Format::hCalendar::profiles(@_); } sub to_icalendar { my ($self) = @_; die "Need RDF::iCalendar to export iCalendar data.\n" unless $HTML::Microformats::Format::hCalendar::HAS_ICAL_EXPORT; my $exporter = RDF::iCalendar::Exporter->new; return $exporter->export_component($self->model, $self->id(1))->to_string; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format/hMeasure.pm0000644000076400007640000003405411775403507022407 0ustar taitai=head1 NAME HTML::Microformats::Format::hMeasure - the hMeasure microformat =head1 SYNOPSIS use HTML::Microformats::DocumentContext; use HTML::Microformats::Format::hMeasure; my $context = HTML::Microformats::DocumentContext->new($dom, $uri); my @objects = HTML::Microformats::Format::hMeasure->extract_all( $dom->documentElement, $context); foreach my $m (@objects) { printf("%s %s\n", $m->get_number, $m->get_unit); } =head1 DESCRIPTION HTML::Microformats::Format::hMeasure inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =cut package HTML::Microformats::Format::hMeasure; use base qw(HTML::Microformats::Format HTML::Microformats::Mixin::Parser); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(searchClass stringify); use HTML::Microformats::Datatype::String qw(isms); use HTML::Microformats::Format::hCard; #use HTML::Microformats::Format::hEvent; use RDF::Trine; 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}|\\\")"; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format::hMeasure::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format::hMeasure::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , 'id.qv' => $context->make_bnode , }; bless $self, $class; my $clone = $element->cloneNode(1); $self->_expand_patterns($clone); $self->{'DATA'}->{'class'} = 'hmeasure'; $self->{'DATA'}->{'class'} = 'hangle' if $clone->getAttribute('class') =~ /\b(hangle)\b/; $self->{'DATA'}->{'class'} = 'hmoney' if $clone->getAttribute('class') =~ /\b(hmoney)\b/; $self->_extract_item($clone, 'vcard', 'HTML::Microformats::Format::hCard'); $self->_extract_item($clone, 'vevent', 'HTML::Microformats::Format::hEvent'); $self->_destroyer($clone); $self->_hmeasure_parse($clone); $self->_hmeasure_fallback($clone); $cache->set($context, $element, $class, $self) if defined $cache; return $self; } sub _extract_item { my ($self, $root, $hclass, $package) = @_; return 1 if defined $self->{'DATA'}->{'item'}; my @nested = searchClass($hclass, $root); foreach my $h (@nested) { next unless ref $h; if ($h->getAttribute('class') =~ /\bitem\b/) { $self->{'DATA'}->{'item'} = $package->new($h, $self->context); push @{ $self->{RemoveTheseNodes} }, $h; last; } my $newClass = $h->getAttribute('class'); $newClass =~ s/\bitem\b//gix; $h->setAttribute('class', $newClass); } return (defined $self->{'DATA'}->{'item'}) ? 1 : 0; } sub _hmeasure_parse { my ($self, $root) = @_; # Number my @nodes = searchClass('num', $root); my $str = stringify($nodes[0], 'value'); $self->{'DATA'}->{'num'} = $str if length $str; push @{ $self->{RemoveTheseNodes} }, $nodes[0] if @nodes; # Unit (except hAngle, as angles don't have units) unless ($self->{'DATA'}->{'class'} eq 'hangle') { @nodes = searchClass('unit', $root); $str = stringify($nodes[0], 'value'); $self->{'DATA'}->{'unit'} = $str if length $str; push @{ $self->{RemoveTheseNodes} }, $nodes[0] if @nodes; } # Type @nodes = searchClass('type', $root); $str = stringify($nodes[0], 'value'); $self->{'DATA'}->{'type'} = $str if length $str; push @{ $self->{RemoveTheseNodes} }, $nodes[0] if @nodes; # Item unless (defined $self->{'DATA'}->{'item'}) { @nodes = searchClass('item', $root); if (@nodes) { my $node = $nodes[0]; my $link; my $str = stringify($node, 'value'); $link = $node->getAttribute('data') if $node->hasAttribute('data'); $link = $node->getAttribute('src') if $node->hasAttribute('src'); $link = $node->getAttribute('href') if $node->hasAttribute('href'); $self->{'DATA'}->{'item_link'} = $link if defined $link; $self->{'DATA'}->{'item_label'} = $str if length $str; $self->{'id.item'} = $self->context->make_bnode; push @{ $self->{RemoveTheseNodes} }, $node; } } # Tolerance @nodes = searchClass('tolerance', $root); $str = stringify($nodes[0], 'value'); if ($str =~ /^\s*($_number)\s*\%\s*$/) { # Construct another hMeasure for the tolerance! $self->{'DATA'}->{'tolerence'} = bless { 'DATA' => { 'class' => 'percentage' , 'num' => $1 , 'unit' => '%', }, 'element' => $self->element , 'context' => $self->context , 'cache' => $self->context->cache , 'id' => $self->context->make_bnode($nodes[0]) , 'id.qv' => $self->context->make_bnode , }; } elsif ($nodes[0]) { my $tolerance = HTML::Microformats::Format::hMeasure->new($nodes[0], $self->context); $self->{'DATA'}->{'tolerence'} = $tolerance if length $tolerance->data->{'num'}; } push @{ $self->{RemoveTheseNodes} }, $nodes[0] if @nodes; } sub _hmeasure_fallback { my ($self, $root) = @_; # Stringify the remainder of the hmeasure (stuff that wasn't # explicitly consumed by _hmeasure_parse). foreach my $node (@{ $self->{RemoveTheseNodes} }) { $node->parentNode->removeChild($node); } my $str = stringify($root, 'value'); # Extract tolerance based on presence of ± character. unless (defined $self->{'DATA'}->{'tolerence'}) { my $tol; ($str, $tol) = split /\x{2213}/, $str; $str =~ s/(^\s+)|(\s+$)//g; $tol =~ s/(^\s+)|(\s+$)//g; if (length $tol) { $tol =~ /$_number/; $self->{'DATA'}->{'tolerence'} = bless { 'DATA' => { 'class' => $self->{'DATA'}->{'class'} , 'num' => $1 , }, 'element' => $self->element , 'context' => $self->context , 'cache' => $self->context->cache , 'id' => $self->context->make_bnode , 'id.qv' => $self->context->make_bnode , }; $tol =~ s/$_number//; $self->{'DATA'}->{'tolerence'}->{'DATA'}->{'unit'} = $tol; } } my $autounit = 0; # If this is an angle and we don't have a num, then the # remaining string must be the num. if ($self->{'DATA'}->{'class'} eq 'hangle' && !defined $self->{'DATA'}->{'num'}) { $self->{'DATA'}->{'num'} = $str; } # Otherwise, if we've got a num, but no unit, remainder # must be the unit. elsif (defined $self->{'DATA'}->{'num'} && !defined $self->{'DATA'}->{'unit'}) { $self->{'DATA'}->{'unit'} = $str; $autounit = 1; } # Otherwise, if we've got a unit but no number, find the number # using a regexp. elsif (defined $self->{'DATA'}->{'unit'} && !defined $self->{'DATA'}->{'num'}) { $str =~ s/\s+//g; $str =~ /$_number/; $self->{'DATA'}->{'num'} = $str; } # If neither the unit nor number have been found yet, then the # remaining string must contain both! elsif (!defined $self->{'DATA'}->{'num'} && !defined $self->{'DATA'}->{'unit'}) { $str =~ /$_number/; $self->{'DATA'}->{'num'} = $1; $str =~ s/\s*($_number)\s*//; $self->{'DATA'}->{'unit'} = $str; $autounit = 1; } # For hmoney, the unit is predictable - it's a currency # code or symbol, so make an effort to find it properly # using regexps. if ($self->{'DATA'}->{'class'} eq 'hmoney' and $autounit) { $self->{'DATA'}->{'unit'} =~ /(\b[A-Z]{3}\b|\x{20AC}|\x{00A3}|\x{00A5}|\x{0024})/i; $self->{'DATA'}->{'unit'} = uc $1 if length $1; } # Expand abbreviated currency units. if ($self->{'DATA'}->{'class'} eq 'hmoney') { $self->{'DATA'}->{'unit'} = 'EUR' if $self->{'DATA'}->{'unit'} =~ /^\x{20AC}$/; $self->{'DATA'}->{'unit'} = 'GBP' if $self->{'DATA'}->{'unit'} =~ /^\x{00A3}$/; $self->{'DATA'}->{'unit'} = 'JPY' if $self->{'DATA'}->{'unit'} =~ /^\x{00A5}$/; $self->{'DATA'}->{'unit'} = 'USD' if $self->{'DATA'}->{'unit'} =~ /^\x{0024}$/; } # Clean up punctuation in number. $self->{'DATA'}->{'num'} =~ s/\,/\./g; $self->{'DATA'}->{'num'} =~ s/\x{2212}/\-/g; # Angles might be given as degrees,minutes,seconds. if ($self->{'DATA'}->{'class'} eq 'hangle') { $str = $self->{'DATA'}->{'num'}; $str =~ m/$_degree/; $self->{'DATA'}->{'num_degree'} = $1 if length $1; $str =~ m/$_minute/; $self->{'DATA'}->{'num_minute'} = $1 if length $1; $str =~ m/$_second/; $self->{'DATA'}->{'num_second'} = $1 if length $1; if ($self->{'DATA'}->{'num_degree'} < 0) { $self->{'DATA'}->{'num_minute'} *= -1; $self->{'DATA'}->{'num_second'} *= -1; } elsif ($self->{'DATA'}->{'num_degree'} == 0 && $self->{'DATA'}->{'num_minute'} < 0) { $self->{'DATA'}->{'num_second'} *= -1; } $self->{'DATA'}->{'num'} = $self->{'DATA'}->{'num_degree'} + ( $self->{'DATA'}->{'num_minute'} / 60 ) + ( $self->{'DATA'}->{'num_second'} / 3600 ); $self->{'DATA'}->{'num_label'} = $str; } # If no unit given for tolerance, copy from base measurement. if ($self->{'DATA'}->{'class'} ne 'hangle' && defined $self->{'DATA'}->{'tolerance'} && !defined $self->{'DATA'}->{'tolerance'}->{'DATA'}->{'unit'}) { $self->{'DATA'}->{'tolerance'}->{'DATA'}->{'unit'} = $self->{'DATA'}->{'unit'}; } } sub profiles { return qw(http://purl.org/uF/hMeasure/0.1/); } sub add_to_model { my ($self, $model) = @_; my $mx = 'http://buzzword.org.uk/rdf/measure-aux#'; $self->_simple_rdf($model); $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${mx}hasValue"), $self->id(1, 'qv'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'qv'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("${mx}QualifiedValue"), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'qv'), RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#value"), RDF::Trine::Node::Literal->new($self->data->{'num'}), )) if $self->data->{'num'}; $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'qv'), RDF::Trine::Node::Resource->new("${mx}unit"), RDF::Trine::Node::Literal->new($self->data->{'unit'}), )) if $self->data->{'unit'}; my $dimension = $self->_dimension_uri; $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${mx}dimension"), RDF::Trine::Node::Resource->new($dimension), )) if defined $dimension; my $item = $self->data->{'item'}; if (ref $item and $item->isa('HTML::Microformats::Format::hCard')) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${mx}item"), $item->id(1, 'holder'), )); $model->add_statement(RDF::Trine::Statement->new( $item->id(1, 'holder'), RDF::Trine::Node::Resource->new($dimension), $self->id(1, 'qv'), )) if defined $dimension; } elsif (defined $self->{'id.item'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1), RDF::Trine::Node::Resource->new("${mx}item"), $self->id(1, 'item'), )); $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new($dimension), $self->id(1, 'qv'), )) if defined $dimension; if (isms($self->data->{'item_label'})) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://www.w3.org/2000/01/rdf-schema#label"), RDF::Trine::Node::Literal->new($self->data->{'item_label'}->to_string, $self->data->{'item_label'}->lang), )); } elsif (defined $self->data->{'item_label'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://www.w3.org/2000/01/rdf-schema#label"), RDF::Trine::Node::Literal->new($self->data->{'item_label'}), )); } if (defined $self->data->{'item_link'}) { $model->add_statement(RDF::Trine::Statement->new( $self->id(1, 'item'), RDF::Trine::Node::Resource->new("http://xmlns.com/foaf/0.1/page"), RDF::Trine::Node::Resource->new($self->data->{'item_link'}), )); } } # TODO: handle tolerances. post-0.001 return $model; } sub _dimension_uri { my $self = shift; return 'http://purl.org/commerce#costs' if $self->data->{'class'} eq 'hmoney' && !defined $self->data->{type}; return unless defined $self->data->{type}; my $dimension = lc $self->data->{'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 format_signature { return { 'root' => [qw(hmeasure hmoney hangle)] , 'classes' => [ ['num', '1'], ['unit', '?'], ['item', '?'], ['type', '?'], ['tolerance', '?'], ] , 'options' => {} , 'rdf:type' => ['http://buzzword.org.uk/rdf/measure-aux#Measurement'] , 'rdf:property' => {} , }; } 1; =head1 MICROFORMAT HTML::Microformats::Format::hMeasure supports hMeasure as described at L. =head1 RDF OUTPUT This module outputs RDF using the Extensible Measurement Ontology (L). =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Format_Rel.pm0000644000076400007640000000514011775403507021432 0ustar taitai=head1 NAME HTML::Microformats::Format_Rel - base rel-* microformat class =head1 SYNOPSIS my @tags = HTML::Microformats::RelTag->extract_all( $doc->documentElement, $context); foreach my $tag (@tags) { print $tag->get_href . "\n"; } =head1 DESCRIPTION HTML::Microformats::Format_Rel inherits from HTML::Microformats::Format. See the base class definition for a description of property getter/setter methods, constructors, etc. =head2 Additional Methods =over 4 =item C<< $relfoo->get_href() >> Returns the absolute URL of the resource being linked to. =item C<< $relfoo->get_label() >> Returns the linked text of the EaE element. Microformats patterns like value excerpting are used. =item C<< $relfoo->get_title() >> Returns the contents of the title attribute of the EaE element, or the same as C<< $relfoo->get_label() >> if the attribute is not set. =back =cut package HTML::Microformats::Format_Rel; use base qw(HTML::Microformats::Format); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Utilities qw(stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Format_Rel::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Format_Rel::VERSION = '0.105'; } sub new { my ($class, $element, $context) = @_; my $cache = $context->cache; return $cache->get($context, $element, $class) if defined $cache && $cache->get($context, $element, $class); my $self = { 'element' => $element , 'context' => $context , 'cache' => $cache , 'id' => $context->make_bnode($element) , }; bless $self, $class; $self->{'DATA'}->{'href'} = $context->uri( $element->getAttribute('href') ); $self->{'DATA'}->{'label'} = stringify($element, 'value'); $self->{'DATA'}->{'title'} = $element->hasAttribute('title') ? $element->getAttribute('title') : $self->{'DATA'}->{'label'}; $cache->set($context, $element, $class, $self) if defined $cache; return $self; } 1; =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/ObjectCache.pm0000644000076400007640000000555511775403507021544 0ustar taitaipackage HTML::Microformats::ObjectCache; use strict qw(subs vars); no warnings; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::ObjectCache::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::ObjectCache::VERSION = '0.105'; } sub new { my $class = shift; my $self = bless {}, $class; return $self; } sub set { my $self = shift; my $ctx = shift; my $elem = shift; my $klass = shift; my $obj = shift; my $nodepath = $elem->getAttribute('data-cpan-html-microformats-nodepath'); $self->{ $ctx->uri }->{ $klass }->{ $nodepath } = $obj; return $self->{ $ctx->uri }->{ $klass }->{ $nodepath }; } sub get { my $self = shift; my $ctx = shift; my $elem = shift; my $klass = shift; my $nodepath = $elem->getAttribute('data-cpan-html-microformats-nodepath'); # print sprintf("Cache %s on %s for %s.\n", # ($self->{ $ctx->uri }->{ $klass }->{ $nodepath } ? 'HIT' : 'miss'), # $nodepath, $klass); return $self->{ $ctx->uri }->{ $klass }->{ $nodepath }; } sub get_all { my $self = shift; my $ctx = shift; my $klass = shift || undef; if (defined $klass) { return values %{ $self->{$ctx->uri}->{$klass} }; } my @rv; foreach my $klass ( keys %{ $self->{$ctx->uri} } ) { push @rv, (values %{ $self->{$ctx->uri}->{$klass} }); } return @rv; } 1; __END__ =head1 NAME HTML::Microformats::ObjectCache - cache for microformat objects =head1 DESCRIPTION Prevents microformats from being parsed twice within the same context. This is not just for saving time. It also prevents the occasional infinite loop, and makes sure identifiers are used consistently. =head2 Constructor =over =item C<< $cache = HTML::Microformats::ObjectCache->new >> Creates a new, empty cache. =back =head2 Public Methods =over =item C<< $cache->set($context, $package, $element, $object); >> For a given context, package (e.g. 'HTML::Microformats::Format::hCard') and DOM element node, stores an object in the cache. =item C<< $object = $cache->get($context, $package, $element); >> For a given context, package (e.g. 'HTML::Microformats::Format::hCard') and DOM element node, retrieves an object from the cache. =item C<< @objects = $cache->get_all($context, [$package]); >> For a given context and package (e.g. 'HTML::Microformats::Format::hCard'), retrieves a list of objects from within the cache. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. HTML-Microformats-0.105/lib/HTML/Microformats/Documentation/0000755000076400007640000000000011775404022021644 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Documentation/Notes.pod0000644000076400007640000000756711775403507023466 0ustar taitai=head1 NAME HTML::Microformats::Documentation::Notes - misc usage and design notes =head1 NOTES =head2 Byzantine Internals The internals of HTML::Microformats are pretty complicated - best to steer clear of them. Here are three usage patterns that mostly avoid dealing with the internals: =over =item * B A page can be parsed into an L and queried using SPARQL. use HTML::Microformats; use LWP::Simple qw[get]; use RDF::Query; my $page = 'http://example.net/'; my $graph = HTML::Microformats ->new_document(get($page), $page) ->assume_all_profiles ->parse_microformats ->model; my $query = RDF::Query->new(< SELECT DISTINCT ?friendname ?friendpage WHERE { <$page> ?p ?friendpage . ?person foaf:name ?friendname ; foaf:page ?friendpage . FILTER ( isURI(?friendpage) && isLiteral(?friendname) && regex(str(?p), "^http://vocab.sindice.com/xfn#(.+)-hyperlink") ) } SPARQL my $results = $query->execute($graph); while (my $result = $results->next) { printf("%s <%s>\n", $result->{friendname}->literal_value, $result->{friendpage}->uri, ); } =item * B The C method on microformat objects returns a hashref of useful data. use HTML::Microformats; use LWP::Simple qw[get]; my $page = 'http://example.net/'; my @xfn_objs = HTML::Microformats ->new_document(get($page), $page) ->assume_all_profiles ->parse_microformats ->objects('XFN'); while (my $xfn = shift @xfn_objs) { printf("%s <%s>\n", $xfn->data->{title}, $xfn->data->{href}, ); } (If you're wondering why the second example's simpler it's because it returns somewhat dumber data.) =item * B Various microformat objects have C methods allowing the data to be exported in various formats.. use HTML::Microformats; use LWP::Simple qw[get]; my $page = 'http://example.net/'; my @hcards = HTML::Microformats ->new_document(get($page), $page) ->assume_all_profiles ->parse_microformats ->objects('hCard'); print $_->to_vcard foreach @hcards; Methods available are: =over =item * C (hCard objects) Exports as vCard 3.0. =item * C (hCard objects) Exports as vCard 4.0. =item * C (hCard objects) Exports as vCard XML. =item * C (hCalendar, hEvent, hTodo, hFreebusy, hAlarm and hEntry objects) Exports as iCalendar. =item * C (hAtom and hEntry objects) Exports as Atom 1.0. =item * C (geo objects) Exports as KML 2.0. =item * C<< serialialise_model(as => $format) >> (all microformat objects) Exports as RDF, serialised as C<$format>. (Format can be 'RDFXML', 'Turtle', 'NTriples', 'RDFJSON'.) =back =back =head2 Stuff that's b0rked The C, C, C, C methods defined in L work unreliably and are poorly documented. You're better off using the C method and inspecting the returned structure for the data you need. This will be fixed in the future. =head2 Here be monsters There are several parts of the code which are incredibly complicated and desperately need refactoring. This will be done at some point, so don't rely too much on their current behaviour. C and C<_stringify_helper> in L. The whole of L. =head1 SEE ALSO L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/0000755000076400007640000000000011775404022020606 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Datatype/DateTime/0000755000076400007640000000000011775404022022302 5ustar taitaiHTML-Microformats-0.105/lib/HTML/Microformats/Datatype/DateTime/Parser.pm0000644000076400007640000011565011775403507024113 0ustar taitai=head1 NAME HTML::Microformats::Datatype::DateTime::Parser - parse ISO8601 datetimes =head1 DESCRIPTION This module is a moderately modified version of L. It allows datetimes to be expressed with a somewhat looser syntax, especially support for whitespace between the date and time instead of a "T". It also calculates the "resolution" of the datetime (e.g. is it specified to year, month, day, hour, minute, second or nanosecond precision) which it places in $dt->{'resolution'}. Other than that, it can be used exactly as DateTime::Format::ISO8601 can. It parses strings into normal DateTime objects. =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. Based on DateTime::Format::ISO8601 by Joshua Hoblitt. =head1 COPYRIGHT AND LICENCE Copyright 2003-2005 Joshua Hoblitt Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut package HTML::Microformats::Datatype::DateTime::Parser; use strict qw(subs vars); no warnings; use Carp qw( croak ); use DateTime; use DateTime::Format::Builder; use Params::Validate qw( validate validate_pos BOOLEAN OBJECT SCALAR ); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::DateTime::Parser::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::DateTime::Parser::VERSION = '0.105'; } { my $default_legacy_year; sub DefaultLegacyYear { my $class = shift; ( $default_legacy_year ) = validate_pos( @_, { type => BOOLEAN, callbacks => { 'is 0, 1, or undef' => sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, }, } ) if @_; return $default_legacy_year; } } __PACKAGE__->DefaultLegacyYear( 1 ); { my $default_cut_off_year; sub DefaultCutOffYear { my $class = shift; ( $default_cut_off_year ) = validate_pos( @_, { type => SCALAR, callbacks => { 'is between 0 and 99' => sub { $_[0] >= 0 && $_[0] <= 99 }, }, } ) if @_; return $default_cut_off_year; } } # the same default value as DT::F::Mail __PACKAGE__->DefaultCutOffYear( 49 ); sub new { my( $class ) = shift; my %args = validate( @_, { base_datetime => { type => OBJECT, can => 'utc_rd_values', optional => 1, }, legacy_year => { type => BOOLEAN, default => $class->DefaultLegacyYear, callbacks => { 'is 0, 1, or undef' => sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, }, }, cut_off_year => { type => SCALAR, default => $class->DefaultCutOffYear, callbacks => { 'is between 0 and 99' => sub { $_[0] >= 0 && $_[0] <= 99 }, }, }, } ); $class = ref( $class ) || $class; my $self = bless( \%args, $class ); if ( $args{ base_datetime } ) { $self->set_base_datetime( object => $args{ base_datetime } ); } return( $self ); } # lifted from DateTime sub clone { bless { %{ $_[0] } }, ref $_[0] } sub base_datetime { $_[0]->{ base_datetime } } sub set_base_datetime { my $self = shift; my %args = validate( @_, { object => { type => OBJECT, can => 'utc_rd_values', }, } ); # ISO8601 only allows years 0 to 9999 # this implimentation ignores the needs of expanded formats my $dt = DateTime->from_object( object => $args{ object } ); my $lower_bound = DateTime->new( year => 0 ); my $upper_bound = DateTime->new( year => 10000 ); if ( $dt < $lower_bound ) { croak "base_datetime must be greater then or equal to ", $lower_bound->iso8601; } if ( $dt >= $upper_bound ) { croak "base_datetime must be less then ", $upper_bound->iso8601; } $self->{ base_datetime } = $dt; return $self; } sub legacy_year { $_[0]->{ legacy_year } } sub set_legacy_year { my $self = shift; my @args = validate_pos( @_, { type => BOOLEAN, callbacks => { 'is 0, 1, or undef' => sub { ! defined( $_[0] ) || $_[0] == 0 || $_[0] == 1 }, }, } ); $self->{ legacy_year } = $args[0]; return $self; } sub cut_off_year { $_[0]->{ cut_off_year } } sub set_cut_off_year { my $self = shift; my @args = validate_pos( @_, { type => SCALAR, callbacks => { 'is between 0 and 99' => sub { $_[0] >= 0 && $_[0] <= 99 }, }, } ); $self->{ cut_off_year } = $args[0]; return $self; } DateTime::Format::Builder->create_class( parsers => { parse_datetime => [ [ preprocess => \&_do_whitespace ], { #YYYYMMDD 19850412 length => [qw(8 9)], regex => qr/^ (-?\d{4}) ([01]\d) ([0-3]\d) $/x, params => [ qw( year month day ) ], postprocess => \&_do_resolution, }, { # uncombined with above because #regex => qr/^ (\d{4}) -?? (\d\d) -?? (\d\d) $/x, # was matching 152746-05 #YYYY-MM-DD 1985-04-12 length => [qw(10 11)], regex => qr/^ (-?\d{4}) - ([01]\d) - ([0-3]\d) $/x, params => [ qw( year month day ) ], postprocess => \&_do_resolution, }, { #YYYY-MM 1985-04 length => [qw(7 8)], regex => qr/^ (-?\d{4}) - ([01]\d) $/x, params => [ qw( year month ) ], postprocess => \&_do_resolution, }, { #YYYY 1985 length => [qw(4 5)], regex => qr/^ (-?\d{4}) $/x, params => [ qw( year ) ], postprocess => \&_do_resolution, }, { #YY 19 (century) length => 2, regex => qr/^ (\d\d) $/x, params => [ qw( year ) ], postprocess => [\&_normalize_century, \&_do_resolution], }, { #YYMMDD 850412 #YY-MM-DD 85-04-12 length => [ qw( 6 8 ) ], regex => qr/^ (\d\d) -?? ([01]\d) -?? ([0-3]\d) $/x, params => [ qw( year month day ) ], postprocess => [\&_fix_2_digit_year, \&_do_resolution], }, { #-YYMM -8504 #-YY-MM -85-04 length => [ qw( 5 6 ) ], regex => qr/^ - (\d\d) -?? ([01]\d) $/x, params => [ qw( year month ) ], postprocess => [\&_fix_2_digit_year, \&_do_resolution], }, { #-YY -85 length => 3, regex => qr/^ - (\d\d) $/x, params => [ qw( year ) ], postprocess => [\&_fix_2_digit_year, \&_do_resolution], }, { #--MMDD --0412 #--MM-DD --04-12 length => [ qw( 6 7 ) ], regex => qr/^ -- ([01]\d) -?? ([0-3]\d) $/x, params => [ qw( month day ) ], postprocess => [\&_add_year, \&_do_resolution], }, { #--MM --04 length => 4, regex => qr/^ -- ([01]\d) $/x, params => [ qw( month ) ], postprocess => [\&_add_year, \&_do_resolution], }, { #---DD ---12 length => 5, regex => qr/^ --- ([0-3]\d) $/x, params => [ qw( day ) ], postprocess => [ \&_add_year, \&_add_month, \&_do_resolution], }, { #+[YY]YYYYMMDD +0019850412 #+[YY]YYYY-MM-DD +001985-04-12 length => [ qw( 11 13 ) ], regex => qr/^ \+ (\d{6}) -?? ([01]\d) -?? ([0-3]\d) $/x, params => [ qw( year month day ) ], postprocess => \&_do_resolution, }, { #+[YY]YYYY-MM +001985-04 length => 10, regex => qr/^ \+ (\d{6}) - (\d\d) $/x, params => [ qw( year month ) ], postprocess => \&_do_resolution, }, { #+[YY]YYYY +001985 length => 7, regex => qr/^ \+ (\d{6}) $/x, params => [ qw( year ) ], postprocess => \&_do_resolution, }, { #+[YY]YY +0019 (century) length => 5, regex => qr/^ \+ (\d{4}) $/x, params => [ qw( year ) ], postprocess => [\&_normalize_century, \&_do_resolution], }, { #YYYYDDD 1985102 #YYYY-DDD 1985-102 length => [ qw( 7 8 9 ) ], regex => qr/^ (-?\d{4}) -?? (\d{3}) $/x, params => [ qw( year day_of_year ) ], constructor => [ 'DateTime', 'from_day_of_year' ], postprocess => \&_do_resolution, }, { #YYDDD 85102 #YY-DDD 85-102 length => [ qw( 5 6 7 ) ], regex => qr/^ (-?\d\d) -?? (\d{3}) $/x, params => [ qw( year day_of_year ) ], postprocess => [ \&_fix_2_digit_year, \&_do_resolution], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-DDD -102 length => 4, regex => qr/^ - (\d{3}) $/x, params => [ qw( day_of_year ) ], postprocess => [ \&_add_year, \&_do_resolution], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #+[YY]YYYYDDD +001985102 #+[YY]YYYY-DDD +001985-102 length => [ qw( 10 11 ) ], regex => qr/^ \+ (\d{6}) -?? (\d{3}) $/x, params => [ qw( year day_of_year ) ], constructor => [ 'DateTime', 'from_day_of_year' ], postprocess => \&_do_resolution, }, { #YYYYWwwD 1985W155 #YYYY-Www-D 1985-W15-5 length => [ qw( 8 9 10 11 ) ], regex => qr/^ (-?\d{4}) -?? W (\d\d) -?? (\d) $/x, params => [ qw( year week day_of_year ) ], postprocess => [ \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #YYYYWww 1985W15 #YYYY-Www 1985-W15 length => [ qw( 7 8 9 ) ], regex => qr/^ (-?\d{4}) -?? W (\d\d) $/x, params => [ qw( year week ) ], postprocess => [ \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #YYWwwD 85W155 #YY-Www-D 85-W15-5 length => [ qw( 6 7 8 9 ) ], regex => qr/^ (-?\d\d) -?? W (\d\d) -?? (\d) $/x, params => [ qw( year week day_of_year ) ], postprocess => [ \&_fix_2_digit_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #YYWww 85W15 #YY-Www 85-W15 length => [ qw( 5 6 7 ) ], regex => qr/^ (-?\d\d) -?? W (\d\d) $/x, params => [ qw( year week ) ], postprocess => [ \&_fix_2_digit_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-YWwwD -5W155 #-Y-Www-D -5-W15-5 length => [ qw( 6 8 ) ], regex => qr/^ - (\d) -?? W (\d\d) -?? (\d) $/x, params => [ qw( year week day_of_year ) ], postprocess => [ \&_fix_1_digit_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-YWww -5W15 #-Y-Www -5-W15 length => [ qw( 5 6 ) ], regex => qr/^ - (\d) -?? W (\d\d) $/x, params => [ qw( year week ) ], postprocess => [ \&_fix_1_digit_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-WwwD -W155 #-Www-D -W15-5 length => [ qw( 5 6 ) ], regex => qr/^ - W (\d\d) -?? (\d) $/x, params => [ qw( week day_of_year ) ], postprocess => [ \&_add_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-Www -W15 length => 4, regex => qr/^ - W (\d\d) $/x, params => [ qw( week ) ], postprocess => [ \&_add_year, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #-W-D -W-5 length => 4, regex => qr/^ - W - (\d) $/x, params => [ qw( day_of_year ) ], postprocess => [ \&_add_year, \&_add_week, \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #+[YY]YYYYWwwD +001985W155 #+[YY]YYYY-Www-D +001985-W15-5 length => [ qw( 11 13 ) ], regex => qr/^ \+ (\d{6}) -?? W (\d\d) -?? (\d) $/x, params => [ qw( year week day_of_year ) ], postprocess => [ \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #+[YY]YYYYWww +001985W15 #+[YY]YYYY-Www +001985-W15 length => [ qw( 10 11 ) ], regex => qr/^ \+ (\d{6}) -?? W (\d\d) $/x, params => [ qw( year week ) ], postprocess => [ \&_normalize_week, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, { #hhmmss 232050 - skipped #hh:mm:ss 23:20:50 length => [ qw( 8 9 ) ], regex => qr/^ T?? (\d\d) : (\d\d) : (\d\d) $/x, params => [ qw( hour minute second) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, #hhmm 2320 - skipped #hh 23 -skipped { #hh:mm 23:20 length => [ qw( 4 5 6 ) ], regex => qr/^ T?? (\d\d) :?? (\d\d) $/x, params => [ qw( hour minute ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #hhmmss,ss 232050,5 #hh:mm:ss,ss 23:20:50,5 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, params => [ qw( hour minute second nanosecond) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_fractional_second, \&_do_resolution ], }, { #hhmm,mm 2320,8 #hh:mm,mm 23:20,8 regex => qr/^ T?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, params => [ qw( hour minute second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_fractional_minute, \&_do_resolution ], }, { #hh,hh 23,3 regex => qr/^ T?? (\d\d) [\.,] (\d+) $/x, params => [ qw( hour minute ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_fractional_hour, \&_do_resolution ], }, { #-mmss -2050 - skipped #-mm:ss -20:50 length => 6, regex => qr/^ - (\d\d) : (\d\d) $/x, params => [ qw( minute second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_do_resolution ], }, #-mm -20 - skipped #--ss --50 - skipped { #-mmss,s -2050,5 #-mm:ss,s -20:50,5 regex => qr/^ - (\d\d) :?? (\d\d) [\.,] (\d+) $/x, params => [ qw( minute second nanosecond ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_fractional_second, \&_do_resolution ], }, { #-mm,m -20,8 regex => qr/^ - (\d\d) [\.,] (\d+) $/x, params => [ qw( minute second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_fractional_minute, \&_do_resolution ], }, { #--ss,s --50,5 regex => qr/^ -- (\d\d) [\.,] (\d+) $/x, params => [ qw( second nanosecond) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_add_minute, \&_fractional_second, \&_do_resolution ], }, { #hhmmssZ 232030Z #hh:mm:ssZ 23:20:30Z length => [ qw( 7 8 9 10 ) ], regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) Z $/x, params => [ qw( hour minute second ) ], extra => { time_zone => 'UTC' }, postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #hhmmss.ssZ 232030.5Z #hh:mm:ss.ssZ 23:20:30.5Z regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) Z $/x, params => [ qw( hour minute second nanosecond) ], extra => { time_zone => 'UTC' }, postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_fractional_second, \&_do_resolution ], }, { #hhmmZ 2320Z #hh:mmZ 23:20Z length => [ qw( 5 6 7 ) ], regex => qr/^ T?? (\d\d) :?? (\d\d) Z $/x, params => [ qw( hour minute ) ], extra => { time_zone => 'UTC' }, postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #hhZ 23Z length => [ qw( 3 4 ) ], regex => qr/^ T?? (\d\d) Z $/x, params => [ qw( hour ) ], extra => { time_zone => 'UTC' }, postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { # TOBY - modified #hhmmss[+-]hhmm 152746+0100 152746-0500 #hh:mm:ss[+-]hh:mm 15:27:46+01:00 15:27:46-05:00 length => [ qw( 11 12 14 15 ) ], regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( hour minute second time_zone ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_normalize_offset, \&_do_resolution ], }, { # TOBY - modified #hhmmss.ss[+-]hhmm 152746.5+0100 152746.5-0500 #hh:mm:ss.ss[+-]hh:mm 15:27:46.5+01:00 15:27:46.5-05:00 regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( hour minute second nanosecond time_zone ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_fractional_second, \&_normalize_offset, \&_do_resolution ], }, { #hhmmss[+-]hh 152746+01 152746-05 #hh:mm:ss[+-]hh 15:27:46+01 15:27:46-05 length => [ qw( 9 10 11 12 ) ], regex => qr/^ T?? (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d) $/x, params => [ qw( hour minute second time_zone ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_normalize_offset, \&_do_resolution ], }, { #YYYYMMDDThhmmss 19850412T101530 #YYYY-MM-DDThh:mm:ss 1985-04-12T10:15:30 # length => [ qw( 15 19 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) :?? (\d\d) $/x, params => [ qw( year month day hour minute second ) ], extra => { time_zone => 'floating' }, postprocess => \&_do_resolution }, { #YYYYMMDDThhmmss.ss 19850412T101530.123 #YYYY-MM-DDThh:mm:ss.ss 1985-04-12T10:15:30.123 regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) $/x, params => [ qw( year month day hour minute second nanosecond ) ], extra => { time_zone => 'floating' }, postprocess => [ \&_fractional_second, \&_do_resolution ], }, { #YYYYMMDDThhmmssZ 19850412T101530Z #YYYY-MM-DDThh:mm:ssZ 1985-04-12T10:15:30Z # length => [ qw( 16 20 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) :?? (\d\d) Z $/x, params => [ qw( year month day hour minute second ) ], extra => { time_zone => 'UTC' }, postprocess => \&_do_resolution }, { #YYYYMMDDThhmmss.ssZ 19850412T101530.5Z 20041020T101530.5Z #YYYY-MM-DDThh:mm:ss.ssZ 1985-04-12T10:15:30.5Z 1985-04-12T10:15:30.5Z regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) Z$/x, params => [ qw( year month day hour minute second nanosecond ) ], extra => { time_zone => 'UTC' }, postprocess => [ \&_fractional_second, \&_do_resolution ], }, { # TOBY - added #YYYYMMDDThh[+-]hhmm 19850412T10+0100 20041020T10-0500 #YYYY-MM-DDThh[+-]hh:mm 1985-04-12T10+01:00 1985-04-12T10-05:00 regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( year month day hour time_zone ) ], postprocess => [ \&_normalize_offset, \&_do_resolution ], }, { # TOBY - added #YYYYMMDDThhmm[+-]hhmm 19850412T1015+0100 20041020T1015-0500 #YYYY-MM-DDThh:mm[+-]hh:mm 1985-04-12T10:15+01:00 1985-04-12T10:15-05:00 regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T?? (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( year month day hour minute time_zone ) ], postprocess => [ \&_normalize_offset, \&_do_resolution ], }, { # TOBY - modified #YYYYMMDDThhmmss[+-]hhmm 19850412T101530+0400 #YYYY-MM-DDThh:mm:ss[+-]hh:mm 1985-04-12T10:15:30+04:00 # length => [ qw( 20 25 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( year month day hour minute second time_zone ) ], postprocess => [\&_normalize_offset,\&_do_resolution] }, { # TOBY - modified #YYYYMMDDThhmmss.ss[+-]hhmm 19850412T101530.5+0100 20041020T101530.5-0500 #YYYY-MM-DDThh:mm:ss.ss[+-]hh:mm 1985-04-12T10:15:30.5+01:00 1985-04-12T10:15:30.5-05:00 regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T?? (\d\d) :?? (\d\d) :?? (\d\d) [\.,] (\d+) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( year month day hour minute second nanosecond time_zone ) ], postprocess => [ \&_fractional_second, \&_normalize_offset, \&_do_resolution ], }, { #YYYYMMDDThhmmss[+-]hh 19850412T101530+04 #YYYY-MM-DDThh:mm:ss[+-]hh 1985-04-12T10:15:30+04 # length => [ qw( 18 22 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) :?? (\d\d) ([+-] \d\d) $/x, params => [ qw( year month day hour minute second time_zone ) ], postprocess => [\&_normalize_offset, \&_do_resolution] }, { #YYYYMMDDThhmm 19850412T1015 #YYYY-MM-DDThh:mm 1985-04-12T10:15 # length => [ qw( 13 16 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d\d) -?? (\d\d) T (\d\d) :?? (\d\d) $/x, params => [ qw( year month day hour minute ) ], extra => { time_zone => 'floating' }, postprocess => [\&_normalize_offset, \&_do_resolution] }, { #YYYYDDDThhmmZ 1985102T1015Z #YYYY-DDDThh:mmZ 1985-102T10:15Z # length => [ qw( 13 15 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? (\d{3}) T (\d\d) :?? (\d\d) Z $/x, params => [ qw( year day_of_year hour minute ) ], extra => { time_zone => 'UTC' }, constructor => [ 'DateTime', 'from_day_of_year' ], postprocess => [\&_normalize_offset, \&_do_resolution] }, { # TOBY - modified #YYYYWwwDThhmm[+-]hhmm 1985W155T1015+0400 #YYYY-Www-DThh:mm[+-]hh 1985-W15-5T10:15+04 # length => [ qw( 18 19 ) ], regex => qr/^ ((?:\-|\+\d+)?\d{4}) -?? W (\d\d) -?? (\d) T (\d\d) :?? (\d\d) ([+-] \d\d (?: :?? \d\d)?) $/x, params => [ qw( year week day_of_year hour minute time_zone) ], postprocess => [ \&_normalize_week, \&_normalize_offset, \&_do_resolution ], constructor => [ 'DateTime', 'from_day_of_year' ], }, ], parse_time => [ { #hhmmss 232050 length => [ qw( 6 7 ) ], regex => qr/^ T?? (\d\d) (\d\d) (\d\d) $/x, params => [ qw( hour minute second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #hhmm 2320 length => [ qw( 4 5 ) ], regex => qr/^ T?? (\d\d) (\d\d) $/x, params => [ qw( hour minute ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #hh 23 length => [ qw( 2 3 ) ], regex => qr/^ T?? (\d\d) $/x, params => [ qw( hour ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_do_resolution ], }, { #-mmss -2050 length => 5, regex => qr/^ - (\d\d) (\d\d) $/x, params => [ qw( minute second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_do_resolution ], }, { #-mm -20 length => 3, regex => qr/^ - (\d\d) $/x, params => [ qw( minute ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_do_resolution ], }, { #--ss --50 length => 4, regex => qr/^ -- (\d\d) $/x, params => [ qw( second ) ], postprocess => [ \&_add_year, \&_add_month, \&_add_day, \&_add_hour, \&_add_minute, \&_do_resolution ], }, ], } ); sub _fix_1_digit_year { my %p = @_; no strict 'refs'; my $year = ( $p{ self }{ base_datetime } || DateTime->now )->year; use strict qw(subs vars); no warnings; $year =~ s/.$//; $p{ parsed }{ year } = $year . $p{ parsed }{ year }; return 1; } sub _fix_2_digit_year { my %p = @_; # this is a mess because of the need to support parse_* being called # as a class method no strict 'refs'; if ( exists $p{ self }{ legacy_year } ) { if ( $p{ self }{ legacy_year } ) { my $cutoff = exists $p{ self }{ cut_off_year } ? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear; $p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000; } else { my $century = ( $p{ self }{ base_datetime } || DateTime->now )->strftime( '%C' ); $p{ parsed }{ year } += $century * 100; } } else { my $cutoff = exists $p{ self }{ cut_off_year } ? $p{ self }{ cut_off_year } : $p{ self }->DefaultCutOffYear; $p{ parsed }{ year } += $p{ parsed }{ year } > $cutoff ? 1900 : 2000; } use strict qw(subs vars); no warnings; return 1; } sub _add_minute { my %p = @_; no strict 'refs'; $p{ parsed }{ minute } = ( $p{ self }{ base_datetime } || DateTime->now )->minute; $p{ self }{ missing_details }{ minute } = 1; use strict qw(subs vars); no warnings; return 1; } sub _add_hour { my %p = @_; no strict 'refs'; $p{ parsed }{ hour } = ( $p{ self }{ base_datetime } || DateTime->now )->hour; $p{ self }{ missing_details }{ hour } = 1; use strict qw(subs vars); no warnings; return 1; } sub _add_day { my %p = @_; no strict 'refs'; $p{ parsed }{ day } = ( $p{ self }{ base_datetime } || DateTime->now )->day; $p{ self }{ missing_details }{ day } = 1; use strict qw(subs vars); no warnings; return 1; } sub _add_week { my %p = @_; no strict 'refs'; $p{ parsed }{ week } = ( $p{ self }{ base_datetime } || DateTime->now )->week; $p{ self }{ missing_details }{ week } = 1; use strict qw(subs vars); no warnings; return 1; } sub _add_month { my %p = @_; no strict 'refs'; $p{ parsed }{ month } = ( $p{ self }{ base_datetime } || DateTime->now )->month; $p{ self }{ missing_details }{ month } = 1; use strict qw(subs vars); no warnings; return 1; } sub _add_year { my %p = @_; no strict 'refs'; $p{ parsed }{ year } = ( $p{ self }{ base_datetime } || DateTime->now )->year; $p{ self }{ missing_details }{ year } = 1; use strict qw(subs vars); no warnings; return 1; } sub _fractional_second { my %p = @_; $p{ parsed }{ nanosecond } = ".$p{ parsed }{ nanosecond }" * 10**9; return 1; } sub _fractional_minute { my %p = @_; $p{ parsed }{ second } = ".$p{ parsed }{ second }" * 60; return 1; } sub _fractional_hour { my %p = @_; $p{ parsed }{ minute } = ".$p{ parsed }{ minute }" * 60; return 1; } sub _normalize_offset { my %p = @_; return 1 unless (defined $p{ parsed }{ time_zone }); $p{ parsed }{ time_zone } =~ s/://; if( length $p{ parsed }{ time_zone } == 3 ) { $p{ parsed }{ time_zone } .= '00'; } elsif( length $p{ parsed }{ time_zone } == 2 ) { $p{ parsed }{ time_zone } .= '000'; } return 1; } sub _normalize_week { my %p = @_; # from section 4.3.2.2 # "A calendar week is identified within a calendar year by the calendar # week number. This is its ordinal position within the year, applying the # rule that the first calendar week of a year is the one that includes the # first Thursday of that year and that the last calendar week of a # calendar year is the week immediately preceding the first calendar week # of the next calendar year." # this make it oh so fun to covert an ISO week number to a count of days my $dt = DateTime->new( year => $p{ parsed }{ year }, ); if ( $dt->week_number == 1 ) { $p{ parsed }{ week } -= 1; } $p{ parsed }{ week } *= 7; if( defined $p{ parsed }{ day_of_year } ) { $p{ parsed }{ week } -= $dt->day_of_week -1; } $p{ parsed }{ day_of_year } += $p{ parsed }{ week }; delete $p{ parsed }{ week }; return 1; } sub _normalize_century { my %p = @_; $p{ parsed }{ year } .= '01'; return 1; } # TOBY - new preprocessing function, primarily to handle HTML5 date formats. sub _do_whitespace { my %args = @_; my ($date, $p) = @args{qw( input parsed )}; # Normalise white space. $date =~ s/(^\s+|\s+$)//g; $date =~ s/\s+/ /g; # HTML 5 split date with whitespace between Date and Time $date =~ s/\-(\d\d?)\s(\d\d?)\:/sprintf("\-%02dT%02d\:", $1, $2)/ex; # Also white space before the timezone if ($date =~ / ([Z\+\-])([0-9\:]*)$/i) { # And the time zone may be weird and need reformatting my $sign = $1; my $nums = $2; my $tz = ''; if (uc($sign) eq 'Z') { $tz = 'Z'; } elsif ($nums =~ /^(\d{0,2})$/) { $tz = sprintf('%s%02d00', $sign, $1); } elsif ($nums =~ /^(\d{1,2})(\d{2})?$/) { $tz = sprintf('%s%02d%02d', $sign, $1, $2); } elsif ($nums =~ /^(\d{0,2})\:(\d{0,2})?$/) { $tz = sprintf('%s%02d%02d', $sign, $1, $2); } $date =~ s/ ([Z\+\-])([0-9\:]*)$/$tz/; } return $date; } # TOBY - postprocessing function for *all* datetime formats, recording resolution sub _do_resolution { my %p = @_; my $res; if (defined $p{ parsed }{ nanosecond }) { $res = 'nanosecond'; } elsif (defined $p{ parsed }{ second }) { $res = 'second'; } elsif (defined $p{ parsed }{ minute }) { $res = 'minute'; } elsif (defined $p{ parsed }{ hour }) { $res = 'hour'; } elsif (defined $p{ parsed }{ day }) { $res = 'day'; } elsif (defined $p{ parsed }{ month }) { $res = 'month'; } elsif (defined $p{ parsed }{ year }) { $res = 'year'; } else { $res = 'second'; } if (defined $p{ parsed }{ hour } && ($p{ parsed }{ hour }==24)) { $res = 'end'; foreach my $x (qw(nanosecond second minute hour)) { $p{ parsed }{ $x } = 0; } } $p{ self }{ resolution } = $res; $p{ self }{ time_zone } = (defined $p{ parsed }{ time_zone }) ? 'time_zone' : undef; return 1; } 1; HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/String.pm0000644000076400007640000000761311775403507022430 0ustar taitai=head1 NAME HTML::Microformats::Datatype::String - text in a particular language =head1 SYNOPSIS my $string = HTML::Microformats::Datatype::String ->new('Bonjour', 'fr'); print "$string\n"; =cut package HTML::Microformats::Datatype::String; use strict qw(subs vars); no warnings; use overload '""'=>\&to_string, '.'=>\&concat, 'cmp'=>\&compare; use base qw(Exporter HTML::Microformats::Datatype); our @EXPORT = qw(ms isms); our @EXPORT_OK = qw(ms isms concat compare); use Encode; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::String::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::String::VERSION = '0.105'; } =head1 DESCRIPTION =head2 Constructor =over 4 =item C<< $str = HTML::Microformats::Datatype::String->new($text, [$lang]) >> Creates a new HTML::Microformats::Datatype::String object. =back =cut sub new { my $class = shift; my $rv = {}; $rv->{'string'} = shift; $rv->{'lang'} = shift; bless $rv, $class; } =head2 Public Methods =over 4 =item C<< $str->lang >> Return the language code. =cut sub lang { my $this = shift; return $this->{'lang'}; } =item C<< $str->to_string >> Return a plain (scalar) string. =back =cut sub to_string { my $this = shift; return $this->{'string'}; } sub TO_JSON { my $this = shift; return $this->{'string'}; } =head2 Functions =over 4 =item C<< $str = ms($text, [$element]) >> Construct a new HTML::Microformats::Datatype::String object from a scalar, plus XML::LibXML::Element. If $element is undef, then returns the plain (scalar) string itself. This function is exported by default. (Note: the name 'ms' originally stood for 'Magic String'.) =cut sub ms { my ($rv, $dom); $rv->{string} = shift; $dom = shift || return $rv->{string}; $rv->{lang} = $dom->getAttribute('data-cpan-html-microformats-lang'); $rv->{xpath} = $dom->getAttribute('data-cpan-html-microformats-nodepath'); $rv->{xml} = $dom->toString; $rv->{dom} = $dom; bless $rv, __PACKAGE__; } =item C<< isms($str) >> Returns true iff $str is blessed as a HTML::Microformats::Datatype::String object. This function is exported by default. =cut sub isms { my $this = shift; return (__PACKAGE__ eq ref $this); } =item C<< $c = concat($a, $b, [$reverse]) >> Concatenates two strings. If the language of string $b is null or the same as $a, then the resultant string has the same language as $a. Otherwise the result has no language. If $reverse is true, then the strings are concatenated with $b preceding $a. This function is not exported by default. Can also be used as a method: $c = $a->concat($b); =cut sub concat { my $a = shift; my $b = shift; my $rev = shift; if ($rev) { ($a, $b) = ($b, $a); } unless (ref $a) { $a = { string => $a }; } unless (ref $b) { $b = { string => $b }; } my $rv = {}; $rv->{string} = $a->{string}.$b->{string}; if (!$b->{lang} || (lc($a->{lang}) eq lc($b->{lang}))) { $rv->{lang} = $a->{lang}; } bless $rv, __PACKAGE__; } =item C<< compare($a, $b) >> Compares two strings alphabetically. Language is ignored. Return values are as per 'cmp' (see L). This function is not exported by default. Can also be used as a method: $a->compare($b); =back =cut sub compare { my $a = shift; my $b = shift; return "$a" cmp "$b"; } 1; __END__ =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/DateTime.pm0000644000076400007640000001364311775403507022656 0ustar taitai=head1 NAME HTML::Microformats::Datatype::DateTime - dates and datetimes =head1 SYNOPSIS my $duration = HTML::Microformats::Datatype::DateTime->now; print "$duration\n"; =cut package HTML::Microformats::Datatype::DateTime; use base qw(DateTime HTML::Microformats::Datatype); use DateTime; use DateTime::Format::Natural; use DateTime::Format::Strptime; use HTML::Microformats::Datatype::DateTime::Parser; use HTML::Microformats::Datatype::String qw(); use HTTP::Date; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::DateTime::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::DateTime::VERSION = '0.105'; } =head1 DESCRIPTION This class inherits from DateTime, so supports all of DateTime's methods. =head2 Constructors This class inherits from DateTime, so DateTime's standard constructors (C, C, etc) should work. Also: =over 4 =item C<< $dt = HTML::Microformats::Datatype::DateTime->parse($string, $elem, $context, [$tz], [$base]) >> Creates a new HTML::Microformats::Datatype::DateTime object. $tz is the timezone to use (if it can't be figured out) and $base is a base datetime to use for relative datetimes, whatever that means. =back =cut sub parse { my $class = shift; my $string = shift; my $elem = shift||undef; my $page = shift||undef; my $tz = shift||undef; my $base = shift||undef; return $class->_microformat_datetime($string, $tz, $base); } sub _microformat_datetime { my $class = shift; my $dt = $class->_microformat_datetime_helper(@_); return undef unless $dt; # Super-dangerous: reblessing an already-blessed object. bless $dt, 'HTML::Microformats::Datatype::DateTime'; } sub _microformat_datetime_helper # Very tolerant DateTime parsing. Microformats are supposed to always use W3CDTF, # but we'll be lenient and do our best to parse other ISO 8601 formats, and if # that fails, even try to parse natural language. { my $class = shift; my $string = shift; my $tz = shift || 'UTC'; my $base = shift || undef; my $f; my $dt; $string = $string->{string} if HTML::Microformats::Datatype::String::isms($string); my $parser = __PACKAGE__ . '::Parser'; if ($base) { $f = $parser->new(base_datetime => $base); } else { $f = $parser->new; } eval { my $isostring = $string; $isostring =~ s/([\+\-]\d\d)([014][50])$/$1\:$2/; $dt = $f->parse_datetime($isostring); $dt->{resolution} = $f->{resolution}; if ($dt->{resolution} eq 'end') { $dt = $dt->add( days => 1 ); $dt->{resolution} = 'day'; } }; unless ($dt) { eval { my $time = str2time($string); $dt = DateTime->from_epoch( epoch => $time ); $dt->{resolution} = 'second' unless ($dt->{resolution}); }; } unless ($dt) { $f = DateTime::Format::Natural->new( lang => 'en', # Should read this from source input prefer_future => 1, daytime => { morning => 9, afternoon => 13, evening => 20 }, time_zone => "$tz" ); $dt = $f->parse_datetime($string); $dt->{resolution} = 'second' unless $dt->{resolution}; return undef unless $f->success; } return undef unless $dt; my %pattern = ( year => '%Y', month => '%Y-%m', week => '%F', day => '%F', hour => '%FT%H:%M', minute => '%FT%H:%M', second => '%FT%H:%M:%S', nanosecond => '%FT%T.%9N' ); my %tz_pattern = ( year => '%Y', month => '%Y-%m', week => '%F', day => '%F', hour => '%FT%H:%M%z', minute => '%FT%H:%M%z', second => '%FT%H:%M:%S%z', nanosecond => '%FT%T.%9N%z' ); if ($dt->year >= 100000) { foreach my $x (keys %pattern) { $pattern{$x} = '+'.$pattern{$x}; $tz_pattern{$x} = '+'.$tz_pattern{$x}; } } elsif ($dt->year >= 10000) { foreach my $x (keys %pattern) { $pattern{$x} = '+0'.$pattern{$x}; $tz_pattern{$x} = '+0'.$tz_pattern{$x}; } } if ($dt->{tz}->{name} eq 'floating') { $dt->set_formatter(DateTime::Format::Strptime->new( pattern => ( $pattern{$dt->{resolution}} ) )); } else { $dt->set_formatter(DateTime::Format::Strptime->new( pattern => ( $tz_pattern{$dt->{resolution}} ) )); } return $dt; } =head2 Public Methods =over 4 =item C<< $d->to_string >> Returns a literal string. =cut sub to_string { my $self = shift; my $type = $self->datatype; if ($type eq 'http://www.w3.org/2001/XMLSchema#gYear') { return $self->strftime('%Y'); } elsif ($type eq 'http://www.w3.org/2001/XMLSchema#gYearMonth') { return $self->strftime('%Y-%m'); } elsif ($type eq 'http://www.w3.org/2001/XMLSchema#date') { return $self->strftime('%Y-%m-%d'); } else { return "$self"; } } =item C<< $d->datatype >> Returns an the RDF datatype URI representing the data type of this literal. =back =cut sub datatype { my $self = shift; if($self->{datatype}) { return $self->{datatype}; } elsif ($self->{resolution} eq 'year') { return 'http://www.w3.org/2001/XMLSchema#gYear'; } elsif ($self->{resolution} eq 'month') { return 'http://www.w3.org/2001/XMLSchema#gYearMonth'; } elsif ($self->{resolution} eq 'day') { return 'http://www.w3.org/2001/XMLSchema#date'; } return 'http://www.w3.org/2001/XMLSchema#dateTime'; } sub TO_JSON { return "$_[0]"; } 1; __END__ =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/Interval.pm0000644000076400007640000001513011775403507022737 0ustar taitai=head1 NAME HTML::Microformats::Datatype::Interval - concrete periods of time =head1 SYNOPSIS my $interval = HTML::Microformats::Datatype::Interval->new($span); print "$interval\n"; =cut package HTML::Microformats::Datatype::Interval; use overload '""'=>\&to_string, '<=>'=>\&compare, 'cmp'=>\&compare; use strict qw(subs vars); no warnings; use base qw(Exporter HTML::Microformats::Datatype); our @EXPORT = qw(); our @EXPORT_OK = qw(compare); use DateTime::Span; use HTML::Microformats::Utilities qw(stringify searchClass); use HTML::Microformats::Datatype::Duration; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::Interval::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::Interval::VERSION = '0.105'; } =head1 DESCRIPTION =head2 Constructors =over 4 =item C<< $i = HTML::Microformats::Datatype::Interval->new($span) >> Creates a new HTML::Microformats::Datatype::Interval object. $span is a DateTime::Span object. =cut sub new { my $class = shift; my $interval_obj = shift; my $this = {}; $this->{i} = $interval_obj; bless $this, $class; return $this; } =item C<< $i = HTML::Microformats::Datatype::Interval->parse($string, $elem, $context) >> Creates a new HTML::Microformats::Datatype::Interval object. $string is an interval represented in ISO 8601 format, for example: '2010-01-01/P1Y' or '2010-01-01/2011-01-01'. $elem is the XML::LibXML::Element being parsed. $context is the document context. This constructor supports a number of experimental microformat interval patterns. e.g.
    4 days starting from 2010
    =back =cut sub parse { my $class = shift; my $string = shift; my $elem = shift||undef; my $page = shift||undef; my $rv = {}; if ($string =~ /^ \s* (.+) \s* \/ \s* (.+) \s* $/x) { my $one = $1; my $two = $2; if ($one =~ /^P/i && $two !~ /^P/i) { my $duration = HTML::Microformats::Datatype::Duration->parse($one, $elem, $page); my $before = HTML::Microformats::Datatype::DateTime->parse($two, $elem, $page); if ($duration && $before) { my $span = DateTime::Span->from_datetime_and_duration( duration => $duration->{d}, before => $before ); $rv->{i} = $span if ($span); } } elsif ($one !~ /^P/i && $two !~ /^P/i) { my $start = HTML::Microformats::Datatype::DateTime->parse($one, $elem, $page); my $before = HTML::Microformats::Datatype::DateTime->parse($two, $elem, $page, undef, $start); if ($start && $before) { my $span = DateTime::Span->from_datetimes( start => $start, before => $before ); $rv->{i} = $span if ($span); } } elsif ($one !~ /^P/i && $two =~ /^P/i) { my $start = HTML::Microformats::Datatype::DateTime->parse($one, $elem, $page); my $duration = HTML::Microformats::Datatype::Duration->parse($two, $elem, $page); if ($duration && $start) { my $span = DateTime::Span->from_datetime_and_duration( duration => $duration->{d}, start => $start ); $rv->{i} = $span if ($span); } } } if (! $rv->{i}) { my $duration = HTML::Microformats::Datatype::Duration->parse(undef, $elem, $page); my $time = {}; PROP: foreach my $prop (qw(start after)) { my @nodes = searchClass($prop, $elem); NODE: foreach my $n (@nodes) { $time->{$prop} = HTML::Microformats::Datatype::DateTime->parse( stringify($nodes[0], undef, 1), $nodes[0], $page); last NODE if ($time->{$prop}); } } PROP: foreach my $prop (qw(end before)) { my @nodes = searchClass($prop, $elem); NODE: foreach my $n (@nodes) { $time->{$prop} = HTML::Microformats::Datatype::DateTime->parse( stringify($nodes[0], undef, 1), $nodes[0], $page, undef, ($time->{start} || $time->{after}) ); last NODE if ($time->{$prop}); } } if (($time->{start}||$time->{after}) && ($time->{end}||$time->{before})) { my $startlabel = ($time->{start}) ? 'start' : 'after'; my $endlabel = ($time->{end}) ? 'end' : 'before'; my $span = DateTime::Span->from_datetimes( $startlabel => ($time->{start}||$time->{after}), $endlabel => ($time->{end}||$time->{before}) ); $rv->{i} = $span if ($span); } elsif (($time->{start}||$time->{after}) && ($duration)) { my $startlabel = ($time->{start}) ? 'start' : 'after'; my $span = DateTime::Span->from_datetime_and_duration( $startlabel => ($time->{start}||$time->{after}), duration => $duration->{d} ); $rv->{i} = $span if ($span); } elsif (($duration) && ($time->{end}||$time->{before})) { my $endlabel = ($time->{end}) ? 'end' : 'before'; my $span = DateTime::Span->from_datetime_and_duration( duration => $duration->{d}, $endlabel => ($time->{end}||$time->{before}) ); $rv->{i} = $span if ($span); } } if ($rv->{i}) { $rv->{string} = $string; bless $rv, $class; return $rv; } return undef; } =head2 Public Methods =over 4 =item C<< $span = $i->span >> Returns a DateTime::Span object. =cut sub span { my $this = shift; return $this->{i} } =item C<< $span = $i->to_string >> Returns an ISO 8601 formatted string representing the interval. =cut sub to_string { my $this = shift; my $D = HTML::Microformats::Datatype::Duration->new($this->{i}->duration); return $this->{i}->start . "/$D"; } sub TO_JSON { my $this = shift; return $this->to_string; } =item C<< $d->datatype >> Returns an the RDF datatype URI representing the data type of this literal. =back =cut sub datatype { my $self = shift; return 'urn:iso:std:iso:8601#timeInterval'; } =head2 Function =over 4 =item C<< compare($a, $b) >> Compares intervals $a and $b. Return values are as per 'cmp' (see L). This function is not exported by default. Can also be used as a method: $a->compare($b); =back =cut sub compare { my $this = shift; my $that = shift; return ("$this" cmp "$that"); } 1; __END__ =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/RecurringDateTime.pm0000644000076400007640000001550611775403507024537 0ustar taitai=head1 NAME HTML::Microformats::Datatype::RecurringDateTime - a datetime that recurs =head1 SYNOPSIS my $r_datetime = HTML::Microformats::Datatype::RecurringDateTime->new($ical_string); print "$r_datetime\n"; =cut package HTML::Microformats::Datatype::RecurringDateTime; use HTML::Microformats::Utilities qw(searchClass stringify); use base qw(HTML::Microformats::Datatype); use strict qw(subs vars); no warnings; use 5.010; use HTML::Microformats::Datatype::DateTime; use RDF::Trine; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::RecurringDateTime::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::RecurringDateTime::VERSION = '0.105'; } =head1 DESCRIPTION =head2 Constructors =over 4 =item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->new($string, [$context]) >> Creates a new HTML::Microformats::Datatype::RecurringDateTime object. $string is an iCalendar-RRULE-style string. =cut sub new { my $class = shift; return $class->parse_string(@_) if @_; bless {}, $class; } =item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->parse($string, $elem, $context) >> Creates a new HTML::Microformats::Datatype::RecurringDateTime object. $string is perhaps an iCalendar-RRULE-style string. $elem is the XML::LibXML::Element being parsed. $context is the document context. This constructor supports a number of experimental microformat interval patterns. e.g. The summer lectures are held held yearly, every 2nd year (1999, 2001, etc), every Sunday in January at 8:30 and repeated at 9:30. =cut sub parse { my $class = shift; my $string = shift; my $elem = shift || undef; my $context = shift || undef; my $self = bless {}, $class; $self->{'_context'} = $context; $self->{'_id'} = $context->make_bnode; my @freq_nodes = searchClass('freq', $elem); unless (@freq_nodes) { if (lc $elem->tagName eq 'abbr' and $elem->hasAttribute('title')) { return $class->parse_string($elem->getAttribute('title'), $context); } else { return $class->parse_string(''.stringify($elem, 'value'), $context); } } $self->{'freq'} = uc stringify($freq_nodes[0], 'value'); foreach my $n ($elem->getElementsByTagName('*')) { if ($n->getAttribute('class') =~ /\b (until|count) \b/x) { my $p = $1; unless (defined $self->{'until'} || defined $self->{'count'}) { $self->{$p} = ''.stringify($n, 'value'); $self->{$p} = HTML::Microformats::Datatype::DateTime->parse($self->{$p}, $elem, $context) if $p eq 'until'; } } elsif ($n->getAttribute('class') =~ /\b (bysecond | byminute | byhour | bymonthday | byyearday | byweekno | bymonth | bysetpos) \b/x) { my $p = $1; my $v = stringify($n, 'value'); my @v = split ',', $v; push @{ $self->{$p} }, @v; } elsif ($n->getAttribute('class') =~ /\b (byday | wkst) \b/x) { my $p = $1; my $txt = stringify($n, 'value'); my @v = split ',', $txt; foreach my $v (@v) { if ($v =~ /^\s*(\-?[12345])?\s*(MO|TU|WE|TH|FR|SA|SU)/i) { $v = uc($1.$2); } else { $v = uc($txt); } push @{ $self->{$p} }, "$v"; } } if ($n->getAttribute('class') =~ /\b interval \b/x) { my $v = stringify($n, 'value'); $self->{'interval'} = $v; } } return $self; } =item C<< $r = HTML::Microformats::Datatype::RecurringDateTime->parse_string($string, [$context]) >> Essentially just an alias for C<< new >>. =back =cut sub parse_string { my $class = shift; my $string = shift; my $context = shift || undef; my $self = bless {}, $class; $self->{'_context'} = $context; $self->{'_id'} = $context->make_bnode; my @parts = split /\;/, $string; foreach my $part (@parts) { my ($k,$v) = split /\=/, $part; if ($k =~ /^( byday | wkst | bysecond | byminute | byhour | bymonthday | byyearday | byweekno | bymonth | bysetpos )$/xi) { $self->{ lc $k } = [ split /\,/, $v ]; } elsif ($k =~ /^( interval | until | count | freq )$/xi) { $self->{ lc $k } = uc $v; } } return $self; } =head2 Public Methods =over 4 =item C<< $r->to_string >> Returns an iCal-RRULE-style formatted string representing the recurrance. =cut sub to_string { my $self = shift; my $rv = ''; foreach my $p (qw(freq until count bysecond byminute byhour bymonthday byyear byweekno bymonth bysetpos byday wkst interval)) { if (ref $self->{$p} eq 'ARRAY') { $rv .= sprintf("%s=%s;", uc $p, (join ',', @{$self->{$p}})) if @{$self->{$p}}; } elsif (defined $self->{$p}) { $rv .= sprintf("%s=%s;", uc $p, $self->{$p}); } } $rv =~ s/\;$//; return $rv; } =item C<< $r->datatype >> Returns an the RDF datatype URI representing the data type of this literal. =cut sub datatype { my $self = shift; return 'http://buzzword.org.uk/rdf/icaltzdx#recur'; } =item C<< $r->add_to_model($model) >> Adds the recurring datetime to an RDF model as a resource (not a literal). =back =cut sub add_to_model { my $self = shift; my $model = shift; my $me = RDF::Trine::Node::Blank->new( substr($self->{'_id'}, 2) ); my $ical = 'http://www.w3.org/2002/12/cal/icaltzd#'; foreach my $p (qw(freq until count bysecond byminute byhour bymonthday byyear byweekno bymonth bysetpos byday wkst interval)) { $model->add_statement(RDF::Trine::Statement->new( $me, RDF::Trine::Node::Resource->new("${ical}${p}"), RDF::Trine::Node::Literal->new( (ref $self->{$p} eq 'ARRAY') ? (join ',', @{$self->{$p}}) : $self->{$p} ), )) if defined $self->{$p}; } $model->add_statement(RDF::Trine::Statement->new( $me, RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#type"), RDF::Trine::Node::Resource->new("http://buzzword.org.uk/rdf/icaltzdx#Recur"), )); $model->add_statement(RDF::Trine::Statement->new( $me, RDF::Trine::Node::Resource->new("http://www.w3.org/1999/02/22-rdf-syntax-ns#value"), RDF::Trine::Node::Literal->new($self->to_string, undef, $self->datatype), )); return $self; } sub TO_JSON { my $self = shift; return $self->to_string; } 1; __END__ =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/Datatype/Duration.pm0000644000076400007640000002762511775403507022754 0ustar taitai=head1 NAME HTML::Microformats::Datatype::Duration - floating periods of time =head1 SYNOPSIS my $duration = HTML::Microformats::Datatype::Duration->new($d); print "$duration\n"; =cut package HTML::Microformats::Datatype::Duration; use strict qw(subs vars); no warnings; use overload '""'=>\&to_string, '+'=>\&add, '-'=>\&subtract, '<=>'=>\&compare, 'cmp'=>\&compare; use base qw(Exporter HTML::Microformats::Datatype); our @EXPORT = qw(); our @EXPORT_OK = qw(compare add subtract); use DateTime; use DateTime::Duration; use HTML::Microformats::Utilities qw(searchClass stringify); use Object::AUTHORITY; BEGIN { $HTML::Microformats::Datatype::Duration::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Datatype::Duration::VERSION = '0.105'; } =head1 DESCRIPTION =head2 Constructors =over 4 =item C<< $d = HTML::Microformats::Datatype::Duration->new($duration) >> Creates a new HTML::Microformats::Datatype::Duration object. $duration is a DateTime::Duration object. =cut sub new { my $class = shift; my $duration_obj = shift; my $this = {}; $this->{d} = $duration_obj; bless $this, $class; return $this; } =item C<< $d = HTML::Microformats::Datatype::Duration->parse($string, $elem, $context) >> Creates a new HTML::Microformats::Datatype::Duration object. $string is a duration represented in ISO 8601 format, for example: 'P1Y' or 'PT2H29M58.682S'. $elem is the XML::LibXML::Element being parsed. $context is the document context. The standard way of representing durations in Microformats is as an ISO 8601 string: 4 and a half days This constructor also supports a number of experimental microformat duration patterns. ISO-31 class names are supported:
    4 and a half days.
    As are metric/SI measures (in seconds): 124 s 124 seconds Or using an hMeasure microformat with no 'item' property, the 'type' property either absent or a case-insensitive match of 'duration' and a unit property of 's'/'sec'/'seconds', 'min'/'minutes', 'h'/'hours' or 'd'/'days'. For example: Days: 4.5 =back =cut sub parse { my $class = shift; my $string = shift; my $elem = shift||undef; my $page = shift||undef; my $pkg = __PACKAGE__; # Try for nested class='s', class='min', class='h', etc. Standard=ISO-31. if ($elem) { my ($d, $h, $min, $s, $n); my $success = 0; my $X = {}; # Find values. no strict; foreach my $x (qw(d h min s)) { my @tmp = searchClass($x, $elem); if (@tmp) { my $y = stringify($tmp[0], {'abbr-pattern'=>1}); $y =~ s/\,/\./; $X->{$x} = "$y"; # MagicString -> string. $success++; } } if ($success) { # Cope with fractions. foreach my $frac (qw(d=24.h h=60.min min=60.s s=1000000000.n)) { my ($big, $mult, $small) = split /[\=\.]/, $frac; next unless ($X->{$big} =~ /\./); my $int_part = int($X->{$big}); my $frac_part = $X->{$big} - $int_part; $X->{$big} = $int_part; $X->{$small} += ($mult * $frac_part); } use strict qw(subs vars); no warnings; $X->{'n'} = int($X->{'n'}); # Construct and return object. my $dur = DateTime::Duration->new( days => $X->{'d'}||0, hours => $X->{'h'}||0, minutes => $X->{'min'}||0, seconds => $X->{'s'}||0, nanoseconds => $X->{'n'}||0 ); my $rv = new(__PACKAGE__, $dur); $rv->{string} = $string; $rv->{element} = $elem; return $rv; } } # Commas as decimal points. my $string2 = $string; $string2 =~ s/\,/\./g; # Standard=ISO-8601. if ($string2 =~ /^ \s* ([\+\-])? # Potentially negitive... P # Period of... (?:([\d\.]*)Y)? # n Years (?:([\d\.]*)M)? # n Months (?:([\d\.]*)W)? # n Weeks (?:([\d\.]*)D)? # n Days (?: T # And a time of... (?:([\d\.]*)H)? # n Hours (?:([\d\.]*)M)? # n Minutes (?:([\d\.]*)S)? # n Seconds )? \s* /ix) { my $X = {}; $X->{'I'} = $1; $X->{'y'} = $2; $X->{'m'} = $3; $X->{'w'} = $4; $X->{'d'} = $5; $X->{'h'} = $6; $X->{'min'} = $7; $X->{'s'} = $8; $X->{'n'} = 0; # Handle fractional no strict; foreach my $frac (qw(y=12.m m=30.d w=7.d d=24.h h=60.min min=60.s s=1000000000.n)) { my ($big, $mult, $small) = split /[\=\.]/, $frac; next unless ($X->{$big} =~ /\./); my $int_part = int($X->{$big}); my $frac_part = $X->{$big} - $int_part; $X->{$big} = $int_part; $X->{$small} += ($mult * $frac_part); } use strict qw(subs vars); no warnings; $X->{'n'} = int($X->{'n'}); # Construct and return object. my $dur = DateTime::Duration->new( years => $X->{'y'}||0, months => $X->{'m'}||0, weeks => $X->{'w'}||0, days => $X->{'d'}||0, hours => $X->{'h'}||0, minutes => $X->{'min'}||0, seconds => $X->{'s'}||0, nanoseconds => $X->{'n'}||0 ); my $rv = $X->{'I'} eq '-' ? $pkg->new($dur->inverse) : $pkg->new($dur); $rv->{string} = $string; $rv->{element} = $elem; return $rv; } # Duration as a simple number of seconds. Standard=SI. elsif ($string2 =~ /^\s* (\-?)(\d*)(?:\.(\d+))? \s* S? \s*$/ix && ($1||$2)) { my $s = $2; my $n = "0.$3" * 1000000000; # Construct and return object. my $dur = DateTime::Duration->new( seconds => $s, nanoseconds => $n ); my $rv = $1 eq '-' ? $pkg->new($dur->inverse) : $pkg->new($dur); $rv->{'string'} = $string; $rv->{'element'} = $elem; return $rv; } # Look for hMeasure. elsif ($elem && $page) { # By this point, we're on a clone of the element, and certain class data # within it may have been destroyed. This is a little hack to find our # way back to the *real* element! my $real; my @real = $page->document->findnodes($elem->getAttribute('data-cpan-html-microformats-nodepath')); $real = $real[0] if @real; return $string unless ($real); my @measures; if ($real->getAttribute('class') =~ /\b(hmeasure)\b/) { push @measures, HTML::Microformats::hMeasure->new($real, $page); } else { @measures = HTML::Microformats::hMeasure->extract_all($real, $page); } foreach my $m (@measures) { next if $m->data->{'item'} || $m->data->{'item_link'} || $m->data->{'item_label'} ; next if defined $m->data->{'type'} && $m->data->{'type'} !~ /^\s*(duration)\s*$/i; my ($dur, $neg); my $n = $m->data->{'num'}; $n = "$n"; # MagicString -> string if ($n < 0) { $neg = 1; $n = 0 - $n; } if (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* s ( ec (ond)? s? )? \s*$/ix) { # print "hMeasure duration in seconds.\n"; my $seconds = int($n); $n -= $seconds; $n *= 1000000000; my $nanoseconds = int($n); # Construct and return object. $dur = DateTime::Duration->new( seconds => $seconds, nanoseconds => $nanoseconds ); } elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* min ( (ute)? s? )? \s*$/ix) { # print "hMeasure duration in minutes.\n"; my $minutes = int($n); $n -= $minutes; $n *= 60; my $seconds = int($n); $n -= $seconds; $n *= 1000000000; my $nanoseconds = int($n); # Construct and return object. $dur = DateTime::Duration->new( minutes => $minutes, seconds => $seconds, nanoseconds => $nanoseconds ); } elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* h ( our s? )? \s*$/ix) { # print "hMeasure duration in hours.\n"; my $hours = int($n); $n -= $hours; $n *= 60; my $minutes = int($n); $n -= $minutes; $n *= 60; my $seconds = int($n); # Construct and return object. $dur = DateTime::Duration->new( hours => $hours, minutes => $minutes, seconds => $seconds ); } elsif (defined $m->data->{'unit'} && $m->data->{'unit'} =~ /^\s* d ( ay s? )? \s*$/ix) { # print "hMeasure duration in days.\n"; my $days = int($n); $n -= $days; $n *= 24; my $hours = int($n); $n -= $hours; $n *= 60; my $minutes = int($n); $n -= $minutes; $n *= 60; my $seconds = int($n); # Construct and return object. $dur = DateTime::Duration->new( days => $days, hours => $hours, minutes => $minutes, seconds => $seconds ); } if ($dur) { my $rv = ($neg==1) ? $pkg->new($dur->inverse) : $pkg->new($dur); $rv->{'string'} = $string; $rv->{'element'} = $elem; $rv->{'hmeasure'} = $m; return $rv; } } } return $string; } =head2 Public Methods =over 4 =item C<< $d->duration >> Returns a DateTime::Duration object. =cut sub duration { my $self = shift; return $self->{d} } =item C<< $d->to_string >> Returns an ISO 8601 formatted string representing the duration. =cut sub to_string { my $self = shift; my $str; # We coerce weeks into days and nanoseconds into fractions of a second # for compatibility with xsd:duration. if ($self->{d}->is_negative) { $str .= '-P'; } else { $str .= 'P'; } if ($self->{d}->years) { $str .= $self->{d}->years.'Y'; } if ($self->{d}->months) { $str .= $self->{d}->months.'M'; } if ($self->{d}->weeks || $self->{d}->days) { $str .= ($self->{d}->days + (7 * $self->{d}->weeks)).'D'; } $str .= 'T'; if ($self->{d}->hours) { $str .= $self->{d}->hours.'H'; } if ($self->{d}->minutes) { $str .= $self->{d}->minutes.'M'; } if ($self->{d}->seconds || $self->{d}->nanoseconds) { $str .= ($self->{d}->seconds + ($self->{d}->nanoseconds / 1000000000)).'S'; } $str =~ s/T$//; return $str; } sub TO_JSON { my $self = shift; return $self->to_string; } =item C<< $d->datatype >> Returns an the RDF datatype URI representing the data type of this literal. =back =cut sub datatype { my $self = shift; return 'http://www.w3.org/2001/XMLSchema#duration'; } =head2 Functions =over 4 =item C<< compare($a, $b) >> Compares durations $a and $b. Return values are as per 'cmp' (see L). Note that there is not always a consistent answer when comparing durations. 30 days is longer than a month in February, but shorter than a month in January. Durations are compared as if they were applied to the current datetime (i.e. now). This function is not exported by default. Can also be used as a method: $a->compare($b); =cut sub compare { my $this = shift; my $that = shift; return DateTime::Duration->compare($this->{d}, $that->{d}, DateTime->now); } =item C<< $c = add($a, $b) >> Adds two durations together. This function is not exported by default. Can also be used as a method: $c = $a->add($b); =cut sub add { my $this = shift; my $that = shift; my $sign = shift || '+'; my $rv = $this->{d}->clone; if ($sign eq '-') { $rv -= $that->{d}; } else { $rv += $that->{d}; } return new(__PACKAGE__, $rv); } =item C<< $c = subtract($a, $b) >> Subtracts duration $b from $a. This function is not exported by default. Can also be used as a method: $c = $a->subtract($b); =back =cut sub subtract { return add(@_, '-'); } 1; __END__ =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L, L, L. =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. =cut HTML-Microformats-0.105/lib/HTML/Microformats/DocumentContext.pm0000644000076400007640000002215111775403507022524 0ustar taitaipackage HTML::Microformats::DocumentContext; use strict qw(subs vars); no warnings; use 5.010; use Data::UUID; use HTML::Microformats::ObjectCache; use HTML::Microformats::Utilities qw'searchAncestorTag'; use URI; use XML::LibXML qw(:all); use Object::AUTHORITY; BEGIN { $HTML::Microformats::DocumentContext::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::DocumentContext::VERSION = '0.105'; } sub new { my ($class, $document, $uri, $cache) = @_; $cache ||= HTML::Microformats::ObjectCache->new; my $self = { 'document' => $document , 'uri' => $uri , 'profiles' => [] , 'cache' => $cache , }; bless $self, $class; foreach my $e ($document->getElementsByTagName('*')) { my $np = $e->nodePath; $np =~ s?\*/?\*\[1\]/?g; $e->setAttribute('data-cpan-html-microformats-nodepath', $np) } ($self->{'bnode_prefix'} = Data::UUID->new->create_hex) =~ s/^0x//; $self->_process_langs($document->documentElement); $self->_detect_profiles; return $self; } sub cache { return $_[0]->{'cache'}; } sub document { return $_[0]->{'document'}; } sub uri { my $this = shift; my $param = shift || ''; my $opts = shift || {}; if ((ref $opts) =~ /^XML::LibXML/) { my $x = {'element' => $opts}; $opts = $x; } if ($param =~ /^([a-z][a-z0-9\+\.\-]*)\:/i) { # seems to be an absolute URI, so can safely return "as is". return $param; } elsif ($opts->{'require-absolute'}) { return undef; } my $base = $this->{'uri'}; if ($opts->{'element'}) { $base = $this->get_node_base($opts->{'element'}); } my $rv = URI->new_abs($param, $base)->canonical->as_string; while ($rv =~ m!^(http://.*)(\.\./|\.)+(\.\.|\.)?$!i) { $rv = $1; } return $rv; } sub document_uri { my $self = shift; return $self->{'document_uri'} || $self->uri; } sub make_bnode { my ($self, $elem) = @_; # if (defined $elem && $elem->hasAttribute('id')) # { # my $uri = $self->uri('#' . $elem->getAttribute('id')); # return 'http://thing-described-by.org/?'.$uri; # } return sprintf('_:B%s%04d', $self->{'bnode_prefix'}, $self->{'next_bnode'}++); } sub profiles { return @{ $_[0]->{'profiles'} }; } sub has_profile { my $self = shift; foreach my $requested (@_) { foreach my $available ($self->profiles) { return 1 if $available eq $requested; } } return 0; } sub add_profile { my $self = shift; foreach my $p (@_) { push @{ $self->{'profiles'} }, $p unless $self->has_profile($p); } } sub representative_hcard { my $self = shift; unless ($self->{'representative_hcard'}) { my @hcards = HTML::Microformats::Format::hCard->extract_all($self->document->documentElement, $self); HCARD: foreach my $hc (@hcards) { next unless ref $hc; if (defined $hc->data->{'uid'} and $hc->data->{'uid'} eq $self->document_uri) { $self->{'representative_hcard'} = $hc; last HCARD; } } unless ($self->{'representative_hcard'}) { HCARD: foreach my $hc (@hcards) { next unless ref $hc; if ($hc->data->{'_has_relme'}) { $self->{'representative_hcard'} = $hc; last HCARD; } } } # unless ($self->{'representative_hcard'}) # { # $self->{'representative_hcard'} = $hcards[0] if @hcards; # } if ($self->{'representative_hcard'}) { $self->{'representative_hcard'}->{'representative'} = 1; } } return $self->{'representative_hcard'}; } sub representative_person_id { my $self = shift; my $as_trine = shift; my $hcard = $self->representative_hcard; if ($hcard) { return $hcard->id($as_trine, 'holder'); } unless (defined $self->{'representative_person_id'}) { $self->{'representative_person_id'} = $self->make_bnode; } if ($as_trine) { return ($self->{'representative_person_id'} =~ /^_:(.*)$/) ? RDF::Trine::Node::Blank->new($1) : RDF::Trine::Node::Resource->new($self->{'representative_person_id'}); } return $self->{'representative_person_id'}; } sub contact_hcard { my $self = shift; unless ($self->{'contact_hcard'}) { my @hcards = HTML::Microformats::Format::hCard->extract_all($self->document->documentElement, $self); my ($shallowest, $shallowest_depth); HCARD: foreach my $hc (@hcards) { next unless ref $hc; my $address = searchAncestorTag('address', $hc->element); next unless defined $address; my @bits = split m'/', $address; my $address_depth = scalar(@bits); if ($address_depth < $shallowest_depth || !defined $shallowest) { $shallowest_depth = $address_depth; $shallowest = $hc; } } $self->{'contact_hcard'} = $shallowest; if ($self->{'contact_hcard'}) { $self->{'contact_hcard'}->{'contact'} = 1; } } return $self->{'contact_hcard'}; } sub contact_person_id { my $self = shift; my $as_trine = shift; my $hcard = $self->contact_hcard; if ($hcard) { return $hcard->id($as_trine, 'holder'); } unless (defined $self->{'contact_person_id'}) { $self->{'contact_person_id'} = $self->make_bnode; } if ($as_trine) { return ($self->{'contact_person_id'} =~ /^_:(.*)$/) ? RDF::Trine::Node::Blank->new($1) : RDF::Trine::Node::Resource->new($self->{'contact_person_id'}); } return $self->{'contact_person_id'}; } sub _process_langs { my $self = shift; my $elem = shift; my $lang = shift; if ($elem->hasAttributeNS(XML_XML_NS, 'lang')) { $lang = $elem->getAttributeNS(XML_XML_NS, 'lang'); } elsif ($elem->hasAttribute('lang')) { $lang = $elem->getAttribute('lang'); } $elem->setAttribute('data-cpan-html-microformats-lang', $lang); foreach my $child ($elem->getChildrenByTagName('*')) { $self->_process_langs($child, $lang); } } sub _detect_profiles { my $self = shift; foreach my $head ($self->document->getElementsByTagNameNS('http://www.w3.org/1999/xhtml', 'head')) { if ($head->hasAttribute('profile')) { my @p = split /\s+/, $head->getAttribute('profile'); foreach my $p (@p) { $self->add_profile($p) if length $p; } } } } 1; __END__ =head1 NAME HTML::Microformats::DocumentContext - context for microformat objects =head1 DESCRIPTION Microformat objects need context when being parsed to properly make sense. For example, a base URI is needed to resolve relative URI references, and a full copy of the DOM tree is needed to implement the include pattern. =head2 Constructor =over =item C<< $context = HTML::Microformats::DocumentContext->new($dom, $baseuri) >> Creates a new context from a DOM document and a base URI. $dom will be modified, so if you care about keeping it pristine, make a clone first. =back =head2 Public Methods =over =item C<< $context->cache >> A Microformat cache for the context. This prevents the same microformat object from being parsed and reparsed - e.g. an adr parsed first in its own right, and later as a child of an hCard. =item C<< $context->document >> Return the modified DOM document. =item C<< $context->uri( [$relative_reference] ) >> Called without a parameter, returns the context's base URI. Called with a parameter, resolves the URI reference relative to the base URI. =item C<< $context->document_uri >> Returns a URI representing the document itself. (Usually the same as the base URI.) =item C<< $context->make_bnode( [$element] ) >> Mint a blank node identifier or a URI. If an element is passed, this may be used to construct a URI in some way. =item C<< $context->profiles >> A list of profile URIs declared by the document. =item C<< $context->has_profile(@profiles) >> Returns true iff any of the profiles in the array are declared by the document. =item C<< $context->add_profile(@profiles) >> Declare these additional profiles. =item C<< $context->representative_hcard >> Returns the hCard for the person that is "represented by" the page (in the XFN sense), or undef if no suitable hCard could be found =item C<< $context->representative_person_id( [$as_trine] ) >> Equivalent to calling C<< $context->representative_hcard->id($as_trine, 'holder') >>, however magically works even if $context->representative_hcard returns undef. =item C<< $context->contact_hcard >> Returns the hCard for the contact person for the page, or undef if none can be found. hCards are considered potential contact hCards if they are contained within an HTML EaddressE tag, or their root element is an EaddressE tag. If there are several such hCards, then the one in the shallowest EaddressE tag is used; if there are several EaddressE tags equally shallow, the first is used. =item C<< $context->contact_person_id( [$as_trine] ) >> Equivalent to calling C<< $context->contact_hcard->id($as_trine, 'holder') >>, however magically works even if $context->contact_hcard returns undef. =back =head1 BUGS Please report any bugs to L. =head1 SEE ALSO L =head1 AUTHOR Toby Inkster Etobyink@cpan.orgE. =head1 COPYRIGHT AND LICENCE Copyright 2008-2012 Toby Inkster This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 DISCLAIMER OF WARRANTIES THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. HTML-Microformats-0.105/lib/HTML/Microformats/Utilities.pm0000644000076400007640000004216711775403507021365 0ustar taitai=head1 NAME HTML::Microformats::Utilities - utility functions for searching and manipulating HTML =head1 DESCRIPTION This module includes a few functions for searching and manipulating HTML trees. =cut package HTML::Microformats::Utilities; use base qw(Exporter); use strict qw(subs vars); no warnings; use utf8; use 5.010; use Object::AUTHORITY; BEGIN { $HTML::Microformats::Utilities::AUTHORITY = 'cpan:TOBYINK'; $HTML::Microformats::Utilities::VERSION = '0.105'; } our @EXPORT_OK; BEGIN { @EXPORT_OK = qw(searchClass searchAncestorClass searchRel searchRev searchID searchAncestorTag stringify xml_stringify); } use HTML::Microformats::Datatype::String; use XML::LibXML qw(:all); =over 4 =item C<< searchClass($class, $node, [$prefix]) >> Returns a list of elements which are descendents of $node and have class name $class. $class can be a plain string, or a regular expression. If $prefix is supplied it is used as an optional prefix for $class. For example, with $class 'bar' and $prefix 'foo', searchClass will look for all of the following classes: 'bar', 'foobar', 'foo-bar' and 'foo:bar'. =cut sub searchClass { my $target = shift; my $dom = shift; my $prefix = shift || undef; my @matches; return @matches unless $dom; foreach my $node ($dom->getElementsByTagName('*')) { my $classList; $classList = $node->getAttribute('class'); $classList = $node->getAttribute('name') if (!length $classList) && ($node->tagName eq 'param'); next unless length $classList; if ((defined $prefix) && $classList =~ / (^|\s) ($prefix [:\-]?)? $target (\s|$) /x) { push @matches, $node; } elsif ($classList =~ / (^|\s) $target (\s|$) /x) { push @matches, $node; } } return @matches; } =item C<< searchAncestorClass($class, $node, [$skip]) >> Returns the first element which is an ancestor of $node having class name $class. $class can be a plain string, or a regular expression. $skip is the number of levels of ancestor to skip. If $skip is 0, then potentially searchAncestorClass will return $node itself. If $skip is 1, then it will not return $node but could potentially return its parent, and so on. =cut sub searchAncestorClass { my $target = shift; my $dom = shift; my $skip = shift; return undef unless defined $dom; if (!defined $skip or $skip <= 0) { my $classList; $classList = $dom->getAttribute('class'); $classList = $dom->getAttribute('name') if (!length $classList and $dom->tagName eq 'param'); if ($classList =~ / (^|\s) $target (\s|$) /x) { return $dom; } } if (defined $dom->parentNode and $dom->parentNode->isa('XML::LibXML::Element')) { return searchAncestorClass($target, $dom->parentNode, $skip-1); } return undef; } =item C<< searchRel($relationship, $node) >> Returns a list of elements which are descendents of $node and have relationship $relationship. $relationship can be a plain string, or a regular expression. =cut sub searchRel { my $target = shift; my $dom = shift; $target =~ tr/[\:\.]/\[\:\.\]/ unless ref $target; my @matches = (); for my $node ($dom->getElementsByTagName('*')) { my $classList = $node->getAttribute('rel'); next unless length $classList; if ($classList =~ / (^|\s) $target (\s|$) /ix) { push @matches, $node; } } return @matches; } =item C<< searchRev($relationship, $node) >> As per searchRel, but uses the rev attribute. =cut sub searchRev { my $target = shift; my $dom = shift; $target =~ tr/[\:\.]/\[\:\.\]/ unless ref $target; my @matches = (); for my $node ($dom->getElementsByTagName('*')) { my $classList = $node->getAttribute('rev'); next unless length $classList; if ($classList =~ / (^|\s) $target (\s|$) /ix) { push @matches, $node; } } return @matches; } =item C<< searchID($id, $node) >> Returns a descendent of $node with id attribute $id, or undef. =cut sub searchID { my $target = shift; my $dom = shift; $target =~ s/^\#//; for my $node ($dom->getElementsByTagName('*')) { my $id = $node->getAttribute('id') || next; return $node if $id eq $target; } } =item C<< searchAncestorTag($tagname, $node) >> Returns the nearest ancestor of $node with tag name $tagname, or undef. =cut sub searchAncestorTag { my ($target, $node) = @_; return $node if $node->localname =~ /^ $target $/ix; return searchAncestorTag($target, $node->parentNode) if defined $node->parentNode && $node->parentNode->nodeType == XML_ELEMENT_NODE; return undef; } =item C<< stringify($node, \%options) >> Returns a stringified version of a DOM element. This is conceptually equivalent to C<< $node->textContent >>, but follows microformat-specific stringification rules, including value excerption, the abbr pattern and so on. =cut # This function takes on too much responsibility. # It should delegate stuff. sub stringify { my $dom = shift; my $valueClass = shift || undef; my $doABBR = shift || (length $valueClass); my $str; my %opts; if (ref($valueClass) eq 'HASH') { %opts = %$valueClass; $valueClass = $opts{'excerpt-class'}; $doABBR = $opts{'abbr-pattern'}; } return unless $dom; # value-title if ($opts{'value-title'} =~ /(allow|require)/i or ($opts{'datetime'} && $opts{'value-title'} !~ /(forbid)/i)) { KIDDY: foreach my $kid ($dom->childNodes) { next if $kid->nodeName eq '#text' && $kid->textContent !~ /\S/; # skip whitespace last # anything without class='value-title' and a title attribute causes us to bail out. unless $opts{'value-title'} =~ /(lax)/i || ($kid->can('hasAttribute') && $kid->hasAttribute('class') && $kid->hasAttribute('title') && $kid->getAttribute('class') =~ /\b(value\-title)\b/); my $str = $kid->getAttribute('title'); utf8::encode($str); return HTML::Microformats::Datatype::String::ms($str, $kid); } } return if $opts{'value-title'} =~ /(require)/i; # ABBR pattern if ($doABBR) { if ($dom->nodeType==XML_ELEMENT_NODE && length $dom->getAttribute('data-cpan-html-microformats-content')) { my $title = $dom->getAttribute('data-cpan-html-microformats-content'); return HTML::Microformats::Datatype::String::ms($title, $dom); } elsif ( ($dom->nodeType==XML_ELEMENT_NODE && $dom->tagName eq 'abbr' && $dom->hasAttribute('title')) || ($dom->nodeType==XML_ELEMENT_NODE && $dom->tagName eq 'acronym' && $dom->hasAttribute('title')) || ($dom->nodeType==XML_ELEMENT_NODE && $dom->getAttribute('title') =~ /data\:/) ) { my $title = $dom->getAttribute('title'); utf8::encode($title); if ($title =~ / [\(\[\{] data\: (.*) [\)\]\}] /x || $title =~ / data\: (.*) $ /x ) { $title = $1; } if (defined $title) { return (ms $title, $dom); } } elsif ($dom->nodeType==XML_ELEMENT_NODE && $opts{'datetime'} && $dom->hasAttribute('datetime')) { my $str = $dom->getAttribute('datetime'); utf8::encode($str); return HTML::Microformats::Datatype::String::ms($str, $dom); } } # Value excerpting. if (length $valueClass) { my @nodes = searchClass($valueClass, $dom); my @strs; if (@nodes) { foreach my $valueNode (@nodes) { push @strs, stringify($valueNode, { 'excerpt-class' => undef, 'abbr-pattern' => $doABBR, 'datetime' => $opts{'datetime'}, 'keep-whitespace' => 1 }); } # In datetime mode, be smart enough to detect when date, time and # timezone have been given in wrong order. if ($opts{'datetime'}) { my $dt_things = {}; foreach my $x (@strs) { if ($x =~ /^\s*(Z|[+-]\d{1,2}(\:?\d\d)?)\s*$/i) { push @{$dt_things->{'z'}}, $1; } elsif ($x =~ /^\s*T?([\d\.\:]+)\s*$/i) { push @{$dt_things->{'t'}}, $1; } elsif ($x =~ /^\s*([\d-]+)\s*$/i) { push @{$dt_things->{'d'}}, $1; } elsif ($x =~ /^\s*T?([\d\.\:]+)\s*(Z|[+-]\d{1,2}(\:?\d\d)?)\s*$/i) { push @{$dt_things->{'t'}}, $1; push @{$dt_things->{'z'}}, $2; } elsif ($x =~ /^\s*(\d+)(?:[:\.](\d+))?(?:[:\.](\d+))?\s*([ap])\.?\s*[m]\.?\s*$/i) { my $h = $1; if (uc $4 eq 'P' && $h<12) { $h += 12; } elsif (uc $4 eq 'A' && $h==12) { $h = 0; } my $t = (defined $3) ? sprintf("%02d:%02d:%02d", $h, $2, $3) : sprintf("%02d:%02d", $h, $2); push @{$dt_things->{'t'}}, $t; } } if (defined $opts{'datetime-feedthrough'} && !defined $dt_things->{'d'}->[0]) { push @{ $dt_things->{'d'} }, $opts{'datetime-feedthrough'}->ymd('-'); } if (defined $opts{'datetime-feedthrough'} && !defined $dt_things->{'z'}->[0]) { push @{ $dt_things->{'z'} }, $opts{'datetime-feedthrough'}->strftime('%z'); } $str = sprintf("%s %s %s", $dt_things->{'d'}->[0], $dt_things->{'t'}->[0], $dt_things->{'z'}->[0]); } unless (length $str) { $str = HTML::Microformats::Datatype::String::ms((join $opts{'joiner'}, @strs), $dom); } } } my $inpre = searchAncestorTag('pre', $dom) ? 1 : 0; eval { $str = _stringify_helper($dom, $inpre, 0) unless defined $str; }; #$str = '***UTF-8 ERROR (WTF Happened?)***' if $@; #$str = '***UTF-8 ERROR (Not UTF-8)***' unless utf8::is_utf8("$str"); #$str = '***UTF-8 ERROR (Bad UTF-8)***' unless utf8::valid("$str"); if ($opts{'datetime'} && defined $opts{'datetime-feedthrough'}) { if ($str =~ /^\s*T?([\d\.\:]+)\s*$/i) { $str = sprintf('%s %s %s', $opts{'datetime-feedthrough'}->ymd('-'), $1, $opts{'datetime-feedthrough'}->strftime('%z'), ); } elsif ($str =~ /^\s*T?([\d\.\:]+)\s*(Z|[+-]\d{1,2}(\:?\d\d)?)\s*$/i) { $str = sprintf('%s %s %s', $opts{'datetime-feedthrough'}->ymd('-'), $1, $2, ); } elsif ($str =~ /^\s*([\d]+)(?:[:\.](\d+))(?:[:\.](\d+))?\s*([ap])\.?\s*[m]\.?\s*$/i) { my $h = $1; if (uc $4 eq 'P' && $h<12) { $h += 12; } elsif (uc $4 eq 'A' && $h==12) { $h = 0; } my $t = (defined $3) ? sprintf("%02d:%02d:%02d", $h, $2, $3) : sprintf("%02d:%02d", $h, $2); $str = sprintf('%s %s %s', $opts{'datetime-feedthrough'}->ymd('-'), $t, $opts{'datetime-feedthrough'}->strftime('%z'), ); } } unless ($opts{'keep-whitespace'}) { # \x1D is used as a "soft" line break. It can be "absorbed" into an adjacent # "hard" line break. $str =~ s/\x1D+/\x1D/g; $str =~ s/\x1D\n/\n/gs; $str =~ s/\n\x1D/\n/gs; $str =~ s/\x1D/\n/gs; $str =~ s/(^\s+|\s+$)//gs; } return HTML::Microformats::Datatype::String::ms($str, $dom); } sub _stringify_helper { my $domNode = shift || return; my $inPRE = shift || 0; my $indent = shift || 0; my $rv = ''; my $tag; if ($domNode->nodeType == XML_ELEMENT_NODE) { $tag = lc($domNode->tagName); } elsif ($domNode->nodeType == XML_COMMENT_NODE) { return HTML::Microformats::Datatype::String::ms(''); } # Change behaviour within 
    .
	$inPRE++ if $tag eq 'pre';
	
	# Text node, or equivalent.
	if (!$tag || $tag eq 'img' || $tag eq 'input' || $tag eq 'param')
	{
		$rv = $domNode->getData
			unless $tag;
		$rv = $domNode->getAttribute('alt')
			if $tag && $domNode->hasAttribute('alt');
		$rv = $domNode->getAttribute('value')
			if $tag && $domNode->hasAttribute('value');

		utf8::encode($rv);

		unless ($inPRE)
		{
			$rv =~ s/[\s\r\n]+/ /gs;
		}
		
		return $rv;
	}
	
	# Breaks.
	return "\n" if ($tag eq 'br');
	return "\x1D\n====\n\n"
		if ($tag eq 'hr');
	
	# Deleted text.
	return '' if ($tag eq 'del');

	# Get stringified children.
	my (@parts, @ctags, @cdoms);
	my $extra = 0;
	if ($tag =~ /^([oud]l|blockquote)$/)
	{
		$extra += 6; # Advisory for word wrapping.
	}
	foreach my $child ($domNode->getChildNodes)
	{
		my $ctag = $child->nodeType==XML_ELEMENT_NODE ? lc($child->tagName) : undef;
		my $str  = _stringify_helper($child, $inPRE, $indent + $extra);
		push @ctags, $ctag;
		push @parts, $str;
		push @cdoms, $child;
	}
	
	if ($tag eq 'ul' || $tag eq 'dir' || $tag eq 'menu')
	{
		$rv .= "\x1D";
		my $type = lc($domNode->getAttribute('type')) || 'disc';

		for (my $i=0; defined $parts[$i]; $i++)
		{
			next unless ($ctags[$i] eq 'li');
			
			$_ = $parts[$i];
			s/(^\x1D|\x1D$)//g;
			s/\x1D+/\x1D/g;
			s/\x1D\n/\n/gs;
			s/\n\x1D/\n/gs;
			s/\x1D/\n/gs;
			s/\n/\n    /gs;

			my $marker_type = $type;
			$marker_type = lc($cdoms[$i]->getAttribute('type'))
				if (length $cdoms[$i]->getAttribute('type'));

			my $marker = '*';
			if ($marker_type eq 'circle')    { $marker = '-'; }
			elsif ($marker_type eq 'square') { $marker = '+'; }
			
			$rv .= "  $marker $_\n";
		}
		$rv .= "\n";
	}
	
	elsif ($tag eq 'ol')
	{
		$rv .= "\x1D";
		
		my $count = 1;
		$count = $domNode->getAttribute('start')
			if (length $domNode->getAttribute('start'));
		my $type = $domNode->getAttribute('type') || '1';
		
		for (my $i=0; defined $parts[$i]; $i++)
		{
			next unless ($ctags[$i] eq 'li');
			
			$_ = $parts[$i];
			s/(^\x1D|\x1D$)//g;
			s/\x1D+/\x1D/g;
			s/\x1D\n/\n/gs;
			s/\n\x1D/\n/gs;
			s/\x1D/\n/gs;
			s/\n/\n    /gs;
			
			my $marker_value = $count;
			$marker_value = $cdoms[$i]->getAttribute('value')
				if (length $cdoms[$i]->getAttribute('value'));
			
			my $marker_type = $type;
			$marker_type = $cdoms[$i]->getAttribute('type')
				if (length $cdoms[$i]->getAttribute('type'));
				
			my $marker = sprintf('% 2d', $marker_value);
			if (uc($marker_type) eq 'A' && $marker_value > 0 && $marker_value <= 26)
				{ $marker = ' ' . chr( ord($marker_type) + $marker_value - 1 ); }
			elsif ($marker_type eq 'i' && $marker_value > 0 && $marker_value <= 3999)
				{ $marker = sprintf('% 2s', roman($marker_value)); }
			elsif ($marker_type eq 'I' && $marker_value > 0 && $marker_value <= 3999)
				{ $marker = sprintf('% 2s', Roman($marker_value)); }
				
			$rv .= sprintf("\%s. \%s\n", $marker, $_);

			$count++;
		}
		$rv .= "\n";
	}

	elsif ($tag eq 'dl')
	{
		$rv .= "\x1D";
		for (my $i=0; defined $parts[$i]; $i++)
		{
			next unless ($ctags[$i] eq 'dt' || $ctags[$i] eq 'dd');
			
			if ($ctags[$i] eq 'dt')
			{
				$rv .= $parts[$i] . ':';
				$rv =~ s/\:\s*\:$/\:/;
				$rv .= "\n";
			}
			elsif ($ctags[$i] eq 'dd')
			{
				$_ = $parts[$i];
				s/(^\x1D|\x1D$)//g;
				s/\x1D+/\x1D/g;
				s/\x1D\n/\n/gs;
				s/\n\x1D/\n/gs;
				s/\x1D/\n/gs;
				s/\n/\n    /gs;
				$rv .= sprintf("    \%s\n\n", $_);
			}
		}
	}

	elsif ($tag eq 'blockquote')
	{
		$rv .= "\x1D";
		for (my $i=0; defined $parts[$i]; $i++)
		{
			next unless ($ctags[$i]);
			
			$_ = $parts[$i];
			s/(^\x1D|\x1D$)//g;
			s/\x1D+/\x1D/g;
			s/\x1D\n/\n/gs;
			s/\n\x1D/\n/gs;
			s/\x1D/\n/gs;
			s/\n\n/\n/;
			s/\n/\n> /gs;
			$rv .= "> $_\n";
		}
		$rv =~ s/> $/\x1D/;
	}
	
	else
	{
		$rv = '';
		for (my $i=0; defined $parts[$i]; $i++)
		{
			$rv .= $parts[$i];
			
			# Hopefully this is a sensible algorithm for inserting whitespace
			# between childnodes. Needs a bit more testing though.
			
			# Don't insert whitespace if this tag or the next one is a block-level element.
			# Probably need to expand this list of block elements.
#			next if ($ctags[$i]   =~ /^(p|h[1-9]?|div|center|address|li|dd|dt|tr|caption|table)$/);
#			next if ($ctags[$i+1] =~ /^(p|h[1-9]?|div|center|address|li|dd|dt|tr|caption|table)$/);
			
			# Insert whitespace unless the string already ends in whitespace, or next
			# one begins with whitespace.
#			$rv .= ' '
#				unless ($rv =~ /\s$/ || (defined $parts[$i+1] && $parts[$i+1] =~ /^\s/));
		}
		
		if ($tag =~ /^(p|h[1-9]?|div|center|address|li|dd|dt|tr|caption|table)$/ && !$inPRE)
		{
			$rv =~ s/^[\t ]//s;
			#local($Text::Wrap::columns);
			#$Text::Wrap::columns = 78 - $indent;
			$rv = "\x1D".$rv;#Text::Wrap::wrap('','',$rv);
			if ($tag =~ /^(p|h[1-9]?|address)$/)
			{
				$rv .= "\n\n";
			}
		}
		
		if ($tag eq 'sub')
			{ $rv = "($rv)"; }
		elsif ($tag eq 'sup')
			{ $rv = "[$rv]"; }
		elsif ($tag eq 'q')
			{ $rv = "\"$rv\""; }
		elsif ($tag eq 'th' || $tag eq 'td')
			{ $rv = "$rv\t"; }
	}

	return $rv;
}

=item C<< xml_stringify($node) >>

Returns an XML serialisation of a DOM element. This is conceptually equivalent
to C<< $node->toStringEC14N >>, but hides certain attributes which
HTML::Microformats::DocumentContext adds for internal processing.

=cut

sub xml_stringify
{
	my $node  = shift;
	my $clone = $node->cloneNode(1);
	
	foreach my $attr ($clone->attributes)
	{
		if ($attr->nodeName =~ /^data-cpan-html-microformats-/)
		{
			$clone->removeAttribute($attr->nodeName);
		}
	}
	foreach my $kid ($clone->getElementsByTagName('*'))
	{
		foreach my $attr ($kid->attributes)
		{
			if ($attr->nodeName =~ /^data-cpan-html-microformats-/)
			{
				$kid->removeAttribute($attr->nodeName);
			}
		}
	}
	
	$node->ownerDocument->documentElement->appendChild($clone);
	my $rv = $clone->toStringEC14N;
	$node->ownerDocument->documentElement->removeChild($clone);
	return $rv;
}

1;

__END__

=back

=head1 BUGS

Please report any bugs to L.

=head1 SEE ALSO

L.

=head1 AUTHOR

Toby Inkster Etobyink@cpan.orgE.

=head1 COPYRIGHT AND LICENCE

Copyright 2008-2012 Toby Inkster

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.


=cut
HTML-Microformats-0.105/lib/HTML/Microformats/Format.pm0000644000076400007640000002334011775403507020632 0ustar  taitai=head1 NAME

HTML::Microformats::Format - base microformat class

=head1 DESCRIPTION

HTML::Microformats::Format cannot be instantiated directly but many other classes
inherit from it. 

=cut

package HTML::Microformats::Format;

use base qw(HTML::Microformats::Mixin::RDF);
use strict qw(subs vars); no warnings;
use 5.010;

use Carp;
use HTML::Microformats::Utilities qw(searchClass searchRel searchRev);
use RDF::Trine;
use Scalar::Util qw[];

use Object::AUTHORITY;

BEGIN {
	$HTML::Microformats::Format::AUTHORITY = 'cpan:TOBYINK';
	$HTML::Microformats::Format::VERSION   = '0.105';
}
our $AUTOLOAD;

# Derived classes...
#   MUST override: new
#   SHOULD override: format_signature, add_to_model, profiles
#   MIGHT WANT TO override: id, extract_all, data

=head2 Constructors

The constructors cannot actually be called on this package. Call them on descendent
classes instead.

=over 4

=item C<< $object = HTML::Microformats::Format->new($element, $context, %options) >>

Parse a microformat with root element $element. 

=cut

sub new
{
	die "Cannot instantiate HTML::Microformats::Format.\n";
}

=item C<< $object = HTML::Microformats::Format->extract_all($element, $context, %options) >>

Find and parse all such microformats within element $element. 

=back

=cut

sub extract_all
{
	my ($class, $dom, $context, %options) = @_;
	my @rv;
	
	my $hclass = $class->format_signature->{'root'};
	my $rel    = $class->format_signature->{'rel'};
	my $rev    = $class->format_signature->{'rev'};
	
	unless (defined $rel || defined $rev || defined $hclass)
	{
		die "extract_all failed.\n";
	}
	
	if (defined $hclass)
	{
		$hclass = [$hclass] unless ref $hclass eq 'ARRAY';
		
		foreach my $hc (@$hclass)
		{
			my @elements = searchClass($hc, $dom);
			foreach my $e (@elements)
			{
				my $object = $class->new($e, $context, %options);
				next unless $object;
				next if grep { $_->id eq $object->id } @rv; # avoid duplicates
				push @rv, $object if ref $object;
			}
		}
	}
	
	if (defined $rel)
	{
		$rel = [$rel] unless ref $rel eq 'ARRAY';
		
		foreach my $r (@$rel)
		{
			my @elements = searchRel($r, $dom);
			foreach my $e (@elements)
			{
				my $object = $class->new($e, $context, %options);
				next unless $object;
				next if grep { $_->id eq $object->id } @rv; # avoid duplicates
				push @rv, $object if ref $object;
			}
		}
	}
	
	if (defined $rev)
	{
		$rev = [$rev] unless ref $rev eq 'ARRAY';
		
		foreach my $r (@$rev)
		{
			my @elements = searchRev($r, $dom);
			foreach my $e (@elements)
			{
				my $object = $class->new($e, $context, %options);
				next unless $object;
				next if grep { $_->id eq $object->id } @rv; # avoid duplicates
				push @rv, $object if ref $object;
			}
		}
	}
	
	return @rv;
}

=head2 Public Methods - Accessors

There are a number of property accessor methods defined via Perl's AUTOLOAD mechanism. 

For any microformat property (e.g. 'fn' in hCard) there are get_X, set_X, add_X and
clear_X methods defined.

C: for singular properties, returns the value of property X. For plural properties, returns a
list of values if called in list context, or the first value otherwise.

C: for singular properties, sets the value of property X to the first given parameter.
For plural properties, sets the values of property X to the list of parameters.
B

C: for singular properties, sets the value of property X to the first given parameter,
but croaks if X is already set. For concatenated singular properties, concatenates to the
end of any existing value of X. For plural properties, adds any given parameters to the
list of values of property X.
B

C: removes any values of property X, but croaks if the property is a required
property.
B

For example, an HTML::Microformats::hCard object will have a method called get_fn which
gets the value of the hCard's "fn" property, a method called set_fn which sets it, a
method called add_fn which also sets it (but croaks if it's already set), and a method
called clear_fn which croaks if called (because "fn" is a required property).

B the C, C and C methods are 
deprecated and will be removed soon. In general you should treat objects which are
instances of HTML::Microformats::Format as read-only.

=cut

sub AUTOLOAD
{
	my $self = shift;
	my $func = $AUTOLOAD;
	
	if ($func =~ /^.*::(get|set|add|clear)_([^:]+)$/)
	{		
		my $method = $1;
		my $datum  = $2;
		my $opts   = undef;
		my $classes = $self->format_signature->{'classes'};
		
		$datum =~ s/_/\-/g;
		
		foreach my $c (@$classes)
		{
			if ($c->[0] eq $datum)
			{
				$opts = $c->[1];
				last;
			}
			elsif ($c->[2]->{'use-key'} eq $datum)
			{
				$datum = $c->[2]->{'use-key'};
				$opts  = $c->[1];
				last;
			}
		}
		
		croak "Function $func unknown.\n" unless defined $opts;
		
		if ($method eq 'get')
		{
			return $self->{'DATA'}->{$datum};
		}
		elsif ($method eq 'clear')
		{
			croak "Attempt to clear required property $datum.\n"
				if $opts =~ /[1\+]/;
			delete $self->{'DATA'}->{$datum};
		}
		elsif ($method eq 'add')
		{
			croak "Attempt to add more than one value to singular property $datum.\n"
				if $opts =~ /[1\?]/ && defined $self->{'DATA'}->{$datum};
			
			if ($opts =~ /[1\?]/)
			{
				$self->{'DATA'}->{$datum} = shift;
			}
			elsif ($opts =~ /[\&]/)
			{
				$self->{'DATA'}->{$datum} .= shift;
			}
			else
			{
				push @{ $self->{'DATA'}->{$datum} }, @_;
			}
		}
		elsif ($method eq 'set')
		{
			if ($opts =~ /[1\?\&]/)
			{
				$self->{'DATA'}->{$datum} = shift;
			}
			else
			{
				$self->{'DATA'}->{$datum} = \@_;
			}
		}
	}
	else
	{
		croak "No function '$func' defined.\n"
			unless $func =~ /::(DESTROY|no|import)$/;
	}
}

=head2 Public Methods - Other

=over 4

=item C<< $object->format_signature >> or C<< $class->format_signature >>

This method may be called as a class or object method. It returns various information
about the definition of this microformat (e.g. what is the root class, which properties
exist, etc). You may need to do some digging to figure out what everything means.

=cut

sub format_signature
{
	return {
		'root'         => undef ,
		'rel'          => undef ,
		'classes'      => [] ,
		'options'      => {} ,
		'rdf:type'     => 'http://www.w3.org/2002/07/owl#Thing' ,
		'rdf:property' => {} ,
		};
}

=item C<< $object->profiles >> or C<< $class->profiles >>

This method may be called as a class or object method. It returns HTML profile
URIs which indicate the presence of this microformat.

=cut

sub profiles
{
	return qw();
}

=item C<< $object->context >> 

Returns the parsing context (as supplied to C).

=cut

sub context
{
	return $_[0]->{'context'};
}

=item C<< $object->data >> 

Returns a hashref of object data. This is a reference to the live data inside the
object. Any changes to the returned hashref will change the values inside the object.

=cut

sub data
{
	return {} unless defined $_[0]->{'DATA'};
	return $_[0]->{'DATA'};
}

sub TO_JSON
{
	return data( $_[0] );
}

=item C<< $object->element >> 

Returns the root element.

=cut

sub element
{
	return $_[0]->{'element'};
}

=item C<< $object->cache >> 

Shortcut for C<< $object->context->cache >>.

=cut

sub cache
{
	return $_[0]->{'cache'};
}

=item C<< $object->id([$trine_obj], [$role]) >> 

Returns a blank node identifier or identifying URI for the object.

If $trine_obj is true, the return value is an RDF::Trine::Node object. Otherwise,
it's a string (using the '_:' convention to identify blank nodes).

If $role is undefined, then returns the identifier for the object itself.
If it's defined then it returns an identifier for a resource with a fixed
relationship to the object.

  $identifier_for_business_card  = $hcard->id;
  $identifier_for_person         = $hcard->id(undef, 'holder');

=cut

sub id
{
	my ($self, $as_trine, $role) = @_;

	my $id = defined $role ? $self->{"id.${role}"} : $self->{'id'};
	
	unless (defined $id)
	{
		$self->{ defined $role ? "id.${role}" : 'id' } = $self->context->make_bnode;
		$id = defined $role ? $self->{"id.${role}"} : $self->{'id'};
	}

	return $id unless $as_trine;
	return ($id  =~ /^_:(.*)$/) ?
	       RDF::Trine::Node::Blank->new($1) :
	       RDF::Trine::Node::Resource->new($id);
}

=item C<< $object->add_to_model($model) >> 

Given an RDF::Trine::Model object, adds relevant data to the model.

=cut

sub add_to_model
{
	my $self  = shift;
	my $model = shift;

	$self->_simple_rdf($model);
	
	return $self;
}

=item C<< $object->model >> 

Creates a fresh, new RDF::Trine::Model object, containing relevant data.

=cut

sub model
{
	my $self  = shift;
	my $model = RDF::Trine::Model->temporary_model;
	$self->add_to_model($model);
	return $model;
}

=item C<< $object->serialise_model(as => $format) >> 

As C but returns a string.

=back

=cut

sub serialise_model
{
	my $self = shift;
	
	my %opts = ref $_[0] ? %{ $_[0] } : @_;
	$opts{as} ||= 'Turtle';
	
	my $ser = RDF::Trine::Serializer->new(delete $opts{as}, %opts);
	return $ser->serialize_model_to_string($self->model);
}

sub _isa # utility function for subclasses to use
{
	return Scalar::Util::blessed($_[1]) && $_[1]->isa($_[2]);
}

1;

=head1 BUGS

Please report any bugs to L.

=head1 SEE ALSO

L.

=head1 AUTHOR

Toby Inkster Etobyink@cpan.orgE.

=head1 COPYRIGHT AND LICENCE

Copyright 2008-2012 Toby Inkster

This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=head1 DISCLAIMER OF WARRANTIES

THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.


=cut


HTML-Microformats-0.105/TODO0000644000076400007640000000071111775402314013545 0ustar  taitai* Documentation is pretty sketchy.

* More test cases.

* AUTOLOADed get methods:
	- document them better
		+ can auto-generate much docs using ->format_signature 
	- ensure they can be called as get_X and get_Y where X is the microformat
          class/rel name, and Y is the hash key from ->data which sometimes differ.
		+ make sure any such differences are clearly documented

* Microformats 2.0???

* Drop dependencies on CGI/CGI::Util and URI::URL.

HTML-Microformats-0.105/MANIFEST0000644000076400007640000000651011775404022014207 0ustar  taitaiChanges
examples/microformats-to-json.pl
examples/microformats-to-rdf.pl
examples/misc/example1.pl
examples/misc/example2.pl
examples/misc/example3.pl
examples/misc/example4.pl
examples/misc/example5.pl
examples/misc/example6.pl
examples/misc/example7.pl
examples/misc/example8.pl
examples/misc/example9.pl
examples/misc/exampleA.pl
examples/misc/exampleB.pl
examples/misc/exampleC.pl
examples/misc/exampleD.pl
inc/Module/AutoInstall.pm
inc/Module/Install.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/AutoManifest.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Include.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/Package.pm
inc/Module/Install/TrustMetaYml.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
inc/Module/Package.pm
inc/Module/Package/Dist/RDF.pm
inc/Scalar/Util.pm
inc/unicore/Name.pm
inc/utf8.pm
inc/YAML/Tiny.pm
lib/HTML/Microformats.pm
lib/HTML/Microformats/Datatype.pm
lib/HTML/Microformats/Datatype/DateTime.pm
lib/HTML/Microformats/Datatype/DateTime/Parser.pm
lib/HTML/Microformats/Datatype/Duration.pm
lib/HTML/Microformats/Datatype/Interval.pm
lib/HTML/Microformats/Datatype/RecurringDateTime.pm
lib/HTML/Microformats/Datatype/String.pm
lib/HTML/Microformats/Documentation/Notes.pod
lib/HTML/Microformats/DocumentContext.pm
lib/HTML/Microformats/Format.pm
lib/HTML/Microformats/Format/adr.pm
lib/HTML/Microformats/Format/figure.pm
lib/HTML/Microformats/Format/geo.pm
lib/HTML/Microformats/Format/hAlarm.pm
lib/HTML/Microformats/Format/hAtom.pm
lib/HTML/Microformats/Format/hAudio.pm
lib/HTML/Microformats/Format/hCalendar.pm
lib/HTML/Microformats/Format/hCard.pm
lib/HTML/Microformats/Format/hCard/email.pm
lib/HTML/Microformats/Format/hCard/impp.pm
lib/HTML/Microformats/Format/hCard/label.pm
lib/HTML/Microformats/Format/hCard/n.pm
lib/HTML/Microformats/Format/hCard/org.pm
lib/HTML/Microformats/Format/hCard/tel.pm
lib/HTML/Microformats/Format/hCard/TypedField.pm
lib/HTML/Microformats/Format/hEntry.pm
lib/HTML/Microformats/Format/hEvent.pm
lib/HTML/Microformats/Format/hFreebusy.pm
lib/HTML/Microformats/Format/hListing.pm
lib/HTML/Microformats/Format/hMeasure.pm
lib/HTML/Microformats/Format/hNews.pm
lib/HTML/Microformats/Format/hProduct.pm
lib/HTML/Microformats/Format/hRecipe.pm
lib/HTML/Microformats/Format/hResume.pm
lib/HTML/Microformats/Format/hReview.pm
lib/HTML/Microformats/Format/hReview/rating.pm
lib/HTML/Microformats/Format/hReviewAggregate.pm
lib/HTML/Microformats/Format/hTodo.pm
lib/HTML/Microformats/Format/OpenURL_COinS.pm
lib/HTML/Microformats/Format/RelEnclosure.pm
lib/HTML/Microformats/Format/RelLicense.pm
lib/HTML/Microformats/Format/RelTag.pm
lib/HTML/Microformats/Format/species.pm
lib/HTML/Microformats/Format/VoteLinks.pm
lib/HTML/Microformats/Format/XFN.pm
lib/HTML/Microformats/Format/XMDP.pm
lib/HTML/Microformats/Format/XOXO.pm
lib/HTML/Microformats/Format_Rel.pm
lib/HTML/Microformats/Mixin/Parser.pm
lib/HTML/Microformats/Mixin/RDF.pm
lib/HTML/Microformats/ObjectCache.pm
lib/HTML/Microformats/Utilities.pm
LICENSE
Makefile.PL
MANIFEST			This list of files
META.yml
meta/changes.ttl
meta/doap.ttl
meta/makefile.ttl
meta/rt-bugs.ttl
README
t/01basic.t
t/10hcard.t
t/11hcalendar.t
t/12hatom.t
t/13xfn.t
t/14reltag.t
t/15rellicense.t
TODO
SIGNATURE                                Public-key signature (added by MakeMaker)
HTML-Microformats-0.105/SIGNATURE0000644000076400007640000002131011775404023014336 0ustar  taitaiThis file contains message digests of all files listed in MANIFEST,
signed via the Module::Signature module, version 0.68.

To verify the content in this distribution, first make sure you have
Module::Signature installed, then type:

    % cpansign -v

It will check each file's integrity, as well as the signature's
validity.  If "==> Signature verified OK! <==" is not displayed,
the distribution may already have been compromised, and you should
not run its Makefile.PL or Build.PL.

-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

SHA1 89fea1c25524da1068dbec752bb54e9822d154b0 Changes
SHA1 cc087c3dd6e1b519c680e68cd0231735a68300a0 LICENSE
SHA1 a9eb8bb4ff2a0ba18ba7f1ee291e7b1ba26daa44 MANIFEST
SHA1 6e6bcf14ab6291880f6387bc1aabab5dcc1c4607 META.yml
SHA1 de4aca92cc6fffeb073d369052138ec62c790de5 Makefile.PL
SHA1 22b02e23ecd15b9c9d57f790b1457c9b5898b465 README
SHA1 c0af610c308f1153c0ebceb50cc1cec6e2264e03 TODO
SHA1 4a8bc9cfd303cad1a288f1eb16323be3c9fe86ff examples/microformats-to-json.pl
SHA1 4d10d6b3551f208ec1c910828c4a711c25f2a772 examples/microformats-to-rdf.pl
SHA1 bfa0a5d512919e9526f41ac94a0b52cfcfabb654 examples/misc/example1.pl
SHA1 e69ba060af00de292a5d3d756532379475e05f2f examples/misc/example2.pl
SHA1 68e85c7eb8cf5f73fa1b55d5df4323889bd5c026 examples/misc/example3.pl
SHA1 649d087f64115485142860a1106b3092058252ab examples/misc/example4.pl
SHA1 73b2a8cdce99d44377aea82e7f904bba6521a2cd examples/misc/example5.pl
SHA1 7bde722c5223ce578b745ea9653ebd6e410859c2 examples/misc/example6.pl
SHA1 1ddfee6e6b7dab64dd86360c34b5b5eadfea8c12 examples/misc/example7.pl
SHA1 62aa7e85f36ee52c99283bc06e31d47da7d0a5d7 examples/misc/example8.pl
SHA1 2a7eab920af39191432aece9ce3d095f5ff64c32 examples/misc/example9.pl
SHA1 051e0692057265f55d7f4fd49d4e5f1ef2396837 examples/misc/exampleA.pl
SHA1 0ca14e280d0ab0ca11e0c22adc6dfbe2deb7a8ee examples/misc/exampleB.pl
SHA1 980c21a60b55354ec1a93b244e48fc8e64ffde45 examples/misc/exampleC.pl
SHA1 705fa0053ddfd37d201f710e20638c53070e64ae examples/misc/exampleD.pl
SHA1 06c410f05488c1612ed66b06d3a86b2580581e4a inc/Module/AutoInstall.pm
SHA1 8a924add836b60fb23b25c8506d45945e02f42f4 inc/Module/Install.pm
SHA1 61ab1dd37e33ddbe155907ce51df8a3e56ac8bbf inc/Module/Install/AutoInstall.pm
SHA1 c04f94f91fa97b9f8cfb5a36071098ab0e6c78e3 inc/Module/Install/AutoManifest.pm
SHA1 2d0fad3bf255f8c1e7e1e34eafccc4f595603ddc inc/Module/Install/Base.pm
SHA1 f0e01fff7d73cd145fbf22331579918d4628ddb0 inc/Module/Install/Can.pm
SHA1 7328966e4fda0c8451a6d3850704da0b84ac1540 inc/Module/Install/Fetch.pm
SHA1 66d3d335a03492583a3be121a7d888f63f08412c inc/Module/Install/Include.pm
SHA1 b62ca5e2d58fa66766ccf4d64574f9e1a2250b34 inc/Module/Install/Makefile.pm
SHA1 1aa925be410bb3bfcd84a16985921f66073cc1d2 inc/Module/Install/Metadata.pm
SHA1 3b9281ddf7dd6d6f5de0a9642c69333023193c80 inc/Module/Install/Package.pm
SHA1 9de7b5129351499c048328dfa718d0eab557cf30 inc/Module/Install/TrustMetaYml.pm
SHA1 e4196994fa75e98bdfa2be0bdeeffef66de88171 inc/Module/Install/Win32.pm
SHA1 c3a6d0d5b84feb3280622e9599e86247d58b0d18 inc/Module/Install/WriteAll.pm
SHA1 26d58a041cd6b3d21db98b32e8fd1841aae21204 inc/Module/Package.pm
SHA1 8d909d81d2f98514d42f67a972a489ff624a4183 inc/Module/Package/Dist/RDF.pm
SHA1 0e0eed2e69d9583081868cf4f220068d0a018568 inc/Scalar/Util.pm
SHA1 feb933cefe2e3762e8322bd6071a2499f3440da1 inc/YAML/Tiny.pm
SHA1 8105c0510a773b56840995fb4dd2dc64fe9ddaee inc/unicore/Name.pm
SHA1 36df501c7c9b73c282c5174ed54d8283b2f2cbf2 inc/utf8.pm
SHA1 a79e5237c7496db8625412e08158526c4e075403 lib/HTML/Microformats.pm
SHA1 ce34c252e34c99b0646061e502b650e1eadd4534 lib/HTML/Microformats/Datatype.pm
SHA1 db891e319cbcb4bd986ce7b64f533cc0a124243d lib/HTML/Microformats/Datatype/DateTime.pm
SHA1 fcd129f66bbedd8954b441db60a29fed8c39b7a8 lib/HTML/Microformats/Datatype/DateTime/Parser.pm
SHA1 180e44c5486c87d2f7145d2cab0156cd7d37bdee lib/HTML/Microformats/Datatype/Duration.pm
SHA1 3346a6c7e5f0f8a205cfb2bb9652fb8254795852 lib/HTML/Microformats/Datatype/Interval.pm
SHA1 ca75541e02aafc2f11f3183e8432b52e735fd749 lib/HTML/Microformats/Datatype/RecurringDateTime.pm
SHA1 f5e6c169556fd61e5e930152e8a2b20f5388e0f9 lib/HTML/Microformats/Datatype/String.pm
SHA1 565c4dec031b39637610c301f5fbc3324574efae lib/HTML/Microformats/DocumentContext.pm
SHA1 66ac1972e4f9f27d4c6f4a3bff8af8029cf1ef1f lib/HTML/Microformats/Documentation/Notes.pod
SHA1 2eaf6c7bfd2dfdbafc3477d4e827c9e6965971f3 lib/HTML/Microformats/Format.pm
SHA1 3a9ac12a50aa6b4122c3839652d841ffdf208e5e lib/HTML/Microformats/Format/OpenURL_COinS.pm
SHA1 7120e6dac54ddccfd102a870179a7398951eb956 lib/HTML/Microformats/Format/RelEnclosure.pm
SHA1 ddea90d203740ade098acb9d3d64ac1bc4898b79 lib/HTML/Microformats/Format/RelLicense.pm
SHA1 3e80c4cd5a1ab207894c4033899b68db7a1b3161 lib/HTML/Microformats/Format/RelTag.pm
SHA1 a384869587d3008ae9ce893fedacd2ab6b1e915f lib/HTML/Microformats/Format/VoteLinks.pm
SHA1 f541246741f0b43763d28e038ff11f87dc931207 lib/HTML/Microformats/Format/XFN.pm
SHA1 0ac32c4d5c9d7005047c3cd15186b6461250e46a lib/HTML/Microformats/Format/XMDP.pm
SHA1 a51e7a4a0447160cbce8f0155a3ad61388d03884 lib/HTML/Microformats/Format/XOXO.pm
SHA1 379a2268b9a737e121f666743f4bd6a8e061f84f lib/HTML/Microformats/Format/adr.pm
SHA1 260145f93e9ce7d2b975ce5336c8729d2d5af5de lib/HTML/Microformats/Format/figure.pm
SHA1 919764b522f3806ff18e14f82ba06c11a0089a25 lib/HTML/Microformats/Format/geo.pm
SHA1 ddbd47e8b0bae0dfb0fcc5b5544861845f22dd4d lib/HTML/Microformats/Format/hAlarm.pm
SHA1 bc3890a303525515d00e61a049ea61ece7411974 lib/HTML/Microformats/Format/hAtom.pm
SHA1 8c99e553d858bb3f940e841315d93c79fd7f6e6b lib/HTML/Microformats/Format/hAudio.pm
SHA1 401abc41ae80b38332b677bf0db958a9e7bc3492 lib/HTML/Microformats/Format/hCalendar.pm
SHA1 0830a50bd9702f90cd0b4e33f91c2004f40ae310 lib/HTML/Microformats/Format/hCard.pm
SHA1 930b493805752960a70f63e4966207acf1f7ba22 lib/HTML/Microformats/Format/hCard/TypedField.pm
SHA1 506e28a53511247cff07f727805b440006b6afd0 lib/HTML/Microformats/Format/hCard/email.pm
SHA1 49a6dab2a178a20761094949c8aab4b00997ced2 lib/HTML/Microformats/Format/hCard/impp.pm
SHA1 6a3192fffc334586ee11fb1161d6b7c1ba6ad839 lib/HTML/Microformats/Format/hCard/label.pm
SHA1 ec3b14f82c4c4c80b8491299910abc3f0d3961bf lib/HTML/Microformats/Format/hCard/n.pm
SHA1 1cf34d5a0c63d7246c0fc9b41a77bab8159a5124 lib/HTML/Microformats/Format/hCard/org.pm
SHA1 851d3fda415eeaf267327f5f6a81308df56c31fb lib/HTML/Microformats/Format/hCard/tel.pm
SHA1 f09fa06f974122a7d4686f5f9949b0a4b1bc9669 lib/HTML/Microformats/Format/hEntry.pm
SHA1 b6bf8c54f19c8e0f3322ebcef27884b4e3ebba69 lib/HTML/Microformats/Format/hEvent.pm
SHA1 3c21014b9b9a4c39902622f6db025323762e567e lib/HTML/Microformats/Format/hFreebusy.pm
SHA1 f504db94f44b75bc8184e47b61f4bbeb47c42cc8 lib/HTML/Microformats/Format/hListing.pm
SHA1 490497774d5ab5d69d0892fd1385aee64f3ae560 lib/HTML/Microformats/Format/hMeasure.pm
SHA1 54d7cb07c2c23b4a4e05dfa0f12cca22ad92e2d9 lib/HTML/Microformats/Format/hNews.pm
SHA1 28e5bcd95bf79f2ee0a55f5fb27ca4ee7ab4f381 lib/HTML/Microformats/Format/hProduct.pm
SHA1 06c0eabd117fefe2aed78390aec06c81d7771619 lib/HTML/Microformats/Format/hRecipe.pm
SHA1 bbeb4f50bf2daaa269804bcd4b5088c9443e59a9 lib/HTML/Microformats/Format/hResume.pm
SHA1 2321a31283a428aa7486a1749e06aaccf98583bb lib/HTML/Microformats/Format/hReview.pm
SHA1 f4a82aa7fd0e797efc6c9be2c719ad584ce5e535 lib/HTML/Microformats/Format/hReview/rating.pm
SHA1 e243a1e865a623d2d9712548666b1978888f12a6 lib/HTML/Microformats/Format/hReviewAggregate.pm
SHA1 9880319d33508420f2b74b1ee73992d8bebf9426 lib/HTML/Microformats/Format/hTodo.pm
SHA1 80fe744a2403e5bbb5bd0f9636992e1b30f4e8aa lib/HTML/Microformats/Format/species.pm
SHA1 2ac9927788187c1b98bcac03d11dc4d9fca15352 lib/HTML/Microformats/Format_Rel.pm
SHA1 3dcc2e7893aa94184cc4929f1aab3a859710b51b lib/HTML/Microformats/Mixin/Parser.pm
SHA1 0dfbaf34aa7ad9f4b946f95c509107efa8df7b68 lib/HTML/Microformats/Mixin/RDF.pm
SHA1 d47b2d50278a7dbc33dc756abb8e9d8148234532 lib/HTML/Microformats/ObjectCache.pm
SHA1 8659e5d1561f3a861290274bdc4e32e96a2b5437 lib/HTML/Microformats/Utilities.pm
SHA1 de16d8c5dc3dee776649116bdc0aa25ebea869b8 meta/changes.ttl
SHA1 af96307b9110c326955e775d546c771a21e5631c meta/doap.ttl
SHA1 4cd667210d726b42ea6a4c9bd08cb27c9c89060d meta/makefile.ttl
SHA1 07eaa9fca95c71c84f9f28361eb11cae379ab1a3 meta/rt-bugs.ttl
SHA1 b860cbfb1804e58c949b431f70f3b18c0da4c26b t/01basic.t
SHA1 c52c3ec4f2f8a1493aa35bc2d2a3fb079e55f147 t/10hcard.t
SHA1 e0db34b707609846e4416d34c07bbf1c7c7b49d3 t/11hcalendar.t
SHA1 d04107962b8a3aedc7ea431656ae89597460bdf0 t/12hatom.t
SHA1 8573f4f7158d91bb9d366514bf5c7264415ca78f t/13xfn.t
SHA1 2fd970137bfa4a1939f16f18b80a5cab0495d9b7 t/14reltag.t
SHA1 295cd4a985e7d45467c2ac2424a2ea4e45d638e6 t/15rellicense.t
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.10 (GNU/Linux)

iEYEARECAAYFAk/2CBMACgkQzr+BKGoqfTnZFQCeIf9JPtTY3GYb05xj3+lAZIaG
wKgAoLQoFjie++fOoKkxWhcE2lgND6Je
=Xovy
-----END PGP SIGNATURE-----
HTML-Microformats-0.105/LICENSE0000644000076400007640000004374411775403736014110 0ustar  taitaiThis software is copyright (c) 2012 by Toby Inkster .

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

Terms of the Perl programming language system itself

a) the GNU General Public License as published by the Free
   Software Foundation; either version 1, or (at your option) any
   later version, or
b) the "Artistic License"

--- The GNU General Public License, Version 1, February 1989 ---

This software is Copyright (c) 2012 by Toby Inkster .

This is free software, licensed under:

  The GNU General Public License, Version 1, February 1989

                    GNU GENERAL PUBLIC LICENSE
                     Version 1, February 1989

 Copyright (C) 1989 Free Software Foundation, Inc.
 51 Franklin St, Suite 500, Boston, MA  02110-1335  USA

 Everyone is permitted to copy and distribute verbatim copies
 of this license document, but changing it is not allowed.

                            Preamble

  The license agreements of most software companies try to keep users
at the mercy of those companies.  By contrast, our General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users.  The
General Public License applies to the Free Software Foundation's
software and to any other program whose authors commit to using it.
You can use it for your programs, too.

  When we speak of free software, we are referring to freedom, not
price.  Specifically, the General Public License is designed to make
sure that you have the freedom to give away or sell copies of free
software, that you receive source code or can get it if you want it,
that you can change the software or use pieces of it in new free
programs; and that you know you can do these things.

  To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.

  For example, if you distribute copies of a such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have.  You must make sure that they, too, receive or can get the
source code.  And you must tell them their rights.

  We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.

  Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software.  If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.

  The precise terms and conditions for copying, distribution and
modification follow.

                    GNU GENERAL PUBLIC LICENSE
   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION

  0. This License Agreement applies to any program or other work which
contains a notice placed by the copyright holder saying it may be
distributed under the terms of this General Public License.  The
"Program", below, refers to any such program or work, and a "work based
on the Program" means either the Program or any work containing the
Program or a portion of it, either verbatim or with modifications.  Each
licensee is addressed as "you".

  1. You may copy and distribute verbatim copies of the Program's source
code as you receive it, in any medium, provided that you conspicuously and
appropriately publish on each copy an appropriate copyright notice and
disclaimer of warranty; keep intact all the notices that refer to this
General Public License and to the absence of any warranty; and give any
other recipients of the Program a copy of this General Public License
along with the Program.  You may charge a fee for the physical act of
transferring a copy.

  2. You may modify your copy or copies of the Program or any portion of
it, and copy and distribute such modifications under the terms of Paragraph
1 above, provided that you also do the following:

    a) cause the modified files to carry prominent notices stating that
    you changed the files and the date of any change; and

    b) cause the whole of any work that you distribute or publish, that
    in whole or in part contains the Program or any part thereof, either
    with or without modifications, to be licensed at no charge to all
    third parties under the terms of this General Public License (except
    that you may choose to grant warranty protection to some or all
    third parties, at your option).

    c) If the modified program normally reads commands interactively when
    run, you must cause it, when started running for such interactive use
    in the simplest and most usual way, to print or display an
    announcement including an appropriate copyright notice and a notice
    that there is no warranty (or else, saying that you provide a
    warranty) and that users may redistribute the program under these
    conditions, and telling the user how to view a copy of this General
    Public License.

    d) You may charge a fee for the physical act of transferring a
    copy, and you may at your option offer warranty protection in
    exchange for a fee.

Mere aggregation of another independent work with the Program (or its
derivative) on a volume of a storage or distribution medium does not bring
the other work under the scope of these terms.

  3. You may copy and distribute the Program (or a portion or derivative of
it, under Paragraph 2) in object code or executable form under the terms of
Paragraphs 1 and 2 above provided that you also do one of the following:

    a) accompany it with the complete corresponding machine-readable
    source code, which must be distributed under the terms of
    Paragraphs 1 and 2 above; or,

    b) accompany it with a written offer, valid for at least three
    years, to give any third party free (except for a nominal charge
    for the cost of distribution) a complete machine-readable copy of the
    corresponding source code, to be distributed under the terms of
    Paragraphs 1 and 2 above; or,

    c) accompany it with the information you received as to where the
    corresponding source code may be obtained.  (This alternative is
    allowed only for noncommercial distribution and only if you
    received the program in object code or executable form alone.)

Source code for a work means the preferred form of the work for making
modifications to it.  For an executable file, complete source code means
all the source code for all modules it contains; but, as a special
exception, it need not include source code for modules which are standard
libraries that accompany the operating system on which the executable
file runs, or for standard header files or definitions files that
accompany that operating system.

  4. You may not copy, modify, sublicense, distribute or transfer the
Program except as expressly provided under this General Public License.
Any attempt otherwise to copy, modify, sublicense, distribute or transfer
the Program is void, and will automatically terminate your rights to use
the Program under this License.  However, parties who have received
copies, or rights to use copies, from you under this General Public
License will not have their licenses terminated so long as such parties
remain in full compliance.

  5. By copying, distributing or modifying the Program (or any work based
on the Program) you indicate your acceptance of this license to do so,
and all its terms and conditions.

  6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the original
licensor to copy, distribute or modify the Program subject to these
terms and conditions.  You may not impose any further restrictions on the
recipients' exercise of the rights granted herein.

  7. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time.  Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.

Each version is given a distinguishing version number.  If the Program
specifies a version number of the license which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation.  If the Program does not specify a version number of
the license, you may choose any version ever published by the Free Software
Foundation.

  8. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission.  For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this.  Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.

                            NO WARRANTY

  9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.

  10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.

                     END OF TERMS AND CONDITIONS

        Appendix: How to Apply These Terms to Your New Programs

  If you develop a new program, and you want it to be of the greatest
possible use to humanity, the best way to achieve this is to make it
free software which everyone can redistribute and change under these
terms.

  To do so, attach the following notices to the program.  It is safest to
attach them to the start of each source file to most effectively convey
the exclusion of warranty; and each file should have at least the
"copyright" line and a pointer to where the full notice is found.

    
    Copyright (C) 19yy  

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 1, or (at your option)
    any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA  02110-1301 USA


Also add information on how to contact you by electronic and paper mail.

If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:

    Gnomovision version 69, Copyright (C) 19xx name of author
    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
    This is free software, and you are welcome to redistribute it
    under certain conditions; type `show c' for details.

The hypothetical commands `show w' and `show c' should show the
appropriate parts of the General Public License.  Of course, the
commands you use may be called something other than `show w' and `show
c'; they could even be mouse-clicks or menu items--whatever suits your
program.

You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary.  Here a sample; alter the names:

  Yoyodyne, Inc., hereby disclaims all copyright interest in the
  program `Gnomovision' (a program to direct compilers to make passes
  at assemblers) written by James Hacker.

  , 1 April 1989
  Ty Coon, President of Vice

That's all there is to it!


--- The Artistic License 1.0 ---

This software is Copyright (c) 2012 by Toby Inkster .

This is free software, licensed under:

  The Artistic License 1.0

The Artistic License

Preamble

The intent of this document is to state the conditions under which a Package
may be copied, such that the Copyright Holder maintains some semblance of
artistic control over the development of the package, while giving the users of
the package the right to use and distribute the Package in a more-or-less
customary fashion, plus the right to make reasonable modifications.

Definitions:

  - "Package" refers to the collection of files distributed by the Copyright
    Holder, and derivatives of that collection of files created through
    textual modification. 
  - "Standard Version" refers to such a Package if it has not been modified,
    or has been modified in accordance with the wishes of the Copyright
    Holder. 
  - "Copyright Holder" is whoever is named in the copyright or copyrights for
    the package. 
  - "You" is you, if you're thinking about copying or distributing this Package.
  - "Reasonable copying fee" is whatever you can justify on the basis of media
    cost, duplication charges, time of people involved, and so on. (You will
    not be required to justify it to the Copyright Holder, but only to the
    computing community at large as a market that must bear the fee.) 
  - "Freely Available" means that no fee is charged for the item itself, though
    there may be fees involved in handling the item. It also means that
    recipients of the item may redistribute it under the same conditions they
    received it. 

1. You may make and give away verbatim copies of the source form of the
Standard Version of this Package without restriction, provided that you
duplicate all of the original copyright notices and associated disclaimers.

2. You may apply bug fixes, portability fixes and other modifications derived
from the Public Domain or from the Copyright Holder. A Package modified in such
a way shall still be considered the Standard Version.

3. You may otherwise modify your copy of this Package in any way, provided that
you insert a prominent notice in each changed file stating how and when you
changed that file, and provided that you do at least ONE of the following:

  a) place your modifications in the Public Domain or otherwise make them
     Freely Available, such as by posting said modifications to Usenet or an
     equivalent medium, or placing the modifications on a major archive site
     such as ftp.uu.net, or by allowing the Copyright Holder to include your
     modifications in the Standard Version of the Package.

  b) use the modified Package only within your corporation or organization.

  c) rename any non-standard executables so the names do not conflict with
     standard executables, which must also be provided, and provide a separate
     manual page for each non-standard executable that clearly documents how it
     differs from the Standard Version.

  d) make other distribution arrangements with the Copyright Holder.

4. You may distribute the programs of this Package in object code or executable
form, provided that you do at least ONE of the following:

  a) distribute a Standard Version of the executables and library files,
     together with instructions (in the manual page or equivalent) on where to
     get the Standard Version.

  b) accompany the distribution with the machine-readable source of the Package
     with your modifications.

  c) accompany any non-standard executables with their corresponding Standard
     Version executables, giving the non-standard executables non-standard
     names, and clearly documenting the differences in manual pages (or
     equivalent), together with instructions on where to get the Standard
     Version.

  d) make other distribution arrangements with the Copyright Holder.

5. You may charge a reasonable copying fee for any distribution of this
Package.  You may charge any fee you choose for support of this Package. You
may not charge a fee for this Package itself. However, you may distribute this
Package in aggregate with other (possibly commercial) programs as part of a
larger (possibly commercial) software distribution provided that you do not
advertise this Package as a product of your own.

6. The scripts and library files supplied as input to or produced as output
from the programs of this Package do not automatically fall under the copyright
of this Package, but belong to whomever generated them, and may be sold
commercially, and may be aggregated with this Package.

7. C or perl subroutines supplied by you and linked into this Package shall not
be considered part of this Package.

8. The name of the Copyright Holder may not be used to endorse or promote
products derived from this software without specific prior written permission.

9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE.

The End

HTML-Microformats-0.105/examples/0000755000076400007640000000000011775404022014672 5ustar  taitaiHTML-Microformats-0.105/examples/misc/0000755000076400007640000000000011775404022015625 5ustar  taitaiHTML-Microformats-0.105/examples/misc/exampleA.pl0000755000076400007640000000124211663405777017736 0ustar  taitai#!/usr/bin/perl

use lib "lib";
use HTML::Microformats;
use LWP::Simple qw[get];
use RDF::TrineShortcuts;

print "## " . JSON::to_json([HTML::Microformats->formats]) . "\n";

my $uri  = 'http://microformats.org/profile/hcard';
my $html = get($uri);
my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

my @xmdp_objects = $doc->objects('XMDP');

 foreach my $xo (@xmdp_objects)
 {
   print $xo->serialise_model(
       as         => 'Turtle',
       namespaces => {
           rdfs  => 'http://www.w3.org/2000/01/rdf-schema#',
           hcard => 'http://microformats.org/profile/hcard#',
           },
       );
   print "########\n\n";
 }

HTML-Microformats-0.105/examples/misc/example6.pl0000755000076400007640000000542011663405777017725 0ustar  taitai#!/usr/bin/perl

# Tests date patterns

use strict;
use lib "lib";
use HTML::Microformats;

# Uses VTODO for components which are *supposed* to fail.

my $html = <
		2001-02-03T01:02:03+0100
		basic
	
    
	
    
		 3 Feb
		value-title
	
    
	
    
		   3 Feb
		value-title with space
	
    
	
    
		
			2001-02-03
			01:02:03
			+0100
		
		splitting things up
	
    
	
    
		
			+0100
			01:02:03
			2001-02-03
		
		mixing them up
	
    
	
    
		
			Z
			01:02:03
			2001-02-03
		
		testing 'Z' timezone
	
    
	
    
		
			+0100
			1am
			2001-02-03
		
		test 1am
	
    
	
    
		
			+0100
			1 pm
			2001-02-03
		
		test 1pm
	
    
	
    
		
			+0100
			01.02 p.  M.
			2001-02-03
		
		test 01.02 p.M.
	
    
	
    
		
			+0100
			01.02.03 p.M.
			2001-02-03
		
		test 01.02.03 p.M.
	
    
	
    
		
			+0100
			01.02.03 p.M.
			2001-02-03
		
		
			1.7.3 pm
		
		dtend feedthrough from dtstart (with 'value')
	
    
	
    
		
			+0100
			01.02.03 p.M.
			2001-02-03
		
		13:07:03
		dtend feedthrough from dtstart (no 'value')
	
    
	
    
		XXX  3 Feb
		invalid value-title
	
    

HTML

my $doc    = HTML::Microformats->new_document($html, 'http://example.net/');
$doc->assume_profile('hCalendar');
print $doc->json(pretty=>1,canonical=>1)."\n";

HTML-Microformats-0.105/examples/misc/example9.pl0000755000076400007640000000112311663405777017724 0ustar  taitai#!/usr/bin/perl

use lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use LWP::Simple qw(get);
use Data::Dumper;
use RDF::TrineShortcuts;

my $uri  = 'http://example.com/foo';
my $html = <
	
    rel
    
	
    
		
    Blah blah...
    
		
    
			
    foo
    
			
    Foo blah...
    
			
    bar
    
			
    Bar blah...
		
    
	
    


HTML
utf8::upgrade($html);

my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

print $doc->json(pretty=>1, convert_blessed=>1);
print rdf_string($doc->model, 'rdfxml');
HTML-Microformats-0.105/examples/misc/example4.pl0000755000076400007640000000220111663405777017715 0ustar  taitaiuse 5.010;
use lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use Data::Dumper;
use RDF::TrineShortcuts;

my $html = <
	
    Foo
    
	
    London, UK (12.34,56.78).
    
	
    Foo bar.
    
	
    Eve
    
	
	2010-03-01T15:00:00+0000
	
HTML

my $doc  = HTML::Microformats->new_document($html, 'http://example.net/')->assume_all_profiles;
my @news = $doc->objects('hNews');

say $news[0]->get_summary;
$news[0]->set_summary('Bar foo.');
$news[0]->set_updated('2010-03-02T16:00:00+0000', '2010-03-03T16:00:00+0000');
$news[0]->add_updated('2010-03-04T16:00:00+0000', '2010-03-05T16:00:00+0000');
$news[0]->set_link('http://example.com/');
say $news[0]->get_author->[0]->get_nickname->[0];
print to_json($news[0]->data, {pretty=>1,canonical=>1,convert_blessed=>1});

#print $doc->json(pretty=>1,canonical=>1)."\n";
#print rdf_string($doc->model, 'rdfxml')."\n";
#print Dumper($doc);
HTML-Microformats-0.105/examples/misc/exampleC.pl0000755000076400007640000000154311663405777017744 0ustar  taitai	use HTML::Microformats;
	use LWP::Simple qw[get];
	use RDF::Query;
	
	my $page  = 'http://twitter.com/t' || 'http://tantek.com/';
	my $graph = HTML::Microformats
	               ->new_document(get($page), $page)
	               ->assume_all_profiles
	               ->parse_microformats
	               ->model;
	
	my $query = RDF::Query->new(<
	SELECT DISTINCT ?friendname ?friendpage
	WHERE {
		<$page> ?p ?friendpage .
		?person foaf:name ?friendname ;
			foaf:page ?friendpage .
		FILTER (
			isURI(?friendpage)
			&& isLiteral(?friendname) 
			&& regex(str(?p), "^http://vocab.sindice.com/xfn#(.+)-hyperlink")
		)
	}
SPARQL
	
	my $results = $query->execute($graph);
	while (my $result = $results->next)
	{
		printf("%s <%s>\n",
			$result->{friendname}->literal_value,
			$result->{friendpage}->uri,
			);
	}
HTML-Microformats-0.105/examples/misc/example1.pl0000755000076400007640000000172511663405777017724 0ustar  taitaiuse lib "lib";
use HTML::Microformats::Format::adr;
use HTML::Microformats::_context;
use HTML::HTML5::Parser;
use strict;
use Data::Dumper;
use RDF::TrineShortcuts;

my $html = <
	Foo
	Bar
	Foobar
	
	
    
		
    
			intl:
			France
			
				My crazy Earth co-ordinates
				12.34,56.78
			
		
    
	
    
	

HTML

my $parser = HTML::HTML5::Parser->new;
my $dom    = $parser->parse_string($html);

my $ctx    = HTML::Microformats::_context->new($dom, 'http://example.net/');

my @adrs = HTML::Microformats::Format::adr->extract_all($dom, $ctx);

my $model = rdf_parse;

foreach my $a (@adrs)
{
	$a->add_to_model($model);
	print Dumper($a->data);
}

print rdf_string($model, 'rdfxml');
HTML-Microformats-0.105/examples/misc/example7.pl0000755000076400007640000000074411663405777017732 0ustar  taitai#!/usr/bin/perl

use lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use LWP::Simple qw(get);
use Data::Dumper;
use RDF::TrineShortcuts;

my $uri  = 'http://csarven.ca/cv';
my $html = get($uri);
utf8::upgrade($html);

my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

my @resumes = $doc->objects('hResume');
my $resume  = $resumes[0];

# print to_json($resume, {pretty=>1, convert_blessed=>1});
print rdf_string($resume->model, 'rdfxml');
HTML-Microformats-0.105/examples/misc/example8.pl0000755000076400007640000000603011663405777017725 0ustar  taitai#!/usr/bin/perl

use lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use LWP::Simple qw(get);
use Data::Dumper;
use RDF::TrineShortcuts;

my $uri  = 'http://example.com/chips';
my $html = <
  
  • item 1
    
    
      
    description
    
        
    This item represents the main point we're trying to make.
    
    
    
    
  
    • 



    
    
    Pommes Frites
    
    
    
        Pommes frites originate in outer space. They are served hot.
    
        This recipe is only an example. Don't try this at home!
    
    
    
    
        Contributed by CJ Tom and the
        Cooky Gang.
    
    
     
    Published  14. Oct 2008
    
    Pommes Frites
    
    Ingredients
    
    
      
        
    • 
            500 gramme potatoes, hard cooking.
        
      • 
        
    • 
            1 spoonful of salt
        
      • 
        
    • 
            You may want to provide some 
            Ketchup and Mayonnaise
            as well.
        
      • 
    
    
    
    Instructions
    
    
      
        
    • First wash the potatoes.
      • 
        
    • Then slice and dice them and put them in boiling fat.
      • 
        
    • After a few minutes take them out again.
      • 
    
    
    
    Further details
    
    
    Enough for 12 children.
    
    
    Preparation time is approximately 
         90 min
    
    
    
    Add half an hour to prepare your homemade Ketchup.
    
    
    This recipe is  and .
    
    
    
        
        Pommes Frites have more than 
        1000 Joules Energy, 
        while Ketchup and Mayonnaise have 
        0 vitamins.
    
    

    

	
    
                
    
                        intl:
                        France
                        
                                12.34,   56.78
                        
                
    
        
    


HTML
utf8::upgrade($html);

my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

print $doc->json(pretty=>1, convert_blessed=>1);
print rdf_string($doc->model, 'rdfxml');
HTML-Microformats-0.105/examples/misc/example3.pl0000755000076400007640000000502111663405777017717 0ustar  taitaiuse lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use Data::Dumper;
use RDF::TrineShortcuts;

my $html = <
	License 4.0
	
    
		Joe Bloggs (male)
		Anniversary: 
		Joe Bloggs
		joe
		
    
			Home
			isdn
			+441234
			567
			890
		
    
			cell 07005 123 456
		
    Test Company
		
    
			intl:
			France
			
				12.34,   56.78
			
		
    
		
    
			007
			foo
			
			British
			
		
    
		
		
			Homo
			sapiens
			sapiens
		
	
    

	Alice

	
    
	Eve

	
    1.84 m height
	Tall Thing
    

	Picture of Enc


  
    
    
    My Org
    
    
    
      General Enquiries:
      01234 567 890
    
    
    
    
      
        
        Help Desk
      
      01234 567 899
    
    
  
    

HTML

my $doc    = HTML::Microformats->new_document($html, 'http://example.net/');
$doc->assume_all_profiles;

$doc->objects('hCard')->[0]->get_agent->[0]->set_fn('James Bond');

print $doc->json(pretty=>1,canonical=>1)."\n";

print rdf_string($doc->model, 'rdfxml')."\n";

#print Dumper($doc);
HTML-Microformats-0.105/examples/misc/exampleD.pl0000755000076400007640000000064311663405777017745 0ustar  taitaiuse 5.010;
use lib "lib";
use HTML::Microformats;
use strict;
use JSON;
use Data::Dumper;
use RDF::TrineShortcuts;

my $html = <foo1
foo2
foo3
bar1
HTML

my $doc = HTML::Microformats->new_document($html, 'http://example.net/')->assume_all_profiles;
print rdf_string($doc->model => 'rdfxml');
HTML-Microformats-0.105/examples/misc/example2.pl0000755000076400007640000000423411663405777017723 0ustar  taitaiuse lib "lib";
use HTML::Microformats;
use RDF::TrineShortcuts;
use strict;

my $html = <<'HTML';
	
	
    
		Joe Bloggs
		Anniversary: 
		Joe Bloggs
		
    
			Home
			isdn
			tel:+441234
			567
			890
		
    Test Company
    
		
    Tel.: 819 623-4310 p.5451
    
		
    819 623-4310 p.5452
    
		
    
			intl:
			France
			
				
				12.34,   56.78
			
		
    
		
    
			007
		
    
	
    


    
  
  
    
    
    of Albert Einstein by
    
      Paul Ehrenfest
      (photographer)
    
  
    

    


    
 
  Olá! Meu nome é Celso
    Fontes 
  
    
  Meu email é: 

    

HTML

my $doc  = HTML::Microformats->new_document($html, 'http://example.net/');
$doc->assume_all_profiles;
print $doc->json(pretty=>1, convert_blessed=>1);
print rdf_string($doc->model, 'rdfxml');

foreach my $hcard ($doc->objects('hCard'))
{
	print "# ---\n";
	print $hcard->to_vcard;
	print "# -\n";
	print $hcard->to_vcard4;
	print "# -\n";
	print $hcard->to_vcard4_xml;
}

foreach my $g ($doc->objects('geo'))
{
	print "# ---\n";
	print $g->to_kml;
}
HTML-Microformats-0.105/examples/misc/exampleB.pl0000755000076400007640000000062311663405777017741 0ustar  taitai	use HTML::Microformats;
	use LWP::Simple qw[get];
	
	my $page     = 'http://tantek.com/';
	my @xfn_objs = HTML::Microformats
	               ->new_document(get($page), $page)
	               ->assume_all_profiles
	               ->parse_microformats
	               ->objects('XFN');
	
	while (my $xfn = shift @xfn_objs)
	{
		printf("%s <%s>\n",
			$xfn->data->{title},
			$xfn->data->{href},
			);
	}
HTML-Microformats-0.105/examples/misc/example5.pl0000755000076400007640000000515411663405777017730 0ustar  taitaiuse lib "lib";
use lib "../XML-Atom-FromOWL/lib";
use HTML::Microformats;
use strict;
use JSON;
use Data::Dumper;
use RDF::TrineShortcuts;
use XML::Atom::FromOWL;

my $html = <
		2001-02-03
		3 Feb 2001
	
	
    
		
    Foo
    
		
    London, UK (12.34,56.78).
    
		
    Foo bar.
    
		
    Eve
    
		
		2010-03-01T15:00:00+0000
		I don't like Evil.
	
    
	
    
		
    
			2010-02-03
			3 Feb 2010
			
				Yearly,
				every 10000 years.
			
			freq=daily;interval=365220
			1;2
			PT24H
			
				Toby Inkster
				true
			
		
    
		
    
			
				free
				2001-01-01/P6M
				2002-01-01 182
			
			freetime
		
    
		
      
			
    • Do this
      • 
			
    • Do that
				
        
					
      1. Do that: part 1
        2. 
					
      2. Do that: part 2 p
        3. 
				
      
			
      • 
		
    
		
    
			
				13:00:00
				2008-02-01
				+0100
			
			
				15:00:00
			
		
    
	
    
HTML

my $doc    = HTML::Microformats->new_document($html, 'http://example.net/');
$doc->assume_all_profiles;

foreach ($doc->objects('hAtom'))
{
	print "=======================================================\n";
	print to_json($_->data, {pretty=>1,canonical=>1,convert_blessed=>1});
	print "-------------------------------------------------------\n";
	print to_json(from_json($_->serialise_model(as => 'RDF/JSON')), {pretty=>1,canonical=>1,convert_blessed=>1});
	print "-------------------------------------------------------\n";
	print $_->to_atom;
}

print "=======================================================\n";
print $doc->serialise_model(as => 'RDF/XML');
HTML-Microformats-0.105/examples/microformats-to-rdf.pl0000755000076400007640000000045011667507335021142 0ustar  taitai#!/usr/bin/perl

use 5.010;
use strict;

use HTML::Microformats;
use LWP::Simple qw(get);

my $uri  = shift @ARGV or die "Please provide URI\n";
my $html = get($uri);
my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

say $doc->serialise_model(as => 'turtle');
HTML-Microformats-0.105/examples/microformats-to-json.pl0000755000076400007640000000045211667507316021341 0ustar  taitai#!/usr/bin/perl

use 5.010;
use strict;

use HTML::Microformats;
use LWP::Simple qw(get);

my $uri  = shift @ARGV or die "Please provide URI\n";
my $html = get($uri);
my $doc  = HTML::Microformats->new_document($html, $uri);
$doc->assume_all_profiles;

say $doc->json(pretty => 1, canonical => 1);
HTML-Microformats-0.105/Makefile.PL0000644000076400007640000000004511775377773015053 0ustar  taitaiuse inc::Module::Package 'RDF 0.008'
HTML-Microformats-0.105/meta/0000755000076400007640000000000011775404022014002 5ustar  taitaiHTML-Microformats-0.105/meta/makefile.ttl0000644000076400007640000000217611775401605016316 0ustar  taitai# This file provides instructions for packaging.

@prefix :  .


	:perl_version_from _:main ;
	:version_from _:main ;
	:readme_from _:main ;
	:requires "CGI 0";
	:requires "CGI::Util 0";
	:requires "DateTime 0";
	:requires "DateTime::Duration 0";
	:requires "DateTime::Format::Builder 0";
	:requires "DateTime::Format::Natural 0";
	:requires "DateTime::Format::Strptime 0";
	:requires "DateTime::Span 0";
	:requires "HTML::HTML5::Parser 0.200";
	:requires "HTML::HTML5::Sanity 0.100";
	:requires "HTTP::Date 0";
	:requires "JSON 2.00";
	:requires "Locale::Country 0";
	:requires "Module::Pluggable 0";
	:requires "Object::AUTHORITY 0";
	:requires "RDF::Trine 0.135";
	:requires "XML::LibXML 1.60";
	:requires "URI 1.30";
	:requires "URI::URL 0";
	:test_requires "Test::More 0.61" ;
	:recommends "RDF::iCalendar::Exporter 0.002";
	:recommends "RDF::KML::Exporter 0";
	:recommends "RDF::vCard::Exporter 0.006";
	:recommends "XML::Atom::FromOWL 0".

_:main  "lib/HTML/Microformats.pm" .

HTML-Microformats-0.105/meta/doap.ttl0000644000076400007640000000334411667511614015464 0ustar  taitai@prefix :         .
@prefix dcs:      .
@prefix dc:       .
@prefix foaf:     .
@prefix my:       .
@prefix rdfs:     .
@prefix toby:     .
@prefix xsd:      .

my:project
	a               :Project ;
	:name           "HTML-Microformats" ;
	:shortdesc      "parse microformats in HTML"@en ;
	:programming-language  "Perl" ;
	:homepage        ;
	:download-page   ;
	rdfs:seeAlso     ;
	:bug-database    ;
	:repository     [ a :HgRepository ; :browse  ] ;
	:maintainer     toby:i ;
	:developer      toby:i ;
	:documenter     toby:i ;
	:tester         toby:i ;
	:created        "2010-02-08"^^xsd:date ;
	:license         ;
	:category
		[rdfs:label "XHTML"],
		[rdfs:label "HTML"], 
		[rdfs:label "Semantic Web"],
		[rdfs:label "Microformats"],
		[rdfs:label "POSH"],
		[rdfs:label "RDF"],
		[rdfs:label "JSON"],
		[rdfs:label "vCard"],
		[rdfs:label "iCalendar"],
		[rdfs:label "Atom"].

toby:i
	a               foaf:Person ;
	foaf:name       "Toby Inkster" ;
	foaf:homepage    ;
	foaf:page        ;
	foaf:mbox        ;
	  .
HTML-Microformats-0.105/meta/rt-bugs.ttl0000644000076400007640000000414711775377214016134 0ustar  taitai@prefix dbug:  .
@prefix dc:  .
@prefix doap:  .
@prefix foaf:  .
@prefix prio:  .
@prefix rdfs:  .
@prefix rt:  .
@prefix status:  .
@prefix xsd:  .

_:r1341521548r0 a foaf:Agent ;
	foaf:mbox  .
_:r1341521548r1 a foaf:Agent ;
	foaf:nick "TOBYINK" .
_:r1341521548r2 a foaf:Agent ;
	foaf:mbox  .
_:r1341521548r3 a foaf:Agent ;
	foaf:mbox  .
 dbug:issue , ,  .
 dbug:assignee _:r1341521548r1 ;
	dbug:id "72967"^^xsd:string ;
	dbug:page  ;
	dbug:reporter _:r1341521548r0 ;
	dbug:status status:resolved ;
	dc:created "2011-12-05T13:18:59"^^xsd:dateTime ;
	dc:modified "2011-12-07T06:53:18"^^xsd:dateTime ;
	a dbug:Issue ;
	rdfs:label "needs update, remove sig check, etc" .
 dbug:assignee _:r1341521548r1 ;
	dbug:id "73336"^^xsd:string ;
	dbug:page  ;
	dbug:reporter _:r1341521548r2 ;
	dbug:status status:resolved ;
	dc:created "2011-12-17T22:29:24"^^xsd:dateTime ;
	dc:modified "2012-07-05T21:21:48"^^xsd:dateTime ;
	a dbug:Issue ;
	rdfs:label "[PATCH] pod errors" .
 dbug:assignee _:r1341521548r1 ;
	dbug:id "76623"^^xsd:string ;
	dbug:page  ;
	dbug:reporter _:r1341521548r3 ;
	dbug:status status:resolved ;
	dc:created "2012-04-17T11:46:35"^^xsd:dateTime ;
	dc:modified "2012-07-05T21:28:38"^^xsd:dateTime ;
	a dbug:Issue ;
	rdfs:label "Wrong URL reference" .
HTML-Microformats-0.105/meta/changes.ttl0000644000076400007640000003222711775401412016145 0ustar  taitai@prefix :         .
@prefix dcs:      .
@prefix dc:       .
@prefix foaf:     .
@prefix my:       .
@prefix rdfs:     .
@prefix toby:     .
@prefix xsd:      .

my:project :release my:v_0-00_00.
my:v_0-00_00
	a               :Version ;
	dc:issued       "2010-02-19"^^xsd:date ;
	:revision       "0.00_00"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Original version, forked from Swignition. Supports hCard, adr, geo and rel-tag."@en .

my:project :release my:v_0-00_01.
my:v_0-00_01
	a               :Version ;
	dc:issued       "2010-02-24"^^xsd:date ;
	:revision       "0.00_01"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds XFN, species and hMeasure."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_00 ;
		dcs:item
			[ rdfs:label "Figure out which hCard on a page is the 'representative' one (for the purposes of XFN)."@en ; a dcs:Addition ] ,
			[ rdfs:label "XFN support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Copyright statements now reflect the fact that much of this code comes from 2008."@en ] ,
			[ rdfs:label "Draft 'species' microformat support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Improve hCard type+value property parsing."@en ] ,
			[ rdfs:label "Draft 'hMeasure' microformat support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Document HTML::Microformats::hCard."@en ]
	] .

my:project :release my:v_0-00_02.
my:v_0-00_02
	a               :Version ;
	dc:issued       "2010-03-01"^^xsd:date ;
	:revision       "0.00_02"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds rel-license, rel-enclosure, hAtom and hNews."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_01 ;
		dcs:item
			[ rdfs:label "Split out some common rel-X parsing into HTML::Microformats::_rel."@en ] ,
			[ rdfs:label "rel-license support."@en ; a dcs:Addition ] ,
			[ rdfs:label "rel-enclosure support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Support for hAtom and hNews."@en ; a dcs:Addition ] ,
			[ rdfs:label "Document geo, adr, XFN and hAtom support."@en ] 
	] .

my:project :release my:v_0-00_03.
my:v_0-00_03
	a               :Version ;
	dc:issued       "2010-03-09"^^xsd:date ;
	:revision       "0.00_03"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds hCalendar."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_02 ;
		dcs:item
			[ rdfs:label "Rename _base.pm to BASE.pm; _simple_parser.pm to Mixin/Parser.pm; _simple_rdf.pm to Mixin/RDF.pm; _rel.pm to BASEREL.pm."@en ] ,
			[ rdfs:label "hCalendar support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Document BASE microformat class."@en ] ,
			[ rdfs:label "RecurringDateTime datatype."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-00_04.
my:v_0-00_04
	a               :Version ;
	dc:issued       "2010-03-20"^^xsd:date ;
	:revision       "0.00_04"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds hResume, hReview and xFolk."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_03 ;
		dcs:item
			[ rdfs:label "Problems parsing hCard org properties resolved."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "hMeasure.pm wasn't inheriting properly from BASE.pm."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "Implement class=value-title support."@en ; a dcs:Addition ] ,
			[ rdfs:label "Implement implied date for hCalendar dtend and hAtom updated properties."@en ; a dcs:Addition ] ,
			[ rdfs:label "Improvements in natural language date parsing."@en ] ,
			[ rdfs:label "UTF8 fixes."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "hResume support."@en ; a dcs:Addition ] ,
			[ rdfs:label "hReview and xFolk support."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-00_05.
my:v_0-00_05
	a               :Version ;
	dc:issued       "2010-04-16"^^xsd:date ;
	:revision       "0.00_05"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds hAudio, hReview-aggregate, hListing and hProduct."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_04 ;
		dcs:item
			[ rdfs:label "hAudio support."@en ; a dcs:Addition ] ,
			[ rdfs:label "hReview-aggregate support."@en ; a dcs:Addition ] ,
			[ rdfs:label "hListing support."@en ; a dcs:Addition ] ,
			[ rdfs:label "hProduct support."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-00_06.
my:v_0-00_06
	a               :Version ;
	dc:issued       "2010-04-16"^^xsd:date ;
	:revision       "0.00_06"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-00_05 ;
		dcs:item
			[ rdfs:label "Packaging fix."@en ; a dcs:Bugfix ]
	] .

my:project :release my:v_0-00_07.
my:v_0-00_07
	a               :Version ;
	dc:issued       "2010-04-28"^^xsd:date ;
	:revision       "0.00_07"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-00_06 ;
		dcs:item
			[ rdfs:label "Support http://microformats.org/profile/specs profile URI."@en ; a dcs:Update ] ,
			[ rdfs:label "our @HTML::Microformats::Formats instead of 'my'."@en ]
	] .

my:project :release my:v_0-00_08.
my:v_0-00_08
	a               :Version ;
	dc:issued       "2010-04-29"^^xsd:date ;
	:revision       "0.00_08"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		rdfs:comment "These changes are for the benefit of XML-Atom-Microformats."@en ;
		dcs:versus my:v_0-00_07 ;
		dcs:item
			[ rdfs:label "Introduce a context-unique component to blank node identifiers."@en ; rdfs:comment "This means that two runs of HTML::Microformats will result in different identifiers."@en ] ,
			[ rdfs:label "Distinguish between base URI and document/context URI."@en ]
	] .

my:project :release my:v_0-00_09.
my:v_0-00_09
	a               :Version ;
	dc:issued       "2010-05-12" ;
	:revision       "0.00_09"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds XOXO, OpenURL COinS and figure."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_08 ;
		dcs:item
			[ rdfs:label "XOXO support."@en ; a dcs:Addition ] ,
			[ rdfs:label "OpenURL COinS support."@en ; rdfs:comment "Not technically a microformat."@en ; a dcs:Addition ] ,
			[ rdfs:label "figure support."@en ; a dcs:Addition ] ,
			[ rdfs:label "adr RDF output now better differentiates between the addresses and the places they represent."@en ] ,
			[ rdfs:label "Document the rel-* microformat implementations and OpenURL COinS."@en ] ,
			[ rdfs:label "Document the ISO8601 datetime parser."@en ]
	] .

my:project :release my:v_0-00_10.
my:v_0-00_10
	a               :Version ;
	dc:issued       "2010-05-13" ;
	:revision       "0.00_10"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-00_09 ;
		dcs:item
			[ rdfs:label "Packaging fix - include figure.pm in the distribution."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "Document hCard helper modules."@en ]
	] .

my:project :release my:v_0-00_11.
my:v_0-00_11
	a               :Version ;
	dc:issued       "2010-06-23" ;
	:revision       "0.00_11"^^xsd:string ;
	:file-release    ;
	rdfs:comment    "Adds XMDP and VoteLinks."@en ;
	dcs:changeset [
		dcs:versus my:v_0-00_10 ;
		dcs:item
			[ rdfs:label "Improve calculation of representative hCard."@en ] ,
			[ rdfs:label "Support for VoteLinks microformat, including special support for VoteLinks inside hAtom entries."@en ; a dcs:Addition ] ,
			[ rdfs:label "Find contact hCard for a page - i.e. an hCard in an 
     element."@en ; a dcs:Addition ] ,
			[ rdfs:label "Support XMDP."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-00_12.
my:v_0-00_12
	a               :Version ;
	dc:issued       "2010-06-25" ;
	:revision       "0.00_12"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
			dcs:versus my:v_0-00_11 ;
			dcs:item
				[ rdfs:label "VoteLinks.pm wasn't included in the 0.00_11 distribution."@en ; a dcs:Bugfix ]
		] .

my:project :release my:v_0-00_13.
my:v_0-00_13
	a               :Version ;
	dc:issued       "2010-10-18" ;
	:revision       "0.00_13"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-00_12 ;
		dcs:item
			[ rdfs:label "Minor bugfixes, cleanups and documentation improvements."@en ] ,
			[ rdfs:label "Add serialise_model method to HTML::Microformats and HTML::Microformats::BASE."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-100.
my:v_0-100
	a               :Version ;
	dc:issued       "2010-12-16" ;
	:revision       "0.100"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-00_13 ;
		dcs:item
			[ rdfs:label "Rename loads of modules - in fact every module except the mixins and HTML::Microformats itself."@en ] ,
			[ rdfs:label "Avoid UNIVERSAL::can and UNIVERSAL::isa."@en ] ,
			[ rdfs:label "HTML::Microformats->formats and HTML::Microformats->modules. (use Module::Pluggable)"@en ; a dcs:Addition ] ,
			[ rdfs:label "Lots of test cases."@en ; a dcs:Addition ] ,
			[ rdfs:label "Handle dates like 1pm - i.e with am/pm designator but without minutes."@en ; a dcs:Bugfix ]
	] .

my:project :release my:v_0-101.
my:v_0-101
	a               :Version ;
	dc:issued       "2010-12-22" ;
	:revision       "0.101"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-100 ;
		dcs:item
			[ rdfs:label "Stop printing warnings about DESTROY method not being defined."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "Don't assume each rel=me link refers to a different 'me'!"@en ; a dcs:Bugfix  ]
	] .

my:project :release my:v_0-102.
my:v_0-102
	a               :Version ;
	dc:issued       "2011-02-05" ;
	:revision       "0.102"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-101 ;
		dcs:item
			[ rdfs:label "Deprecated set_X/add_X/clear_X property accessors for microformat objects."@en ] ,
			[ rdfs:label "Include awol:Person, awol:name, awol:email and awol:uri in RDF output for hAtom entries."@en ] ,
			[ rdfs:label "Prefer to parse tel and email in hCard as URLs."@en ] ,
			[ rdfs:label "Provide hEntry output using RDF iCalendar vocabulary, as a ical:Vjournal."@en ] ,
			[ rdfs:label "Export hCards in vCard 3.0 format."@en ; a dcs:Addition ] ,
			[ rdfs:label "Export hCards in vCard 4.0 format."@en ; a dcs:Addition ] ,
			[ rdfs:label "Export hCards in vCard XML format."@en ; a dcs:Addition ] ,
			[ rdfs:label "Export hAtom as Atom feeds."@en ; a dcs:Addition ] ,
			[ rdfs:label "Export geo in KML format."@en ; a dcs:Addition ] ,
			[ rdfs:label "Export hCalendar in iCalendar format."@en ; a dcs:Addition ]
	] .

my:project :release my:v_0-103.
my:v_0-103
	a               :Version ;
	dc:issued       "2011-02-16" ;
	:revision       "0.103"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-102 ;
		dcs:item
			[ rdfs:label "hCalendar attachments."@en ; a dcs:Bugfix ] ,
			[ rdfs:label "Profile management."@en ; a dcs:Bugfix ]
	] .

my:project :release my:v_0-104.
my:v_0-104
	a               :Version ;
	dc:issued       "2011-12-06" ;
	:revision       "0.104"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-103 ;
		dcs:item
			[ rdfs:label "Module::Package::RDF"@en ; a dcs:Packaging ] ,
			[ rdfs:label "Include some examples."@en ; a dcs:Packaging ] ,
			[ rdfs:label "use Object::AUTHORITY"@en ; a dcs:Update ] ,
			[ rdfs:label "use 5.010"@en ; a dcs:Update ]
	] .

my:project :release my:v_0-105.
my:v_0-105
	a               :Version ;
	dc:issued       "2012-07-05" ;
	:revision       "0.105"^^xsd:string ;
	:file-release    ;
	dcs:changeset [
		dcs:versus my:v_0-104 ;
		dcs:item   [ rdfs:label "Drop common::sense dependency."@en ];
		dcs:item   [ rdfs:label "Fix link to ocoins.info."@en ; a dcs:Bugfix, dcs:Documentation ; dcs:fixes  ];
		dcs:item   [ rdfs:label "Corrected pod errors in three files."@en ; a dcs:Bugfix, dcs:Documentation ; dcs:fixes  ];
	] .

HTML-Microformats-0.105/META.yml0000644000076400007640000000263711775403740014343 0ustar  taitai---
abstract: 'parse microformats in HTML'
author:
  - 'Toby Inkster '
build_requires:
  ExtUtils::MakeMaker: 6.59
  Test::More: 0.61
configure_requires:
  ExtUtils::MakeMaker: 6.59
distribution_type: module
dynamic_config: 0
generated_by: 'Module::Install version 1.06'
keywords:
  - Atom
  - HTML
  - JSON
  - Microformats
  - POSH
  - RDF
  - 'Semantic Web'
  - XHTML
  - iCalendar
  - vCard
license: perl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: 1.4
module_name: HTML::Microformats
name: HTML-Microformats
no_index:
  directory:
    - examples
    - inc
    - t
recommends:
  RDF::KML::Exporter: 0
  RDF::iCalendar::Exporter: 0.002
  RDF::vCard::Exporter: 0.006
  XML::Atom::FromOWL: 0
requires:
  CGI: 0
  CGI::Util: 0
  DateTime: 0
  DateTime::Duration: 0
  DateTime::Format::Builder: 0
  DateTime::Format::Natural: 0
  DateTime::Format::Strptime: 0
  DateTime::Span: 0
  HTML::HTML5::Parser: 0.200
  HTML::HTML5::Sanity: 0.100
  HTTP::Date: 0
  JSON: 2.00
  Locale::Country: 0
  Module::Pluggable: 0
  Object::AUTHORITY: 0
  RDF::Trine: 0.130
  URI: 1.30
  URI::URL: 0
  XML::LibXML: 1.60
  perl: 5.10.0
resources:
  bugtracker: http://rt.cpan.org/Dist/Display.html?Queue=HTML-Microformats
  homepage: https://metacpan.org/release/HTML-Microformats
  license: http://dev.perl.org/licenses/
  repository: https://bitbucket.org/tobyink/p5-html-microformats
version: 0.105
HTML-Microformats-0.105/Changes0000644000076400007640000001120311775403735014356 0ustar  taitaiHTML-Microformats
=================

Created:      2010-02-08
Home page:    
Bug tracker:  
Maintainer:   Toby Inkster 

0.105  2012-07-05

 - (Bugfix Documentation) Corrected pod errors in three files.
 - (Bugfix Documentation) Fix link to ocoins.info.
 - Drop common::sense dependency.

0.104  2011-12-06

 - (Packaging) Include some examples.
 - (Packaging) Module::Package::RDF
 - (Update) use 5.010
 - (Update) use Object::AUTHORITY

0.103  2011-02-16

 - (Bugfix) Profile management.
 - (Bugfix) hCalendar attachments.

0.102  2011-02-05

 - (Addition) Export geo in KML format.
 - (Addition) Export hAtom as Atom feeds.
 - (Addition) Export hCalendar in iCalendar format.
 - (Addition) Export hCards in vCard 3.0 format.
 - (Addition) Export hCards in vCard 4.0 format.
 - (Addition) Export hCards in vCard XML format.
 - Deprecated set_X/add_X/clear_X property accessors for microformat
   objects.
 - Include awol:Person, awol:name, awol:email and awol:uri in RDF output
   for hAtom entries.
 - Prefer to parse tel and email in hCard as URLs.
 - Provide hEntry output using RDF iCalendar vocabulary, as a
   ical:Vjournal.

0.101  2010-12-22

 - (Bugfix) Don't assume each rel=me link refers to a different 'me'!
 - (Bugfix) Stop printing warnings about DESTROY method not being defined.

0.100  2010-12-16

 - (Addition) HTML::Microformats->formats and HTML::Microformats->modules.
   (use Module::Pluggable)
 - (Addition) Lots of test cases.
 - (Bugfix) Handle dates like 1pm - i.e with am/pm designator but without
   minutes.
 - Avoid UNIVERSAL::can and UNIVERSAL::isa.
 - Rename loads of modules - in fact every module except the mixins and
   HTML::Microformats itself.

0.00_13  2010-10-18

 - (Addition) Add serialise_model method to HTML::Microformats and
   HTML::Microformats::BASE.
 - Minor bugfixes, cleanups and documentation improvements.

0.00_12  2010-06-25

 - (Bugfix) VoteLinks.pm wasn't included in the 0.00_11 distribution.

0.00_11  2010-06-23

 - (Addition) Find contact hCard for a page - i.e. an hCard in an 
    
   element.
 - (Addition) Support XMDP.
 - (Addition) Support for VoteLinks microformat, including special support
   for VoteLinks inside hAtom entries.
 - Improve calculation of representative hCard.

0.00_10  2010-05-13

 - (Bugfix) Packaging fix - include figure.pm in the distribution.
 - Document hCard helper modules.

0.00_09  2010-05-12

 - (Addition) OpenURL COinS support.
 - (Addition) XOXO support.
 - (Addition) figure support.
 - Document the ISO8601 datetime parser.
 - Document the rel-* microformat implementations and OpenURL COinS.
 - adr RDF output now better differentiates between the addresses and the
   places they represent.

0.00_08  2010-04-29

 - Distinguish between base URI and document/context URI.
 - Introduce a context-unique component to blank node identifiers.

0.00_07  2010-04-28

 - (Update) Support http://microformats.org/profile/specs profile URI.
 - our @HTML::Microformats::Formats instead of 'my'.

0.00_06  2010-04-16

 - (Bugfix) Packaging fix.

0.00_05  2010-04-16

 - (Addition) hAudio support.
 - (Addition) hListing support.
 - (Addition) hProduct support.
 - (Addition) hReview-aggregate support.

0.00_04  2010-03-20

 - (Addition) Implement class=value-title support.
 - (Addition) Implement implied date for hCalendar dtend and hAtom updated
   properties.
 - (Addition) hResume support.
 - (Addition) hReview and xFolk support.
 - (Bugfix) Problems parsing hCard org properties resolved.
 - (Bugfix) UTF8 fixes.
 - (Bugfix) hMeasure.pm wasn't inheriting properly from BASE.pm.
 - Improvements in natural language date parsing.

0.00_03  2010-03-09

 - (Addition) RecurringDateTime datatype.
 - (Addition) hCalendar support.
 - Document BASE microformat class.
 - Rename _base.pm to BASE.pm; _simple_parser.pm to Mixin/Parser.pm;
   _simple_rdf.pm to Mixin/RDF.pm; _rel.pm to BASEREL.pm.

0.00_02  2010-03-01

 - (Addition) Support for hAtom and hNews.
 - (Addition) rel-enclosure support.
 - (Addition) rel-license support.
 - Document geo, adr, XFN and hAtom support.
 - Split out some common rel-X parsing into HTML::Microformats::_rel.

0.00_01  2010-02-24

 - (Addition) Draft 'hMeasure' microformat support.
 - (Addition) Draft 'species' microformat support.
 - (Addition) Figure out which hCard on a page is the 'representative' one
   (for the purposes of XFN).
 - (Addition) XFN support.
 - Copyright statements now reflect the fact that much of this code comes
   from 2008.
 - Document HTML::Microformats::hCard.
 - Improve hCard type+value property parsing.

0.00_00  2010-02-19