1#!/usr/bin/perl -w 2 3use strict; 4 5=head1 NAME 6 7make-zsh-urls -- create F<~/.zsh/urls> hierarchy 8 9=head1 SYNOPSIS 10 11% make-zsh-urls [B<OPTION>] ... 12 13=head1 DESCRIPTION 14 15make-zsh-urls creates a hierarchy of files and directories under 16F<~/.zsh/urls> for use by the _urls completion function in the new 17completion system of zsh 3.1.6 and higher. 18 19It needs the B<URI::Bookmarks> suite of modules to run, which are 20available from CPAN, the Comprehensive Perl Archive Network. 21See B<http://www.perl.com/cpan> or L<CPAN> for more information. 22 23The following options are available: 24 25B<--output-dir>, B<-o> Specify the output directory for the 26 hierarchy. Defaults to F<~/.zsh/urls>. 27 28B<--input-file>, B<-i> Specify the input bookmarks file. 29 Defaults to F<~/.netscape/bookmarks.html>. 30 31B<--root-node>, B<-r> Specify which folder contains the 32 bookmarks which the hierarchy will be 33 created from. Defaults to the root 34 of the bookmark collection tree. 35 36=cut 37 38use Getopt::Long; 39use URI::Bookmarks::Netscape; 40use URI; 41 42my ($out_dir, $input_file, $root_name, $help); 43GetOptions('output-dir|o=s' => \$out_dir, 44 'input-file|i=s' => \$input_file, 45 'root-node|r=s' => \$root_name, 46 'help|h' => \$help) 47 or usage(); 48 49usage() if $help; 50 51$out_dir ||= "$ENV{HOME}/.zsh/urls"; 52$input_file ||= "$ENV{HOME}/.netscape/bookmarks.html"; 53 54my $bookmarks = 55 new URI::Bookmarks(file => $input_file); 56 57my $root = $bookmarks->tree_root(); 58if ($root_name) { 59 my @root_nodes = $bookmarks->name_to_nodes($root_name); 60 if (@root_nodes == 0) { 61 die "Couldn't find any nodes with name `$root_name'; aborting.\n"; 62 } 63 else { 64 if (@root_nodes > 1) { 65 warn "Found more than one node with name `$root_name'; " . 66 "taking first occurrence.\n"; 67 } 68 $root = $root_nodes[0]; 69 } 70} 71 72my @bookmark_path = (); 73$root->walk_down({callback => \&pre_callback, 74 callbackback => \&post_callback}); 75 76sub pre_callback { 77 my ($node, $options) = @_; 78 79 my $depth = $options->{_depth} || 0; 80 my $name = $node->name; 81 my $type = $node->type; 82 83 if ($type eq 'bookmark') { 84 my $url = $node->attribute->{'HREF'}; 85 86 # Type A 87 my $full = $url; 88 $full =~ s@^(https?|ftp|gopher)://@"\L$1/"@ei; 89 $full =~ s@file:@@i; 90 my ($path, $file) = $full =~ m@(.+)/(.*)@; 91 # This is horribly inefficient but I'm too lazy to reimplement mkdir -p 92 # Why isn't there a CPAN module for it? 93 system '/bin/mkdir', '-p', "$out_dir/$path" unless -d "$out_dir/$path"; 94 system 'touch', "$out_dir/$path" unless $full eq "$path/"; 95 96 # Type B 97 $name =~ s@/@-@g; 98 my $bookmark_file = "$out_dir/bookmark/" . 99 (join '/', @bookmark_path) . 100 "/$name"; 101 open(BOOKMARK, ">$bookmark_file") or die "open >$bookmark_file: $!"; 102 print BOOKMARK $url, "\n"; 103 close(BOOKMARK) or die $!; 104 } 105 elsif ($type eq 'folder' && $depth > 0) { 106 print +(' ' x ($depth - 1)), "Processing folder `$name' ...\n"; 107 push @bookmark_path, $name; 108 109 # Type B 110 system '/bin/mkdir', 111 '-p', 112 "$out_dir/bookmark/" . 113 (join '/', @bookmark_path); 114 } 115 116 return 1; 117} 118 119sub post_callback { 120 my ($node, $options) = @_; 121 122 my $type = $node->type; 123 124 if ($type eq 'folder') { 125 my $name = pop @bookmark_path; 126 } 127} 128 129sub usage { 130 print <<EOF; 131Usage: make-zsh-urls [OPTION] ... 132 --help, -h Display this help. 133 --output-dir, -o Specify the output directory for the hierarchy. 134 Defaults to ~/.zsh/urls. 135 --input-file, -i Specify the input bookmarks file. 136 Defaults to ~/.netscape/bookmarks.html. 137 --root-node, -r Specify which folder contains the bookmarks which 138 the hierarchy will be created from. Defaults to 139 the root of the bookmark collection tree. 140EOF 141 exit 0; 142} 143 144 145=head1 AUTHOR 146 147 Adam Spiers <adam@spiers.net> 148 149=head1 COPYRIGHT 150 151 Copyright (c) 1999 Adam Spiers <adam@spiers.net>. All rights 152 reserved. This program is free software; you can redistribute it and/or 153 modify it under the same terms as Perl or zsh. 154 155=cut 156