#!/yer/perl/here -w
use strict;

###############################################################################
#
# render-opml v0.1
# This is proof-of-concept *only*. 
# Don't come crying to me if it doesn't work.
#
# Copyright (c) 2000 Aaron Straup Cope <aaron@aaronland.net>
#
# 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 2
# of the License, 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.
###############################################################################

# Modules
use CGI::Pretty;
use CGI::Carp qw (fatalsToBrowser);
use HTTP::Request;
use LWP::UserAgent;
use XML::Parser;

# Objects
my $xml;
my $cgi;
my $agent;

# Globals

# This is a temporary hack. It shouldn't be necessary.
my $base = "/yer/foldertree/url/here";

my $tree;
my $title;
my $body;
my $outline;

my $count;
my $last;

{
    &main;
    exit;
}

sub main {
    &load_globals;
    &convert($cgi->param("opml"));

    &render;
    return 1;
}

sub load_globals {
    $count = 1;
    $last  = 0;

    $xml   = new XML::Parser;
    $cgi   = new CGI::Pretty;
    $agent = new LWP::UserAgent;

    undef ($tree, $title, $body, $outline);
    return 1;
}

sub render {
    print 
	$cgi->header,
	$cgi->start_html(
			 -xbase   => $base,
			 -style   => { src => "$base/ftie4style.css" },
			 -script  => [
				      { -src  => "$base/ftiens4.js" },
				      { -code => $tree },
				      { -code => "initializeDocument()" },
				      ],
			 -bgcolor => "#ffffff",
			 );
    print $cgi->pre($tree);
    print $cgi->end_html;
    return 1;
}

sub convert {
    my $url    = shift;
    my $stream = &fetch($url);

    $xml->setHandlers( Start => \&start, End => \&end , Char => \&char);
    
    # We do this because expat/XML::Parser doesn't fail
    # gracefully when passed a badly-formed XML document
    eval { $xml->parse($stream); };
    &loser($@) if ($@);

    return 1;
}

sub fetch {
    my $url     = shift;
    my $request = new HTTP::Request (GET => $url);
    my $res     = $agent->request($request);
    
    &loser("Failed to get 'url' : $res->{'_msg'}") if ($res->{'_rc'} ne "200");
    return $res->{'_content'};
}

sub loser {
    die $_[0],"\n";
}

sub start {
  my $parser = shift;
  my $el     = shift;
  my $attrs  = { @_ };

  $title = ($el =~ /^(title)$/);

  $body ||= ($el =~ /^(body)$/);
  return unless $body;

  if (! $outline->{'text'}) {
      $outline = $attrs;
      return 1;
  }

  my $spc; map { $spc .= " "; } (0..$last);
  #print STDERR "$spc$outline->{'text'} $outline->{'url'}\n";

  if (($outline->{'type'} eq "link") && ($outline->{'url'} =~ /\.(opml)$/)) {
      # redefine URL as self?opml=url
      $outline->{'url'} = join("?",$cgi->url,"opml=$outline->{'url'}");
  }

  map { $outline->{$_} =~ s/'/\\'/gm;  $outline->{$_} =~ s/"/'/gm;  } keys %$outline;

  my $aux   = join("","aux",($count || "1"));
  my $p_aux = (! $last) ? "foldersTree" : join("","aux",$last);

  if ($last < $count) {
     $tree .= $spc."$aux = insFld($p_aux, gFld(\"$outline->{'text'}\", \"$outline->{'url'}\"))\n";
  } else {
     $tree .= $spc."insDoc($p_aux, gLnk($count,\"$outline->{'text'}\", \"$outline->{'url'}\"))\n";
  }

  $outline = $attrs;
  $last    = $count;

  $count++;
  return 1;
}

sub end {
  my $parser = shift;
  my $el     = shift;

  return unless $body;

  $count--;
  return 1;
}

sub char {
    my $parser = shift;
    my $el     = shift;

    if ($title) {
	$tree .= "foldersTree = gFld(\"$el\",\"\")\n";
	undef $title;
    }

    return 1;
}