|
| 1 | +#! /usr/bin/perl |
| 2 | +# ex:ts=8 sw=4: |
| 3 | +# |
| 4 | +# Copyright (c) 2019-2022 Aaron Beiber <[email protected]> |
| 5 | +# Copyright (c) 2010 Marc Espie <[email protected]> |
| 6 | +# |
| 7 | +# Permission to use, copy, modify, and distribute this software for any |
| 8 | +# purpose with or without fee is hereby granted, provided that the above |
| 9 | +# copyright notice and this permission notice appear in all copies. |
| 10 | +# |
| 11 | +# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES |
| 12 | +# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF |
| 13 | +# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR |
| 14 | +# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES |
| 15 | +# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN |
| 16 | +# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF |
| 17 | +# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. |
| 18 | + |
| 19 | +use strict; |
| 20 | +use warnings; |
| 21 | +use DBI; |
| 22 | + |
| 23 | +$| = 1; |
| 24 | + |
| 25 | +my @l = qw(add check create delete info search pkgname); |
| 26 | +my %a = ( |
| 27 | + "install" => "add", |
| 28 | + "i" => "add", |
| 29 | + "rm" => "delete", |
| 30 | + "del" => "delete", |
| 31 | + |
| 32 | + "inf" => "info", |
| 33 | + "s" => "search", |
| 34 | + "pi" => "pathinfo" |
| 35 | +); |
| 36 | + |
| 37 | +my $srcDBfile = '/usr/local/share/sqlports'; |
| 38 | +my $dbfile = '/tmp/sqlports.fts'; |
| 39 | +my $dbh; |
| 40 | + |
| 41 | +sub run_sql { |
| 42 | + my ( $dbh, $sql ) = @_; |
| 43 | + |
| 44 | + my $sth = $dbh->prepare($sql) or die $dbh->errstr . "\n$sql\n"; |
| 45 | + $sth->execute() or die $dbh->errstr; |
| 46 | + return $sth; |
| 47 | +} |
| 48 | + |
| 49 | +if ( !-e $dbfile ) { |
| 50 | + print STDERR "Creating full text database..."; |
| 51 | + my $dbh = DBI->connect( "dbi:SQLite:dbname=:memory:", "", "" ); |
| 52 | + $dbh->sqlite_backup_from_file($srcDBfile) |
| 53 | + or die "Can't copy sqlports to memory!"; |
| 54 | + run_sql( |
| 55 | + $dbh, q{ |
| 56 | + CREATE VIRTUAL TABLE |
| 57 | + ports_fts |
| 58 | + USING fts5( |
| 59 | + FULLPKGNAME, |
| 60 | + FULLPKGPATH, |
| 61 | + COMMENT, |
| 62 | + DESCRIPTION); |
| 63 | + } |
| 64 | + ); |
| 65 | + run_sql( |
| 66 | + $dbh, q{ |
| 67 | + INSERT INTO |
| 68 | + ports_fts |
| 69 | + (FULLPKGNAME, FULLPKGPATH, COMMENT, DESCRIPTION) |
| 70 | + select |
| 71 | + FULLPKGNAME, |
| 72 | + FULLPKGPATH, |
| 73 | + COMMENT, |
| 74 | + DESCR_CONTENTS |
| 75 | + FROM Ports; |
| 76 | + } |
| 77 | + ); |
| 78 | + |
| 79 | + $dbh->sqlite_backup_to_file($dbfile) |
| 80 | + or die "Can't copy sqlports to memory!"; |
| 81 | + $dbh->disconnect(); |
| 82 | + print STDERR "Done.\n"; |
| 83 | +} |
| 84 | + |
| 85 | +$dbh = DBI->connect( "dbi:SQLite:dbname=$dbfile", "", "" ); |
| 86 | + |
| 87 | +sub run { |
| 88 | + my ( $cmd, $name ) = @_; |
| 89 | + my $module = "OpenBSD::Pkg\u$cmd"; |
| 90 | + eval "require $module;"; |
| 91 | + if ($@) { |
| 92 | + die $@; |
| 93 | + } |
| 94 | + exit( $module->parse_and_run($name) ); |
| 95 | +} |
| 96 | + |
| 97 | +for my $i (@l) { |
| 98 | + if ( $0 =~ m/\/?pkg_$i$/ ) { |
| 99 | + run( $i, "pkg_$i" ); |
| 100 | + } |
| 101 | +} |
| 102 | + |
| 103 | +if (@ARGV) { |
| 104 | + for my $i (@l) { |
| 105 | + $ARGV[0] = $a{ $ARGV[0] } if defined $a{ $ARGV[0] }; |
| 106 | + if ( $ARGV[0] eq $i ) { |
| 107 | + shift; |
| 108 | + if ( $i eq "info" ) { |
| 109 | + |
| 110 | + # Take a FULLPKGNAME and return DESCR_CONTENTS and COMMENT |
| 111 | + my $ssth = $dbh->prepare( |
| 112 | + q{ |
| 113 | + SELECT |
| 114 | + COMMENT, |
| 115 | + DESCRIPTION |
| 116 | + FROM ports_fts |
| 117 | + WHERE |
| 118 | + FULLPKGNAME = ?; |
| 119 | + } |
| 120 | + ); |
| 121 | + $ssth->bind_param( 1, join( " ", @ARGV ) ); |
| 122 | + $ssth->execute(); |
| 123 | + while ( my $row = $ssth->fetchrow_hashref ) { |
| 124 | + print "Comment:\n$row->{COMMENT}\n\n"; |
| 125 | + print "Description:\n$row->{DESCRIPTION}\n"; |
| 126 | + } |
| 127 | + exit(); |
| 128 | + } |
| 129 | + if ( $i eq "search" ) { |
| 130 | + |
| 131 | + # TODO: what would be a better UX for displaying this stuff? |
| 132 | + my $ssth = $dbh->prepare( |
| 133 | + q{ |
| 134 | + SELECT |
| 135 | + FULLPKGNAME, |
| 136 | + FULLPKGPATH, |
| 137 | + COMMENT, |
| 138 | + DESCRIPTION, |
| 139 | + highlight(ports_fts, 1, '[', ']') AS COMMENT_MATCH, |
| 140 | + highlight(ports_fts, 2, '[', ']') AS DESCR_MATCH |
| 141 | + FROM ports_fts |
| 142 | + WHERE ports_fts MATCH ? ORDER BY rank; |
| 143 | + } |
| 144 | + ); |
| 145 | + $ssth->bind_param( 1, join( " ", @ARGV ) ); |
| 146 | + $ssth->execute(); |
| 147 | + while ( my $row = $ssth->fetchrow_hashref ) { |
| 148 | + print "$row->{FULLPKGNAME}\n"; |
| 149 | + } |
| 150 | + exit(); |
| 151 | + } |
| 152 | + else { |
| 153 | + run( $i, "pkg $i" ); |
| 154 | + } |
| 155 | + } |
| 156 | + } |
| 157 | +} |
| 158 | + |
| 159 | +print STDERR "Usage: pkg [", join( "|", @l ), "] [args]\n"; |
| 160 | +exit(1); |
0 commit comments