—

              
package URI::Collection;
use strict;
use vars qw($VERSION);
$VERSION = '0.02';
use Carp;
use Cwd;
use File::Spec;
use File::Find;
use File::Path;
use Config::IniFiles;
use Netscape::Bookmarks;
# XXX These globals should be object attributes, instead.
# Declare our internal category/link structure.
my %cat_links;
# Declare the top level Favorites directory name holder.
my $favorites_path;
# PUBLIC METHODS
# XXX The fact that this is created as an object is just a thin veil
# XXX of appearance, so that methods can be called.  A procedural
# XXX interface would work, but just wouldn't be as shiny, IMHO.
sub new {
    my ($class, %args) = @_;
    my $self = {};
    # Handle a M$ Windows Favorites directory tree.
    if ($args{directory}) {
        $favorites_path = $args{directory};
        _traverse ($favorites_path);
    }
    # Handle a Netscape style bookmark file.
    _parse_file ($args{file}) if $args{file};
#use Data::Dumper;croak Dumper([keys %cat_links]);
    bless $self, $class;
    return $self;
}
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 %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 (@{ $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 %cat_links) {
        mkpath $path;
        chdir $path;
        # Add links to the path category.
        for my $link (@{ $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;
}
# PRIVATE FUNCTIONS
# Step over the Favorites directory and add the categories and links
# to our internal categories and links structure.
sub _traverse { 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/^$favorites_path//;
            # 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);
            # Add the category and link!
            push @{ $cat_links{$category} }, {
                title => $title,
                obj => Config::IniFiles->new (-file => "$title.url"),
            };
        }
    },
    @_
) }
# Parse the given bookmarks file into our internal categories and
# links structure.
sub _parse_file {
    # Define a Netscape bookmarks object.
    my $b = Netscape::Bookmarks->new (shift);
    # Declare our categories list and current category title.
    my (@category, $category);
    # Define the last seen level as the top.
    my $last_level = 0;
    # Define our Netscape::Bookmarks::recurse callback, which figures
    # out the category and adds links.
    my $sub = sub {
        my ($object, $level) = @_;
        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 @{ $cat_links{$category} }, {
                title => $object->title,
                obj => $object,
            };
        }
    };
    # Call the Netscape::Bookmarks recursion method.
    $b->recurse ($sub);
}
# 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__
HideShow 149 lines of Pod
=head1 NAME
URI::Collection - Input and output link collections in different
formats.
=head1 SYNOPSIS
  use URI::Collection;
  $collection = URI::Collection->new (
      file      => $bookmarks,
      directory => $favorites,
  );
  $bookmarks = $collection->as_bookmark_file (
      save_as => $file_name,
  );
  $favorites = $collection->as_favorite_directory (
      save_as => $directory_name,
  );
=head1 ABSTRACT
Input and output link collections in different formats.
=head1 DESCRIPTION
An object of class URI::Collection represents a parsed Netscape style
bookmark file or a Windows "Favorites" directory with multi-format 
output methods.
=head1 METHODS
=head2 new
  $collection = URI::Collection->new (
      file      => $bookmarks,
      directory => $favorites,
  );
Return a new URI::Collection object.
This method mashes link store formats together, simultaneously.
=head2 as_bookmark_file
  $bookmarks = $collection->as_bookmark_file (
      save_as => $file_name,
  );
Output a Netscape style bookmark file as a string with the file 
contents.
Save the bookmarks as a file to disk, if asked to.
=head2 as_favorite_directory
  $favorites = $collection->as_favorite_directory (
      save_as => $directory_name,
  );
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. 
=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
Make proper tests, damnit!
Throw out redundant links.
Optionally return the M$ Favorites directory structure (as a
variable) instead of writing it to disk.
Handle the top Favorites path better - possibly just rename the first
directory containing *.url files.
Allow input/output of file and directory handles.
Allow slicing of the category-links structure.
Add a method to munge a set of links as bookmarks or favorites after 
the constructor is called.
Allow this link munging to happen under a given category.
Check if links are active.
Update link titles and URLs if changed or moved.
Mirror links?
Handle other bookmark formats (if there even are any) and "raw" lists
of links, to justify such a generic package name.  :-)
Move the Favorites input/output functionality to a seperate module
like "URI::Favorites::IE::Windows" and "URI::Favorites::IE::Mac", or
some such.
Make a separate module for building an OmniWeb bookmark file, 
instead of naively reconstituting one as a Netscape bookmark file.
Make the internal hash structure an object attribute, instead of a 
global variable.
=head1 NOTE
Currently, this module will convert forward slashes ("/") in 
Favorite category names to an underscore character ("_").
=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>cpan@ology.netE<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