# URI::Bookmarks --
# Perl module class encapsulating bookmark files
#
# Copyright (c) 1999 Adam Spiers <adam@spiers.net>. All rights
# reserved. This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# $Id: Bookmarks.pm,v 1.12 2001/10/10 13:47:56 adam Exp $
#

package URI::Bookmarks;

use strict;

require 5.004;
#use AutoLoader qw(AUTOLOAD);
use Carp;
use URI::Bookmarks::Netscape;
use URI::Bookmark::Folder;
use URI::Bookmarks::Mozilla;

use vars qw($VERSION);
$VERSION = '1.11';

=head1 NAME

URI::Bookmarks - Perl module class encapsulating bookmark files

=head1 SYNOPSIS

  use URI::Bookmarks;

  # URI::Bookmarks automagically detects which type of bookmarks
  # we're dealing with.

  my $bookmarks =
    new URI::Bookmarks(file => "$ENV{HOME}/.netscape/bookmarks.html");

  my $bookmarks =
    new URI::Bookmarks(file => "$ENV{HOME}/.mozilla/My Profile/bookmarks.html");

  # This one not implemented yet, sorry!
  my $bookmarks = new URI::Bookmarks(dir => "/mnt/C/windows/Favorites");

  # Manipulate $bookmarks using nice tree methods from Tree::DAG_Node,
  # e.g. delete all bookmarks from under the first folder named $folder:
  ($bookmarks->name_to_nodes($folder))[0]->unlink_from_mother();

  # Then output the new file.
  print $bookmarks->export('Netscape');

=head1 DESCRIPTION

URI::Bookmarks provides a class for manipulating hierarchical
collections of bookmarks.  Each entry in the collection is an object
of type URI::Bookmark, which is in turn a subclass of Tree::DAG_Node,
and hence all standard tree manipulation methods are available (see
L<Tree::DAG_Node>).

=head1 CONSTRUCTORS

=head2 new()

See L</SYNOPSIS>.

Returns C<undef> or a scalar containing a reason for failure if it
failed to construct a bookmark tree using the given parameters.

You can specify a title via the C<title> parameter.

If no source data is specified, an empty tree is constructed.

B<N.B. This API has changed a bit since 0.94.  Sorry for any hassle.>

=cut

sub new {
  my $this = shift;
  my $class = ref $this || $this;
  my $self = {};
  bless $self, $class;

  my %p = @_;

  my $title = $p{title} || '';
  $self->tree_root(URI::Bookmark::Folder->new({ name => $title }));

  return $self unless $p{file};

  # Automatically figure out what sort of collection of bookmarks we are.
  # Currently, this isn't very cunning.  Note that Netscape and Mozilla
  # share the same import code.
  return "URI::Bookmarks::new must be passed a hash" unless @_ % 2 == 0;
  
  return "URI::Bookmarks::new was missing `file' parameter" unless $p{file};
  return "URI::Bookmarks::new was passed non-existent file `$p{file}'"
    unless -e $p{file};
  return "URI::Bookmarks::new was passed empty file `$p{file}'"
    unless -s $p{file};

  my $parse_return =
    $self->URI::Bookmarks::Netscape::import_bookmarks(file => $p{file});
  if (! ref $parse_return) {
    return $parse_return;
  }

  $self->tree_root->name($title) if $title; # Override import title

  return $self;
}

sub parser_debugging { $_[0]->{_parser_debugging} }

sub type     { $_[0]->{type}           }
sub source   { $_[0]->origin->{source} }

#1;
########################    End of preloaded code    ########################
#__END__

=head1 METHODS

=head2 tree_root()

  my $tree_root_node = $bookmarks->tree_root();

  $bookmarks->tree_root($new_root);

Returns the current root node of the tree of bookmarks.  If the
optional parameter is provided, the root node is changed to it.

=cut

sub tree_root {
  my ($self, $new_root) = @_;
  $self->{root} = $new_root if $new_root;
  return $self->{root};
}

=head2 title()

  my $title = $bookmarks->title();

  $bookmarks->title($new_title);

Returns the current title of the collection of bookmarks.  If the
optional parameter is provided, the title is changed to it.

=cut

sub title {
  my $self = shift;
  my ($new_title) = @_;
  
  $self->{title} = $new_title if defined $new_title;

  return $self->{title} || '';
}

=head2 origin()

  my $origin = $bookmarks->origin();
  my $origin_type = $origin->{type};

Returns a hashref containing information about the origin of the
collection of bookmarks.  This will typically be where the bookmarks
were imported from, but if several collections of bookmarks have been
imported into this object, it's up to the user what it contains.

=cut

sub origin {
  my $self = shift;

  return $self->{origin} ||= {};
}

=head2 grep_nodes()

  # Find all nodes whose name contains `foo'.
  # Note that not every node has a name (e.g. hrules don't).
  my $filter = sub { ($_[0]->name() || '') =~ /foo/ };
  my @matching_nodes = $bookmarks->grep_nodes($filter);

Takes a filter coderef as the only parameter, and returns all
nodes which satisfy the filter's condition.

=cut

sub grep_nodes {
  my ($self, $filter) = @_;

  return grep { $filter->($_) } $self->tree_root->descendants();
}

=head2 name_to_nodes()

  my @nodes = $bookmarks->name_to_nodes('Cinemas');

Returns an array of all nodes matching the given name.

=cut

sub name_to_nodes {
  my $self = shift;
  my ($name) = @_;

  if (! exists $self->{name_to_nodes}) {
    $self->build_name_lookup;
  }

  return () unless exists $self->{name_to_nodes}{$name};
  my @nodes = @{$self->{name_to_nodes}{$name}};
  return () if @nodes == 0;
  return @nodes;
}

=head2 build_name_lookup()

  $bookmarks->build_name_lookup();

This method builds an internal hash which maps node names to arrays of
nodes which have the corresponding key as their name.

It only needs to be called if you want to rebuild the hash after
modifying the bookmark collection in some way; if the hash is needed
and has not been built, it will be built automatically.

=cut

sub build_name_lookup {
  my $self = shift;

  $self->{name_to_nodes} = { };

  my @descendants = $self->tree_root->descendants;
  foreach my $descendant (@descendants) {
    my $name = $descendant->name;
    push @{$self->{name_to_nodes}{$name || '__UNDEF__'}}, $descendant;
  }
}

=head2 export()

  my @lines = $bookmarks->export('Netscape array');
  my @lines = $bookmarks->export('Mozilla array');
  my $text = $bookmarks->export('Netscape');
  my $text = $bookmarks->export('Mozilla');

The interface to the export routines.  The examples above show the 
currently available export types.

=cut

sub export {
  my $self = shift;
  my ($new_type) = @_;

  if ($new_type eq 'Netscape array') {
    return URI::Bookmarks::Netscape::export($self);
  }
  elsif ($new_type eq 'Netscape') {
    return join '', URI::Bookmarks::Netscape::export($self);
  }
  elsif ($new_type eq 'Mozilla array') {
    return URI::Bookmarks::Mozilla::export($self);
  }
  if ($new_type eq 'Mozilla') {
    return join '', URI::Bookmarks::Mozilla::export($self);
  }
  else {
    croak "`$new_type' is an invalid export type";
  }
}

=item * B<all_URLs>

  $bookmarks->all_URLs();

This method simply returns an array of all the URLs in the collection
of bookmarks.

=cut

sub all_URLs {
  my $self = shift;

  my ($root) = @_;
  $root ||= $self->tree_root();

  my @urls = ();

  $root->walk_down({urls     => \@urls,
                    callback => \&_callback_all_URLS});

  return @urls;
}

sub _callback_all_URLS {
  my ($node, $options) = @_;

  if ($node->type() eq 'bookmark') {
    push @{$options->{urls}}, $node->attribute->{href};
  }

  return 1;
}

=head1 BUGS

The C<file> key of C<new()> might not be safe (I can't remember what I
meant when I originally wrote that though).

Mozilla support is probably buggy.

=head1 AUTHOR

Adam Spiers <adam@spiers.net>

=head1 SEE ALSO

L<Tree::DAG_Node>, L<URI::Bookmarks::*>, L<URI::Bookmark>,
L<URI::Bookmark::*>, L<perl(1)>.

=cut

1;