# $Id: Collection.pm,v 1.7 2003/08/11 14:21:13 gene Exp $

package URI::Collection;
use vars qw($VERSION); $VERSION = '0.05';
use strict;
use Carp;
use Cwd;
use File::Spec;
use File::Find;
use File::Path;
use Config::IniFiles;
use Netscape::Bookmarks;

sub _debug {  # {{{
    print @_, "\n" if shift->{debug};
}  # }}}

sub new {  # {{{
    my ($class, %args) = @_;
    my $self = {
        debug     => $args{debug} || 0,
        links     => $args{links} || [],
        cat_links => {},
    };
    bless $self, $class;
    $self->_init($args{links}) if $args{links};
    return $self;
}  # }}}

sub _init {  # {{{
    my $self = shift;

    $self->{links} = [ $self->{links} ]
        if $self->{links} && !ref($self->{links}) &&
            (-f $self->{links} || -d $self->{links});

    for (@{ $self->{links} }) {
        croak "$_ does not exist.\n" unless -d || -f;

        if (-d) {
            # Handle a M$ Windows Favorites directory tree.
            $self->_traverse($_);
        }
        elsif (-f) {
            # Handle a Netscape style bookmark file.
            $self->_parse_file($_);
        }
    }
#use Data::Dumper;warn Dumper($self->{cat_links});
}  # }}}

sub as_bookmark_file {  # {{{
    my ($self, %args) = @_;

    # Make the top level bookmark category.
    my $top = Netscape::Bookmarks::Category->new({
        folded      => 0,
        title       => __PACKAGE__ .' Bookmarks',
        add_date    => time,
        description => 'Bookmarks generated by '. __PACKAGE__,
    });

    # Declare a hash for storing the redundant category objects.
    my %categories;

    # Make bookmark categories for the internal category paths.
    for my $path (sort keys %{ $self->{cat_links} }) {
        # Declare our current category.
        my $category;

        # Make a bookmark category for each title in the category
        # path.
        # NOTE: This split means, "split on any forward slashes that
        # are not preceeded by a backslash."
        for my $title (split /(?<!\\)\//, $path) {
            # Set the current category to the top level if we are
            # just starting out.
            $category = $top unless $category;

            # Add an useen category.
            unless (exists $categories{$title}) {
                $categories{$title} = Netscape::Bookmarks::Category->new({
                    folded      => 0,
                    title       => $title,
                    add_date    => time,
                    description => '',
                });

                $category->add($categories{$title});
            }

            # "Increment" the current category with the one just seen.
            $category = $categories{$title};
        }

        # Add links to the last seen category.
        for my $link (@{ $self->{cat_links}{$path} }) {
            if (ref $link->{obj} eq 'Netscape::Bookmarks::Link') {
                # Handle a Netscape style entry.
                $category->add($link->{obj});
            }
            else {
                # Handle a Windows Favorite entry.
                $category->add(_favorite_to_bookmark($link));
            }
        }
    }

    # Save the bookmarks as a file, if told to.
    if ($args{save_as}) {
        open BOOKMARKS, "> $args{save_as}"
            or croak "Can't write $args{save_as} - $!\n";
        print BOOKMARKS $top->as_string;
        close BOOKMARKS;
    }

    # Return the bookmark file contents.
    return $top->as_string;
}  # }}}

sub as_favorite_directory {  # {{{
    my ($self, %args) = @_;

    # Create a top level directory for our Favorites.
    my $top = $args{save_as} || 'Favorites-'. time;
    mkpath $top;
    chdir $top;
    $top = getcwd;

    # Build the Favorites tree with Internet Shortcut files.
    for my $path (keys %{ $self->{cat_links} }) {
        mkpath $path;
        chdir $path;

        # Add links to the path category.
        for my $link (@{ $self->{cat_links}{$path} }) {
            if (ref $link->{obj} eq 'Config::IniFiles') {
                # Handle a Windows Favorite entry.
                $link->{obj}->WriteConfig ("$link->{title}.url");
            }
            else {
                # Handle a Netscape style entry.
                my ($title, $obj) = _bookmark_to_favorite ($link);
                # Sanitize the title as a proper filename.
                # XXX This is a dumb hack that is probably not 
                # platform independant at all.  There has to be a
                # better way.
                $title =~ s/[^\w\s$%\-@~`'!()^#&+,;=.\[\]{}]/_/g;
                $obj->WriteConfig ("$title.url");
            }
        }

        # Change back to the top level path category directory.
        chdir $top;
    }

    # Return the top level directory.
    return $top;
}  # }}}

# Return all similar links or categories.
# Gene: $self->{cat_links} is NOT NESTED. HTH. HAND.
sub fetch_items {  # {{{
    my ($self, %args) = @_;
$self->_debug('entering fetch_items');
    my %items;

    # Step through every link.
    while (my ($category, $links) = each %{ $self->{cat_links} }) {
#$self->_debug("Cat: $category");
        # If we are given a title, url or matching category...
        if ($args{title} || $args{url} ||
            ($args{category} && $category =~ /$args{category}/i)
        ) {
            # Fetch an entire category's links.
$self->_debug("cat match: $category");
            for (@$links) {
                # Get the interesting bits.
                my ($title, $url) = _title_and_url($_->{obj});
                # XXX Yikes. This condition is... giant!
                # (C ^ P) ^ (Y v X) v (~C ^ X)
                # where X = (T ^ Q) v (U ^ R) and Y = ~(T v U)
                if (
($args{category} && $category =~ /$args{category}/i &&
    (
        !($args{title} || $args{url})
        ||
        ($args{title} && $title =~ /$args{title}/i)
        ||
        ($args{url} && $url =~ /$args{url}/i)
    )
)
||
(!$args{category} &&
    (
        ($args{title} && $title =~ /$args{title}/i)
        ||
        ($args{url} && $url =~ /$args{url}/i)
    )
)
                ) {
$self->_debug("link: $title => $url");
                    push @{ $items{$category} }, { $title => $url }
                }
            }
        }
    }

$self->_debug('exiting fetch_items');
    return \%items;
}  # }}}

sub _title_and_url {  # {{{
    my $link = shift;
    my ($title, $url);

    if (ref $link eq 'Netscape::Bookmarks::Link') {
        ($title, $url) = ($link->title, $link->href);
    }
    elsif (ref $link eq 'Config::IniFiles') {
        ($title, $url) = (
            $link->val('Title', 'Title'),
            $link->val('InternetShortcut', 'URL')
        );
    }

    return $title => $url;
}  # }}}

# Step over the Favorites directory and add the categories and links
# to our internal categories and links structure.
sub _traverse {  # {{{
    my ($self, $dir) = @_;
$self->_debug("entering _traverse with $dir");
    find (
        sub {
            if (/^(.+?)\.url$/) {
                # The file name - sans extension - is the title.
                my $title = $1;

                # Remove the Favorites tree path from the category
                # name.
                (my $category = $File::Find::dir) =~ s/^\Q$dir\E//;

                # Set the top level category if we are there.
                $category = 'Favorites' unless $category;

                # Convert the platform dependent path separators to
                # slashes.
                # NOTE: We Replace any forward slashes in category
                # names with "back-slash escaped" forward slashes
                # ("\/").
                $category = join '/',
                    map { s!\/!\\/!g; $_ }
                        grep { $_ }
                            File::Spec->splitdir($category);

                my $obj = Config::IniFiles->new(
                    '-file' => "$title.url"
                );
                $obj->AddSection('Title');
                $obj->newval('Title', 'Title', $title);

                # Add the category and link!
                push @{ $self->{cat_links}{$category} }, {
                    title => $title,
                    obj   => $obj,
                };
$self->_debug($self->{cat_links}{$category}[-1]{obj});
            }
        },
        $dir  # This dangley bit is the directory into which we want to descend.
    );
$self->_debug('exiting _traverse');
}  # }}}

# Parse the given bookmarks file into our internal categories and
# links structure.
sub _parse_file {  # {{{
    my ($self, $file) = @_;
$self->_debug("entering _parse_file with $file");

    # Define a Netscape bookmarks object.
    my $b = eval { Netscape::Bookmarks->new($file) };
    croak "$@\n" if $@;
$self->_debug("Netscape bookmarks object created with $file");

    # Declare our categories list and current category title.
    my (@category, $category);
    # Define the last seen level as the top.
    my $last_level = 0;

    # Call Netscape::Bookmarks::recurse to figure out the category
    # and adds links.
    $b->recurse(
        sub {
            my ($object, $level) = @_;
$self->_debug($object);

            if ($object->isa('Netscape::Bookmarks::Category')) {
                # Find the current / separated category name.
                if ($level > 0) {
                    if ($level <= $last_level) {
                        # XXX splice () would be more idiomatic...
                        pop @category for 1 .. $last_level - $level + 1;
                    }

                    # Add the category title.
                    push @category, $object->title;
                }

                # Set the current category and level.
                # NOTE that / is forced as the "path separator" here.
                $category = join '/', @category;
                $last_level = $level;
            }
            elsif ($object->isa('Netscape::Bookmarks::Link')) {
                # Add the category and link to our internal structure.
                push @{ $self->{cat_links}{$category} }, {
                    title => $object->title,
                    obj   => $object,
                };
            }
        }
    );

$self->_debug('exiting _parse_file');
}  # }}}

# http://www.cyanwerks.com/file-format-url.html
sub _bookmark_to_favorite {  # {{{
    my $link = shift;

    # Define an Internet Shortcut object based on the given Netscape
    # bookmark object.
    my $obj = Config::IniFiles->new;
    $obj->AddSection('DEFAULT');
    $obj->newval('DEFAULT', 'BASEURL', $link->{obj}->href);
    $obj->AddSection('InternetShortcut');
    $obj->newval('InternetShortcut', 'URL', $link->{obj}->href);

    # Return the Internet Shortcut title and object.
    return $link->{obj}->title, $obj;
}  # }}}

sub _favorite_to_bookmark {  # {{{
    my $link = shift;

    # Define a Netscape bookmark link based on the given Internet
    # Shortcut object.
    my $obj = Netscape::Bookmarks::Link->new({
        TITLE         => $link->{title},
        DESCRIPTION   => '',
        HREF          => $link->{obj}->val('InternetShortcut', 'URL'),
        ADD_DATE      => '',
        LAST_VISIT    => '',
        LAST_MODIFIED => '',
        ALIAS_ID      => '',
    });

    # Return the Netscape bookmark object.
    return $obj;
}  # }}}

1;
__END__

=head1 NAME

URI::Collection - Input and output link collections in different formats

=head1 SYNOPSIS

  use URI::Collection;

  $collection = URI::Collection->new(
      links => $bookmark_file,
  );
  $collection = URI::Collection->new(
      links => $favorite_directory,
  );
  $collection = URI::Collection->new(
      links => [ $bookmark_file, $favorite_directory ],
  );

  $links = $collection->fetch_items(
      name => $regexp,
  );

  $bookmarks = $collection->as_bookmark_file(
      save_as => $bookmark_file,
  );

  $favorites = $collection->as_favorite_directory(
      save_as => $favorite_directory,
  );

=head1 DESCRIPTION

An object of class C<URI::Collection> represents the links and 
categories in parsed Netscape style bookmark files and Windows 
"Favorites" directories, with output in either style.

=head1 METHODS

=head2 new

  $collection = URI::Collection->new(
      links => $bookmark_file,
  );
  $collection = URI::Collection->new(
      links => $favorite_directory,
  );
  $collection = URI::Collection->new(
      links => [ $bookmark_file, $favorite_directory ],
  );

Return a new C<URI::Collection> object.

This method mashes link store formats together, simultaneously.

=head2 as_bookmark_file

  $bookmarks = $collection->as_bookmark_file(
      save_as => $bookmark_file,
  );

Output a Netscape style bookmark file as a string with the file 
contents.

Optionally, save the bookmarks as a file to disk, if given a 
C<save_as> argument.

=head2 as_favorite_directory

  $favorites = $collection->as_favorite_directory(
      save_as => $favorite_directory,
  );

Write an M$ Windows "Favorites" folder to disk and output the top
level directory name.

A specific directory name can be provided for the location of the
Favorites tree to write.  If one is not provided, a folder named 
"Favorites-" with the system time stamp appened is written to the 
current directory. 

=head2 fetch_items

  $items = $collection->fetch_items(
      name => $regexp,
  );

Return a list of links and collections of links that have titles or
categories similar to the name argument. 

=head1 DEPENDENCIES

L<Carp>

L<Cwd>

L<File::Spec>

L<File::Find>

L<File::Path>

L<Config::IniFiles>

L<Netscape::Bookmarks::Alias>

=head1 TO DO

Allow restriction of link fetching for any saved information (not
just category, title and url).

Ignore redundant links.

Optionally return the M$ Favorites directory structure (as a
variable) instead of writing it to disk.

Allow input/output of file and directory handles.

Allow slicing of the category-links structure.

Allow link munging to happen under a given category or 
categories only.

Check if links are active.

Update link titles and URLs if changed or moved.

Mirror links?

Handle other bookmark formats (including some type of generic XML), 
and "raw" (CSV) lists of links, to justify such a generic package 
name.  This includes different platform flavors of every browser.

Move the Favorites input/output functionality to a seperate module
like C<URI::Collection::Favorites::IE::Windows> and 
C<URI::Collection::Favorites::IE::Mac>, or some such.  Do the same 
with the above mentioned "platform flavors", such as Opera and Mosaic 
"Hotlists", and OmniWeb bookmarks, etc.

=head1 SEE ALSO

There are an enormous number of web-based bookmark managers out there 
(see http://useful.webwizards.net/wbbm.htm), which I don't care about 
at all.  What I do care about are multi-format link converters.  Here 
are a few that I found:

Online manager: 
C<http://www.linkagogo.com/>

CDML Universal Bookmark Manager (for M$ Windows only):
C<http://www.cdml.com/products/ubm.asp>

OperaHotlist2HTML:
C<http://nelson.oit.unc.edu/~alanh/operahotlist2html/>

bk2site:
C<http://bk2site.sourceforge.net/>

Windows favorites convertor:
C<http://www.moodfarm.demon.co.uk/download/fav2html.pl>

bookmarker:
C<http://www.renaghan.com/pcr/bookmarker.html>

Columbine Bookmark Merge:
C<http://home.earthlink.net/~garycramblitt/>

XBEL Bookmarks Editor:
C<http://pyxml.sourceforge.net/topics/xbel/>

And here are similar perl modules:

L<URI::Bookmarks>

L<BabelObjects::Component::Directory::Bookmark>

L<WWW::Bookmark::Crawler>

L<Apache::XBEL>

=head1 THANK YOU

A special thank you goes to my friends on rhizo #perl for answering 
my random questions.  : )

=head1 AUTHOR

Gene Boggs E<lt>gene@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2003 by Gene Boggs

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

=cut
