[2] | 1 | #!/usr/bin/perl -w |
---|
| 2 | use strict; |
---|
| 3 | |
---|
[83] | 4 | use FindBin; |
---|
[103] | 5 | use lib "$FindBin::RealBin/../lib"; |
---|
[83] | 6 | |
---|
[2] | 7 | use YAML; |
---|
[120] | 8 | use Getopt::Long qw{GetOptions GetOptionsFromArray :config pass_through}; |
---|
[2] | 9 | |
---|
[83] | 10 | use Bookmarks; |
---|
| 11 | |
---|
[15] | 12 | GetOptions( |
---|
| 13 | 'file|f=s' => \my $DBNAME, |
---|
| 14 | ); |
---|
[2] | 15 | |
---|
[83] | 16 | my $dbname = $DBNAME || $ENV{BKMK_DBNAME}; |
---|
| 17 | die "Usage: $0 --file <dbname> <command>\n" unless $dbname; |
---|
[2] | 18 | |
---|
| 19 | my $bookmarks = Bookmarks->new({ |
---|
[120] | 20 | dbname => $dbname, |
---|
| 21 | }); |
---|
[2] | 22 | |
---|
| 23 | my $command = shift; |
---|
| 24 | |
---|
| 25 | my %action_for = ( |
---|
[47] | 26 | init => sub { |
---|
[86] | 27 | my $src_file = shift; |
---|
[47] | 28 | $bookmarks->create_tables; |
---|
[86] | 29 | load_bookmarks($src_file) if $src_file; |
---|
[47] | 30 | }, |
---|
[120] | 31 | |
---|
[2] | 32 | get => sub { |
---|
| 33 | my $identifier = shift; |
---|
[85] | 34 | my $bookmark = find_bookmark($identifier); |
---|
[91] | 35 | print $bookmark ? Dump($bookmark->to_hashref) : "Not Found\n"; |
---|
[2] | 36 | }, |
---|
[120] | 37 | |
---|
[2] | 38 | add => sub { |
---|
[120] | 39 | GetOptionsFromArray( |
---|
| 40 | \@_, |
---|
| 41 | 'title=s' => \my $TITLE, |
---|
| 42 | ); |
---|
[83] | 43 | my ($uri, @tags) = @_; |
---|
| 44 | my $title = defined $TITLE ? $TITLE : fetch_title($uri); |
---|
[2] | 45 | my $bookmark = $bookmarks->add({ uri => $uri, title => $title, tags => \@tags }); |
---|
[91] | 46 | print Dump($bookmark->to_hashref); |
---|
[2] | 47 | }, |
---|
[83] | 48 | |
---|
[14] | 49 | list => sub { |
---|
[83] | 50 | my @tags = @_; |
---|
[88] | 51 | my $resources = $bookmarks->search({ |
---|
[120] | 52 | tags => \@tags |
---|
| 53 | }); |
---|
[14] | 54 | # TODO: list by tags, date, etc. |
---|
| 55 | # TODO: coordinate this commandline script with the CGI app |
---|
[91] | 56 | print Dump([ map { $_->to_hashref } @{ $resources->results } ]); |
---|
[15] | 57 | }, |
---|
[83] | 58 | |
---|
[85] | 59 | tag => sub { |
---|
| 60 | my ($identifier, @tags) = @_; |
---|
| 61 | my $bookmark = find_bookmark($identifier); |
---|
| 62 | if ($bookmark) { |
---|
| 63 | $bookmark->tags(\@tags); |
---|
| 64 | $bookmarks->update($bookmark); |
---|
[91] | 65 | print Dump($bookmark->to_hashref); |
---|
[85] | 66 | } else { |
---|
| 67 | die "Not found\n"; |
---|
| 68 | } |
---|
| 69 | }, |
---|
| 70 | |
---|
| 71 | #TODO: interactive editing of a bookmark |
---|
| 72 | |
---|
[83] | 73 | # bulk loading |
---|
[15] | 74 | load => sub { |
---|
| 75 | my ($src_file) = @_; |
---|
[86] | 76 | load_bookmarks($src_file); |
---|
[15] | 77 | }, |
---|
[87] | 78 | |
---|
| 79 | # bulk dumping |
---|
| 80 | dump => sub { |
---|
| 81 | my ($dump_file) = @_; |
---|
[91] | 82 | my $dump = [ map { $_->to_hashref } @{ $bookmarks->search->results } ]; |
---|
[87] | 83 | $dump_file ? YAML::DumpFile($dump_file, $dump) : print Dump($dump); |
---|
| 84 | }, |
---|
[120] | 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 | }, |
---|
[2] | 117 | ); |
---|
| 118 | |
---|
| 119 | $action_for{$command}->(@ARGV); |
---|
| 120 | |
---|
[85] | 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 | |
---|
[83] | 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 | } |
---|
[86] | 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 | } |
---|