| 1 | #!/usr/bin/perl -w |
|---|
| 2 | use strict; |
|---|
| 3 | |
|---|
| 4 | use FindBin; |
|---|
| 5 | use lib "$FindBin::RealBin/../lib"; |
|---|
| 6 | |
|---|
| 7 | use YAML; |
|---|
| 8 | use Getopt::Long qw{GetOptions GetOptionsFromArray :config pass_through}; |
|---|
| 9 | |
|---|
| 10 | use Bookmarks; |
|---|
| 11 | |
|---|
| 12 | GetOptions( |
|---|
| 13 | 'file|f=s' => \my $DBNAME, |
|---|
| 14 | ); |
|---|
| 15 | |
|---|
| 16 | my $dbname = $DBNAME || $ENV{BKMK_DBNAME}; |
|---|
| 17 | die "Usage: $0 --file <dbname> <command>\n" unless $dbname; |
|---|
| 18 | |
|---|
| 19 | my $bookmarks = Bookmarks->new({ |
|---|
| 20 | dbname => $dbname, |
|---|
| 21 | }); |
|---|
| 22 | |
|---|
| 23 | my $command = shift; |
|---|
| 24 | |
|---|
| 25 | my %action_for = ( |
|---|
| 26 | init => sub { |
|---|
| 27 | my $src_file = shift; |
|---|
| 28 | $bookmarks->create_tables; |
|---|
| 29 | load_bookmarks($src_file) if $src_file; |
|---|
| 30 | }, |
|---|
| 31 | |
|---|
| 32 | get => sub { |
|---|
| 33 | my $identifier = shift; |
|---|
| 34 | my $bookmark = find_bookmark($identifier); |
|---|
| 35 | print $bookmark ? Dump($bookmark->to_hashref) : "Not Found\n"; |
|---|
| 36 | }, |
|---|
| 37 | |
|---|
| 38 | add => sub { |
|---|
| 39 | GetOptionsFromArray( |
|---|
| 40 | \@_, |
|---|
| 41 | 'title=s' => \my $TITLE, |
|---|
| 42 | ); |
|---|
| 43 | my ($uri, @tags) = @_; |
|---|
| 44 | my $title = defined $TITLE ? $TITLE : fetch_title($uri); |
|---|
| 45 | my $bookmark = $bookmarks->add({ uri => $uri, title => $title, tags => \@tags }); |
|---|
| 46 | print Dump($bookmark->to_hashref); |
|---|
| 47 | }, |
|---|
| 48 | |
|---|
| 49 | list => sub { |
|---|
| 50 | my @tags = @_; |
|---|
| 51 | my $resources = $bookmarks->search({ |
|---|
| 52 | tags => \@tags |
|---|
| 53 | }); |
|---|
| 54 | # TODO: list by tags, date, etc. |
|---|
| 55 | # TODO: coordinate this commandline script with the CGI app |
|---|
| 56 | print Dump([ map { $_->to_hashref } @{ $resources->results } ]); |
|---|
| 57 | }, |
|---|
| 58 | |
|---|
| 59 | tag => sub { |
|---|
| 60 | my ($identifier, @tags) = @_; |
|---|
| 61 | my $bookmark = find_bookmark($identifier); |
|---|
| 62 | if ($bookmark) { |
|---|
| 63 | $bookmark->tags(\@tags); |
|---|
| 64 | $bookmarks->update($bookmark); |
|---|
| 65 | print Dump($bookmark->to_hashref); |
|---|
| 66 | } else { |
|---|
| 67 | die "Not found\n"; |
|---|
| 68 | } |
|---|
| 69 | }, |
|---|
| 70 | |
|---|
| 71 | #TODO: interactive editing of a bookmark |
|---|
| 72 | |
|---|
| 73 | # bulk loading |
|---|
| 74 | load => sub { |
|---|
| 75 | my ($src_file) = @_; |
|---|
| 76 | load_bookmarks($src_file); |
|---|
| 77 | }, |
|---|
| 78 | |
|---|
| 79 | # bulk dumping |
|---|
| 80 | dump => sub { |
|---|
| 81 | my ($dump_file) = @_; |
|---|
| 82 | my $dump = [ map { $_->to_hashref } @{ $bookmarks->search->results } ]; |
|---|
| 83 | $dump_file ? YAML::DumpFile($dump_file, $dump) : print Dump($dump); |
|---|
| 84 | }, |
|---|
| 85 | |
|---|
| 86 | # scanning for current status |
|---|
| 87 | scan => sub { |
|---|
| 88 | GetOptionsFromArray( |
|---|
| 89 | \@_, |
|---|
| 90 | 'csv' => \my $CSV, |
|---|
| 91 | 'timeout=i' => \my $TIMEOUT, |
|---|
| 92 | ); |
|---|
| 93 | |
|---|
| 94 | require LWP::UserAgent; |
|---|
| 95 | require Text::CSV; |
|---|
| 96 | |
|---|
| 97 | $TIMEOUT ||= 10; |
|---|
| 98 | |
|---|
| 99 | my $ua = LWP::UserAgent->new; |
|---|
| 100 | $ua->timeout($TIMEOUT); |
|---|
| 101 | |
|---|
| 102 | my $csv = Text::CSV->new; |
|---|
| 103 | |
|---|
| 104 | for my $bookmark (@{ $bookmarks->search->results }) { |
|---|
| 105 | printf "%3d %s\n", $bookmark->id, $bookmark->uri unless $CSV; |
|---|
| 106 | my $response = $ua->head($bookmark->uri); |
|---|
| 107 | printf " -> %s\n", $response->status_line unless $CSV; |
|---|
| 108 | $csv->combine( |
|---|
| 109 | $bookmark->id, |
|---|
| 110 | $bookmark->uri, |
|---|
| 111 | $response->code, |
|---|
| 112 | $response->message, |
|---|
| 113 | ); |
|---|
| 114 | print $csv->string . "\n" if $CSV; |
|---|
| 115 | } |
|---|
| 116 | }, |
|---|
| 117 | ); |
|---|
| 118 | |
|---|
| 119 | $action_for{$command}->(@ARGV); |
|---|
| 120 | |
|---|
| 121 | sub find_bookmark { |
|---|
| 122 | my $identifier = shift; |
|---|
| 123 | my $query = $identifier =~ /^\d+$/ ? { id => $identifier } : { uri => $identifier }; |
|---|
| 124 | return $bookmarks->get_bookmark($query); |
|---|
| 125 | } |
|---|
| 126 | |
|---|
| 127 | sub fetch_title { |
|---|
| 128 | my $uri = shift; |
|---|
| 129 | require WWW::Mechanize; |
|---|
| 130 | my $mech = WWW::Mechanize->new; |
|---|
| 131 | $mech->get($uri); |
|---|
| 132 | return $mech->title || $uri; |
|---|
| 133 | } |
|---|
| 134 | |
|---|
| 135 | sub load_bookmarks { |
|---|
| 136 | my $src_file = shift; |
|---|
| 137 | my $src_bookmarks = YAML::LoadFile($src_file); |
|---|
| 138 | for my $bookmark (@{ $src_bookmarks }) { |
|---|
| 139 | $bookmarks->add($bookmark); |
|---|
| 140 | } |
|---|
| 141 | } |
|---|