File Coverage

blib/lib/XML/OPML.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

# $Id: OPML.pm,v 0.26 2004/03/06 09:19:00 szul Exp $
package XML::OPML;

use strict;
use Carp;
use XML::Parser;
use XML::SimpleObject;
use Fcntl qw(:DEFAULT :flock);
use vars qw($VERSION $AUTOLOAD @ISA $modules $AUTO_ADD);

$VERSION = '0.26';

$AUTO_ADD = 0;

my %opml_fields = (
    head => {
		title		=> '',
		dateCreated	=> '',
		dateModified	=> '',
		ownerName	=> '',
		ownerEmail	=> '',
		expansionState	=> '',
		vertScrollState	=> '',
		windowTop	=> '',
		windowLeft	=> '',
		windowBottom	=> '',
		windowRight	=> ''
	},
    body  => {
		outline => [],
	},
);

sub new {
    my $class = shift;
    my $self = {};
    bless $self, $class;
    $self->_initialize(@_);
    return $self;
}

sub _initialize {
    my $self = shift;
    my %hash = @_;

    # internal hash
    $self->{_internal} = {};

    # initialize number of outlines to 0
    $self->{num_items} = 0;

    # initialize outlines
    $self->{outline} = [];

    # encode output from as_string?
    (exists($hash{encode_output}))
    ? ($self->{encode_output} = $hash{encode_output})
    : ($self->{encode_output} = 1);

    # get version information
    (exists($hash{version}))
    ? ($self->{version} = $hash{version})
    : ($self->{version} = '1.0');

    # set default output
    (exists($hash{output}))
    ? ($self->{output} = $hash{output})
    : ($self->{output} = "");

    # encoding
    (exists($hash{encoding}))
    ? ($self->{encoding} = $hash{encoding})
    : ($self->{encoding} = 'UTF-8');

    # opml version 1.1 -- version 1.0 not supported
    if ($self->{version} eq '1.1') {
	foreach my $i (qw(head body)) {
	    my %template = %{$opml_fields{$i}};
	    $self->{$i} = \%template;
        }
    }
}

sub add_outline {
    my $self = shift;
    my $hash = {@_};
    push (@{$self->{outline}}, $hash);
    return $self->{outline};
}

sub insert_outline {
  my $self = shift;
  my $hash = {@_};
  $self->{group} = $hash->{group};
  delete($hash->{group});
  $self->{add_on} = $hash;
}

sub as_opml_1_1 {
    my $self = shift;
    my $output;

    # XML declaration
    $output .= '{encoding}.'"?>'."\n";

    # DOCTYPE: No official DocType for version 1.1

    # OPML root element
    $output .= ''."\n";

    ################
    # Head Element #
    ################
    $output .= ''."\n";
    $output .= ''. $self->encode($self->{head}->{title}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{dateCreated}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{dateModified}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{ownerName}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{ownerEmail}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{expansionState}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{vertScrollState}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{windowTop}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{windowLeft}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{windowBottom}) .''."\n";
    $output .= ''. $self->encode($self->{head}->{windowRight}) .''."\n";
    $output .= '' . "\n";
    $output .= '' . "\n";

    ###################
    # outline element #
    ###################

    foreach my $outline (@{$self->{outline}}) {
            if(($outline->{opmlvalue}) && ($outline->{opmlvalue} eq "embed")) {
              my $embed_text = "";
              $embed_text .= "dateAdded=\"$outline->{dateAdded}\" " if($outline->{dateAdded});
              $embed_text .= "date_added=\"$outline->{date_added}\" " if($outline->{date_added});
              $embed_text .= "dateDownloaded=\"$outline->{dateDownloaded}\" " if($outline->{dateDownloaded});
              $embed_text .= "date_downloaded=\"$outline->{date_downloaded}\" " if($outline->{date_downloaded});
              $embed_text .= "description=\"$outline->{description}\" " if($outline->{description});
              $embed_text .= "email=\"$outline->{email}\" " if($outline->{email});
              $embed_text .= "filename=\"$outline->{filename}\" " if($outline->{filename});
              $embed_text .= "htmlUrl=\"$outline->{htmlUrl}\" " if($outline->{htmlUrl});
              $embed_text .= "htmlurl=\"$outline->{htmlurl}\" " if($outline->{htmlurl});
              $embed_text .= "keywords=\"$outline->{keywords}\" " if($outline->{keywords});
              $embed_text .= "text=\"$outline->{text}\" " if($outline->{text});
              $embed_text .= "title=\"$outline->{title}\" " if($outline->{title});
              $embed_text .= "type=\"$outline->{type}\" " if($outline->{type});
              $embed_text .= "version=\"$outline->{version}\" " if($outline->{version});
              $embed_text .= "xmlUrl=\"$outline->{xmlUrl}\" " if($outline->{xmlUrl});
              $embed_text .= "xmlurl=\"$outline->{xmlurl}\" " if($outline->{xmlurl});
              if($embed_text eq "") {
                $output .= "\n";
              }
              else {
                $output .= "\n";
                if(($self->{group}) && ($outline->{text} eq "$self->{group}")) {
                  $outline->{time()} = $self->{add_on};
                }
              }
              $output .= return_embedded($self, $outline);
              $output .= "\n";
              next;
            }
	    $output .= "
          foreach my $atts (sort {$a cmp $b} keys %{$outline}) {
            $output .= "$atts=\"" . $self->encode($outline->{$atts}) . "\" ";
          }
          $output .= " />";
          $output .= "\n";
    }
    $output .= '' . "\n";
    $output .= '' . "\n";

    return $output;
}

# Global array for capturing embedded outlines
my @return_values = ();

# Recurse down the outline elements to build proper tree structure
sub return_embedded {
  my ($self, $outline) = @_;
  foreach my $inner_out (keys %{$outline}) {
    next if($inner_out eq "opmlvalue");
    next if($inner_out eq "dateAdded");
    next if($inner_out eq "date_added");
    next if($inner_out eq "dateDownloaded");
    next if($inner_out eq "date_downloaded");
    next if($inner_out eq "description");
    next if($inner_out eq "email");
    next if($inner_out eq "filename");
    next if($inner_out eq "htmlUrl");
    next if($inner_out eq "htmlurl");
    next if($inner_out eq "keywords");
    next if($inner_out eq "text");
    next if($inner_out eq "title");
    next if($inner_out eq "type");
    next if($inner_out eq "version");
    next if($inner_out eq "xmlUrl");
    next if($inner_out eq "xmlurl");
    if(($outline->{$inner_out}->{'opmlvalue'}) && ($outline->{$inner_out}->{'opmlvalue'} eq "embed")) {
      my @elems = keys(%{$outline->{$inner_out}});
      my $pop_num = scalar(@elems);
      foreach my $elems (@elems) {
        $pop_num-- if(($elems eq "opmlvalue") || ($elems eq "dateAdded") || ($elems eq "date_added") || ($elems eq "dateDownloaded") || ($elems eq "date_downloaded") || ($elems eq "description") || ($elems eq "email") || ($elems eq "filename") || ($elems eq "htmlUrl") || ($elems eq "htmlurl") || ($elems eq "keywords") || ($elems eq "text") || ($elems eq "title") || ($elems eq "type") || ($elems eq "version") || ($elems eq "xmlUrl") || ($elems eq "xmlurl"));
      }
      $pop_num = 1 if($pop_num == 0);
      my $return_output = "";
      my $embed_text = "";
      $embed_text .= "dateAdded=\"$outline->{$inner_out}->{dateAdded}\" " if($outline->{$inner_out}->{dateAdded});
      $embed_text .= "date_added=\"$outline->{$inner_out}->{date_added}\" " if($outline->{$inner_out}->{date_added});
      $embed_text .= "dateDownloaded=\"$outline->{$inner_out}->{dateDownloaded}\" " if($outline->{$inner_out}->{dateDownloaded});
      $embed_text .= "date_downloaded=\"$outline->{$inner_out}->{date_downloaded}\" " if($outline->{$inner_out}->{date_downloaded});
      $embed_text .= "description=\"$outline->{$inner_out}->{description}\" " if($outline->{$inner_out}->{description});
      $embed_text .= "email=\"$outline->{$inner_out}->{email}\" " if($outline->{$inner_out}->{email});
      $embed_text .= "filename=\"$outline->{$inner_out}->{filename}\" " if($outline->{$inner_out}->{filename});
      $embed_text .= "htmlUrl=\"$outline->{$inner_out}->{htmlUrl}\" " if($outline->{$inner_out}->{hmtlUrl});
      $embed_text .= "htmlurl=\"$outline->{$inner_out}->{htmlurl}\" " if($outline->{$inner_out}->{htmlurl});
      $embed_text .= "keywords=\"$outline->{$inner_out}->{keywords}\" " if($outline->{$inner_out}->{keywords});
      $embed_text .= "text=\"$outline->{$inner_out}->{text}\" " if($outline->{$inner_out}->{text});
      $embed_text .= "title=\"$outline->{$inner_out}->{title}\" " if($outline->{$inner_out}->{title});
      $embed_text .= "type=\"$outline->{$inner_out}->{type}\" " if($outline->{$inner_out}->{type});
      $embed_text .= "version=\"$outline->{$inner_out}->{version}\" " if($outline->{$inner_out}->{version});
      $embed_text .= "xmlUrl=\"$outline->{$inner_out}->{xmlUrl}\" " if($outline->{$inner_out}->{xmlUrl});
      $embed_text .= "xmlurl=\"$outline->{$inner_out}->{xmlurl}\" " if($outline->{$inner_out}->{xmlurl});
      if($embed_text eq "") {
        $return_output .= "\n";
      }
      else {
        $return_output .= "\n";
        if(($self->{group}) && ($outline->{$inner_out}->{text} eq "$self->{group}")) {
          $outline->{$inner_out}->{time()} = $self->{add_on};
        }
      }
      return_embedded($self, $outline->{$inner_out});
      while($pop_num > 0) {
      	$return_output .= pop(@return_values);
        $pop_num--;
      }
      $return_output .= "\n";
      push(@return_values, $return_output);
      next;
    }
    else {
      my $return_output = "";
      $return_output .= "
      foreach my $atts (sort {$a cmp $b} keys %{$outline->{$inner_out}}) {
        $return_output .= "$atts=\"" . $self->encode($outline->{$inner_out}->{$atts}) . "\" ";
      }
      $return_output .= " />\n";
      push(@return_values, $return_output);
    }
  }
  my $return_value = join('', @return_values);
  return $return_value;
}

sub as_string {
    my $self = shift;
    my $version = ($self->{output} =~ /\d/) ? $self->{output} : $self->{version};
    my $output;
    $output = &as_opml_1_1($self);
    return $output;
}

sub save {
    my ($self,$file) = @_;
    open(OUT,">$file") || croak "Cannot open file $file for write: $!";
    flock(OUT, LOCK_EX);
    print OUT $self->as_string();
    flock(OUT, LOCK_UN);
    close OUT;
}

# Parser the OPML with XML::Parser and XML::SimpleObject to add additional outlines.

sub parse {
  my $self = shift;
  my $content = shift;
  $self->_initialize((%$self));
  @return_values = ();
  my $xmlobj;
  my $bool;
  eval {
    $bool = "true" if(-e $content);
  };
  if($bool) {
    my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
    $xmlobj = XML::SimpleObject->new($parser->parsefile($content));
   }
   else {
    my $parser = XML::Parser->new(ErrorContext => 2, Style => "Tree");
    $xmlobj = XML::SimpleObject->new($parser->parse($content));
  }
  my $head = $xmlobj->child('opml')->child('head');
  my @head_children = $head->children();
  my $head_hash = {};
  foreach my $head_child (@head_children) {
    my $elem_value = $head_child->value() || "";
    $head_hash->{$head_child->name()} = $elem_value;
  }
  my $body = $xmlobj->child('opml')->child('body');
  my @outlines = $body->children('outline');
  my $outline_list = [];
  foreach my $outlines (@outlines) {
    my $outline_holder = {};
    my %atts = $outlines->attributes();
    foreach my $atts (keys(%atts)) {
      $outline_holder->{$atts} = $outlines->attribute($atts);
    }
    unless($outlines->children()) {
      push(@{$outline_list}, $outline_holder);
    }
    else {
      my $new_hash = return_outlines($outline_holder, $outlines);
      push(@{$outline_list}, $new_hash);
    }
  }
  $self->{head} = $head_hash;
  $self->{outline} = $outline_list;
}

sub return_outlines {
  my($outline_holder, $outlines) = @_;
  $outline_holder->{'opmlvalue'} = 'embed';
  my @outlines = $outlines->children('outline');
  my $out_count = 0;
  foreach my $outs (@outlines) {
    $out_count++;
    my $new_outline_holder = {};
    my %atts = $outs->attributes();
    foreach my $atts (keys(%atts)) {
      $new_outline_holder->{$atts} = $outs->attribute($atts);
    }
    my $var_name = time() . $out_count;
    unless($outs->children()) {
      $outline_holder->{$var_name} = $new_outline_holder;
    }
    else {
      my $new_hash = return_outlines($new_outline_holder, $outs);
      $outline_holder->{$var_name} = $new_hash;
    }
  }
  return $outline_holder;
}

sub strict {
    my ($self,$value) = @_;
    $self->{'strict'} = $value;
}

sub AUTOLOAD {
    my $self = shift;
    my $type = ref($self) || croak "$self is not an object\n";
    my $name = $AUTOLOAD;
    $name =~ s/.*://;
    return if $name eq 'DESTROY';

    croak "Unregistered entity: Can't access $name field in object of class $type"
		unless (exists $self->{$name});

    # return reference to OPML structure
    if (@_ == 1) {
	return $self->{$name}->{$_[0]} if defined $self->{$name}->{$_[0]};

    # we're going to set values here
    } elsif (@_ > 1) {
	my %hash = @_;
    	# return value
      foreach my $key (keys(%hash)) {
        $self->{$name}->{$key} = $hash{$key};
      }
	return $self->{$name};

    # otherwise, just return a reference to the whole thing
    } else {
	return $self->{$name};
    }
    return 0;
}

# Entities for encoding
my %entity = (
	      nbsp   => " ",
	      iexcl  => "¡",
	      cent   => "¢",
	      pound  => "£",
	      curren => "¤",
	      yen    => "¥",
	      brvbar => "¦",
	      sect   => "§",
	      uml    => "¨",
	      copy   => "©",
	      ordf   => "ª",
	      laquo  => "«",
	      not    => "¬",
	      shy    => "­",
	      reg    => "®",
	      macr   => "¯",
	      deg    => "°",
	      plusmn => "±",
	      sup2   => "²",
	      sup3   => "³",
	      acute  => "´",
	      micro  => "µ",
	      para   => "¶",
	      middot => "·",
	      cedil  => "¸",
	      sup1   => "¹",
	      ordm   => "º",
	      raquo  => "»",
	      frac14 => "¼",
	      frac12 => "½",
	      frac34 => "¾",
	      iquest => "¿",
	      Agrave => "À",
	      Aacute => "Á",
	      Acirc  => "Â",
	      Atilde => "Ã",
	      Auml   => "Ä",
	      Aring  => "Å",
	      AElig  => "Æ",
	      Ccedil => "Ç",
	      Egrave => "È",
	      Eacute => "É",
	      Ecirc  => "Ê",
	      Euml   => "Ë",
	      Igrave => "Ì",
	      Iacute => "Í",
	      Icirc  => "Î",
	      Iuml   => "Ï",
	      ETH    => "Ð",
	      Ntilde => "Ñ",
	      Ograve => "Ò",
	      Oacute => "Ó",
	      Ocirc  => "Ô",
	      Otilde => "Õ",
	      Ouml   => "Ö",
	      times  => "×",
	      Oslash => "Ø",
	      Ugrave => "Ù",
	      Uacute => "Ú",
	      Ucirc  => "Û",
	      Uuml   => "Ü",
	      Yacute => "Ý",
	      THORN  => "Þ",
	      szlig  => "ß",
	      agrave => "à",
	      aacute => "á",
	      acirc  => "â",
	      atilde => "ã",
	      auml   => "ä",
	      aring  => "å",
	      aelig  => "æ",
	      ccedil => "ç",
	      egrave => "è",
	      eacute => "é",
	      ecirc  => "ê",
	      euml   => "ë",
	      igrave => "ì",
	      iacute => "í",
	      icirc  => "î",
	      iuml   => "ï",
	      eth    => "ð",
	      ntilde => "ñ",
	      ograve => "ò",
	      oacute => "ó",
	      ocirc  => "ô",
	      otilde => "õ",
	      ouml   => "ö",
	      divide => "÷",
	      oslash => "ø",
	      ugrave => "ù",
	      uacute => "ú",
	      ucirc  => "û",
	      uuml   => "ü",
	      yacute => "ý",
	      thorn  => "þ",
	      yuml   => "ÿ",
	      );

my $entities = join('|', keys %entity);

sub encode {
	my ($self, $text) = @_;
	return $text unless $self->{'encode_output'};
	my $encoded_text = '';
	while ( $text =~ s/(.*?)(\<\!\[CDATA\[.*?\]\]\>)//s ) {
		$encoded_text .= encode_text($1) . $2;
	}
	$encoded_text .= encode_text($text);
	return $encoded_text;
}

sub encode_text {
    my $text = shift;
    $text =~ s/&(?!(#[0-9]+|#x[0-9a-fA-F]+|\w+);)/&/g;
    $text =~ s/&($entities);/$entity{$1}/g;
    $text =~ s/
    return $text;
}
1;
__END__