use File::Spec;
BEGIN {
- use Cwd;
- unshift(@INC, Cwd::abs_path( ($0 =~ m|^(.*?)/[^/]+$| ? $1 : '/').'/../lib/perl' ))
+ use Cwd;
+ unshift(@INC, Cwd::abs_path( ($0 =~ m|^(.*?)/[^/]+$| ? $1 : '/').'/../lib/perl' ))
}
use NB::Functions qw/html2txt/;
use NB qw/$ROOT_DIR/;
my ($NAME) = $0 =~ m,([^/]+)$,;
my $UC_NAME = uc($NAME);
my %PARAM = (
- 'format' => $ENV{$UC_NAME.'_FORMAT'} ? $ENV{$UC_NAME.'_FORMAT'} : 'csv',
- 'config.txt_errors' => $ENV{$UC_NAME.'_TXT_ERRORS'} ? $ENV{$UC_NAME.'_TXT_ERRORS'} : '1',
- 'rows_head_char' => "\r",
+ 'format' => $ENV{$UC_NAME.'_FORMAT'} ? $ENV{$UC_NAME.'_FORMAT'} : 'csv',
+ 'config.txt_errors' => $ENV{$UC_NAME.'_TXT_ERRORS'} ? $ENV{$UC_NAME.'_TXT_ERRORS'} : '1',
+ 'rows_head_char' => "\r",
);
my %CMD_ALIASE = (
my @H;
my %CURL_OPT = (
#>_SHELL_REPLACE dbq --curl_help
- 'compressed|z!' => 1, # Request compressed response (using deflate or gzip)
- 'dump-header|D=s' => undef, # FILE Write the headers to FILE
- 'get|G!' => undef, # Send the -d data with a HTTP GET (H)
- 'silent|s!' => 1, # Silent mode (don't output anything)
- 'header|H=s' => \@H, # LINE Pass custom header LINE to server (H)
- 'netrc|n!' => 1, # Must read .netrc for user name and password
- 'insecure|k!' => undef, # Allow connections to SSL sites without certs (H)
- 'user-agent|A=s' => undef, # STRING User-Agent to send to server (H)
- 'user|u=s' => undef, # USER[:PASSWORD] Server user and password
+ 'compressed|z!' => 1, # Request compressed response (using deflate or gzip)
+ 'dump-header|D=s' => undef, # FILE Write the headers to FILE
+ 'get|G!' => undef, # Send the -d data with a HTTP GET (H)
+ 'silent|s!' => 1, # Silent mode (don't output anything)
+ 'header|H=s' => \@H, # LINE Pass custom header LINE to server (H)
+ 'netrc|n!' => 1, # Must read .netrc for user name and password
+ 'insecure|k!' => undef, # Allow connections to SSL sites without certs (H)
+ 'user-agent|A=s' => undef, # STRING User-Agent to send to server (H)
+ 'user|u=s' => undef, # USER[:PASSWORD] Server user and password
#<_SHELL_REPLACE
);
my @CURL_OPT = keys %CURL_OPT;
# DBQ
if ($ENV{$UC_NAME}) {
- for (split(' ',$ENV{$UC_NAME})) {
- /^(\w+)=(.*?)$/ and $PARAM{$1} = $2;
- }
+ for (split(' ',$ENV{$UC_NAME})) {
+ /^(\w+)=(.*?)$/ and $PARAM{$1} = $2;
+ }
}
# DBQ_PARAMS
if ($ENV{$UC_NAME.'_PARAMS'}) {
- for (split(' ',$ENV{$UC_NAME.'_PARAMS'})) {
- /^(\w+)=(.*?)$/ and $PARAM{$1} = $2;
- }
+ for (split(' ',$ENV{$UC_NAME.'_PARAMS'})) {
+ /^(\w+)=(.*?)$/ and $PARAM{$1} = $2;
+ }
}
-
#
-# Get URL
+# File default
#
-#-e $ROOT_DIR.'/lib/php/db/index.php' && die 'OK';
my $url = ($ENV{$UC_NAME.'_URL'} ? $ENV{$UC_NAME.'_URL'} :
- ( -e $ROOT_DIR.'/lib/php/db/dbq.php' ? $ROOT_DIR.'/lib/php/db/dbq.php' : '' )
+ ( -e $ROOT_DIR.'/lib/php/db/dbq.php' ? $ROOT_DIR.'/lib/php/db/dbq.php' : '' )
);
-# /url/... with no domain
+#
+# Http /url/... with no domain
+#
if (!$Opt{ssh} and @ARGV and $ARGV[0] =~ m|^/|) {
- $url = 'https://api.nbdom.net'.shift(@ARGV);
- @EXEC = grep {$_ ne $url} @EXEC;
+ $url = 'https://api.nbdom.net'.shift(@ARGV);
+ @EXEC = grep {$_ ne $url} @EXEC;
}
-if (!$Opt{ssh} and @ARGV and ($ARGV[0] =~ m|^\w+://| or -e $ARGV[0] )) {
- $url = shift @ARGV;
- @EXEC = grep {$_ ne $url} @EXEC;
+#
+# Http, ssh or file
+#
+if (!$Opt{ssh} and @ARGV and ($ARGV[0] =~ m|^\w+://| or -f $ARGV[0] )) {
+ $url = shift @ARGV;
+ @EXEC = grep {$_ ne $url} @EXEC;
}
-#die $Opt{ssh};
-#exec('ssh',$ARGV[0] && shift @ARGV,$NAME,@ARGV) if @ARGV and $ARGV[0] eq '--ssh' and shift @ARGV;
#
-# Handle format proto://db.table@hosts
+# Url Handle format proto://db.table@hosts
#
$url =~ s,^(\w+://)?([^@]+)@(.*?)$,$1$3, and push(@EXEC,"db=$2");
#
-# Proto SSH
+# Url Proto SSH
#
$url =~ m@^ssh://(.*)$@ and $Opt{ssh} = $1;
-#die "$url | ",join(' ',@EXEC);
#exec('ssh',$Opt{ssh},". /etc/profile && $NAME",map{s/"/\\"/g;'"'.$_.'"'} grep {$_ !~ /^(-+ssh|$Opt{ssh})/} @EXEC) if $Opt{ssh};
exec('ssh',
- $Opt{pipe} ? '-q' : '-t',
- #'-q',
- $Opt{ssh},
- '/usr/bin/env',
- "PATH=$ENV{PATH}",
- "PERL5LIB=$ENV{PERL5LIB}",
- $NAME,
- map{s/"/\\"/g;'"'.$_.'"'} grep {$_ !~ /^(-+ssh|$Opt{ssh})/} @EXEC
+ $Opt{pipe} ? '-q' : '-t',
+ #'-q',
+ $Opt{ssh},
+ '/usr/bin/env',
+ "PATH=$ENV{PATH}",
+ "PERL5LIB=$ENV{PERL5LIB}",
+ $NAME,
+ map{s/"/\\"/g;'"'.$_.'"'} grep {$_ !~ /^(-+ssh|$Opt{ssh})/} @EXEC
) if $Opt{ssh};
#
# Add options to ARGV
#
for my $o (@CURL_OPT) {
- $o =~ s/\|.*$//;
- next unless $Opt{$o};
- if (ref($Opt{$o}) eq 'ARRAY') {
- push(@ARGV,map{ ("--$o",$_) } @{$Opt{$o}});
+ $o =~ s/\|.*$//;
+ next unless $Opt{$o};
+ if (ref($Opt{$o}) eq 'ARRAY') {
+ push(@ARGV,map{ ("--$o",$_) } @{$Opt{$o}});
- } elsif ($Opt{$o} ne '1') {
- push @ARGV,"--$o",$Opt{$o};
+ } elsif ($Opt{$o} ne '1') {
+ push @ARGV,"--$o",$Opt{$o};
- } else {
- push @ARGV,"--$o";
- }
+ } else {
+ push @ARGV,"--$o";
+ }
}
#
push (@cmd,$_) if $VERBOSE and ($_ = '-'.'v'x($VERBOSE-1) ) ne '-';
while ($_ = shift @ARGV) {
- if (/^([\w\._:-]+)=(.*)$/) {
- $keys{($CMD_ALIASE{$1} ? $CMD_ALIASE{$1} : $1)} = $2;
- } else {
- push(@cmd,$_);
- }
+ if (/^([\w\._:-]+)=(.*)$/) {
+ $keys{($CMD_ALIASE{$1} ? $CMD_ALIASE{$1} : $1)} = $2;
+ } else {
+ push(@cmd,$_);
+ }
}
# Defaults Params
#
while (my ($k,$v) = each %PARAM) {
- next if $keys{$k};
- $keys{$k} = $v;
+ next if $keys{$k};
+ $keys{$k} = $v;
}
#################################################################################
#
# Parser
#
-if ($Opt{cut}) {
- open(STDOUT,"|cut -f $Opt{cut}".($keys{sep} ? " -d '$keys{sep}'" : ''));
- $keys{format} = 'csv';
- $keys{header} = '0' unless defined $keys{header};
+if ( $Opt{cut} ) {
+ open(STDOUT,"|cut -f $Opt{cut}".($keys{sep} ? " -d '$keys{sep}'" : ''));
+ $keys{format} = 'csv';
+ $keys{header} = '0' unless defined $keys{header};
-} elsif (!defined $keys{format}) {
-} elsif ($keys{format} eq 'nc') {
- $keys{format} = 'csv';
- open(STDOUT,"|$0 --parse_debug|$0 --csv2txt ".( ( defined($keys{header}) ? $keys{header} : '') eq '0' ? '1' : '0'))
+} elsif ( !defined $keys{format} ) {
+} elsif ( $keys{format} eq 'nc' ) {
+ $keys{format} = 'csv';
+ open(STDOUT,"|$0 --parse_debug|$0 --csv2txt ".( ( defined($keys{header}) ? $keys{header} : '') eq '0' ? '1' : '0'))
} elsif ( $keys{format} eq 'jq' ) {
- $keys{format} = 'json';
- open(STDOUT,"|$0 --parse_debug|jq .")
+ $keys{format} = 'json';
+ open(STDOUT,"|$0 --parse_debug|jq .")
} elsif ( $keys{debug} or $Opt{debug} ) {
- open(STDOUT,"|$0 --parse_debug")
+ open(STDOUT,"|$0 --parse_debug")
}
#use Data::Dumper; die Dumper(\@cmd,\%keys);
# Choice http / php
#
if (-e $url) {
- @cmd = ('php','-f',$url);
+ @cmd = ('php','-f',$url);
# Push key=value
push(@cmd,map {$_.'='.$keys{$_}} sort keys %keys);
} elsif($url) {
- @cmd = ('curl', $url, @cmd);
+ @cmd = ('curl', $url, @cmd);
# Push key=value
push(@cmd,map {('--data-binary',uri_esc($_).'='.uri_esc($keys{$_}))} sort keys %keys);
warn "$NAME: Command: ",join(" ",map{/\s+/ ? '"'.$_.'"' : $_} grep {!/^rows_head_char=/} @cmd),"\n" if $VERBOSE;
if ($Opt{debug} and $Opt{debug} > 1) {
- print STDERR join(' ',@cmd)."\n";
- exit;
+ print STDERR join(' ',@cmd)."\n";
+ exit;
}
#use Data::Dumper; warn(Dumper(\@cmd));
$_ = system(@cmd);
#
#################################################################################
sub parse_debug {
- while (<>) {
+ while (<>) {
- if (/^(DEBUG|INFO|WARN|ERR|BYE): /) { print STDERR $_ }
- elsif ( /^<pre class="[^"]*err">/) { print STDERR uc($1).': '.html2txt($_) }
- elsif ( /^(<\w+>)?Fatal error/ .. /^\s+thrown in/) { print STDERR html2txt($_) }
- elsif ( /^(<\s*\w+\s*\/?>)?(Parse error|Fatal error|Warning|Notice|$)/) { print STDERR $_ if ($_=html2txt($_)) and $_ !~ /^\s*$/ }
- else { print $_ }
+ if (/^(DEBUG|INFO|WARN|ERR|BYE): /) { print STDERR $_ }
+
elsif ( /^<pre class="[^"]*err">/) { print STDERR uc($1).': '.html2txt($_) }
+ elsif ( /^(<\w+>)?Fatal error/ .. /^\s+thrown in/) { print STDERR html2txt($_) }
+ elsif ( /^(<\s*\w+\s*\/?>)?(Parse error|Fatal error|Warning|Notice|$)/) { print STDERR $_ if ($_=html2txt($_)) and $_ !~ /^\s*$/ }
+ else { print $_ }
- }
- exit;
+ }
+ exit;
}
sub csv2txt {
- # sprintf missing argument warning message ????
- # Can't open XXX: No such file or directory
- no warnings;
-
- my $sep = shift;
- my $noheader = shift;
- my @lines = ();
- my $l;
-
- #
- # Store lines and lengths in memory
- #
+ # sprintf missing argument warning message ????
+ # Can't open XXX: No such file or directory
+ no warnings;
+
+ my $sep = shift;
+ my $noheader = shift;
+ my @lines = ();
+ my $l;
+
+ #
+ # Store lines and lengths in memory
+ #
while (<>) {
- chomp($_);
+ chomp($_);
my @F = split($sep,$_);
for (my $i=0;$i<@F;$i++) {
push @lines, [@F];
}
- exit unless @lines;
+ exit unless @lines;
- #
- # Print pretty
- #
- binmode( STDOUT, "utf8:" );
+ #
+ # Print pretty
+ #
+ binmode( STDOUT, "utf8:" );
- csv2txt_next:
+ csv2txt_next:
- my @len = ();
- #warn @{$lines[0]};
- my $count=0;
+ my @len = ();
+ #warn @{$lines[0]};
+ my $count=0;
for (@lines) {
- my @F = @$_;
- last if $count and @F and $F[0] =~/$PARAM{'rows_head_char'}/;
- $count++;
+ my @F = @$_;
+ last if $count and @F and $F[0] =~/$PARAM{'rows_head_char'}/;
+ $count++;
for (my $i=0;$i<@F;$i++) {
$len[$i] = length($F[$i]) unless defined $len[$i];
$len[$i] = $l if ( $l = length($F[$i]) ) >= $len[$i];
- }
- }
+ }
+ }
#die map { join(' | ',@$_)."\n" } @lines;
- my $i = 0;
- my $t = -1;
- my $format = "| ".join(" | ",map {$t+=$_+3; "\%-".$_."s"} @len)." |".chr(10);
- my $sep_line = "+".join("+",map {("-"x($_+2))} @len)."+".chr(10);
- my $tot = @lines - ($noheader ? 0 : 1);
- #use Data::Dumper; warn Dumper(\@lines);
- exit unless $tot;
-
- print $sep_line;
-
- sub csv_end {
- print $sep_line if $tot;
- print "$tot Records\n";
- }
-
- while ($_ = shift @lines) {
- if ($_->[0] =~ s/^\r// and $i) {
- csv_end();
- print "\n";
- unshift @lines,$_;
- goto csv2txt_next;
- }
- printf $format,@$_;
- print $sep_line if !$noheader and !$i++;
- }
-
- csv_end();
- exit;
+ my $i = 0;
+ my $t = -1;
+ my $format = "| ".join(" | ",map {$t+=$_+3; "\%-".$_."s"} @len)." |".chr(10);
+ my $sep_line = "+".join("+",map {("-"x($_+2))} @len)."+".chr(10);
+ my $tot = @lines - ($noheader ? 0 : 1);
+ #use Data::Dumper; warn Dumper(\@lines);
+ exit unless $tot;
+
+ print $sep_line;
+
+ sub csv_end {
+ print $sep_line if $tot;
+ print "$tot Records\n";
+ }
+
+ while ($_ = shift @lines) {
+ if ($_->[0] =~ s/^\r// and $i) {
+ csv_end();
+ print "\n";
+ unshift @lines,$_;
+ goto csv2txt_next;
+ }
+ printf $format,@$_;
+ print $sep_line if !$noheader and !$i++;
+ }
+
+ csv_end();
+ exit;
}
sub uri_esc {
- return URI::Escape::uri_escape($_[0]);
+ return URI::Escape::uri_escape($_[0]);
local $_=shift;s/([^A-Za-z0-9])/sprintf("%%%02X", ord($1))/seg;
return $_;
};
$main::_DATA_ =~ s/([@\$][A-Z_a-z\{\}]+)/pod_env($1)/eg;
# Create tmp
- my $in_file = (-e '/dev/shm' ? '/dev/shm' : '/tmp')."/$NAME.$$";
- my $in;
- open($in,">$in_file") or die "$NAME: Can't write into $in_file: $!";
- print $in $main::_DATA_;
+ my $in_file = (-e '/dev/shm' ? '/dev/shm' : '/tmp')."/$NAME.$$";
+ my $in;
+ open($in,">$in_file") or die "$NAME: Can't write into $in_file: $!";
+ print $in $main::_DATA_;
close $in;
# Output
- open(STDOUT,"|perl -pe 's/\.$$//g'".(($ENV{PAGER}||'') eq 'less' ? "|less -FRi" : ""));
+ open(STDOUT,"|perl -pe 's/\.$$//g'".(($ENV{PAGER}||'') eq 'less' ? "|less -FRi" : ""));
my $opts = {
-input => $in_file,
-ouput => \*STDOUT,
};
Pod::Usage::pod2usage($opts);
- close STDOUT;
- unlink $in_file if $in_file and -e $in_file;
+ close STDOUT;
+ unlink $in_file if $in_file and -e $in_file;
exit 0;
}
#------------------------------------------------------------------------------
sub get_options {
- my $Opt = $_[0]; #shift @_;
- my $default = $_[1]; #shift @_;
+ my $Opt = $_[0]; #shift @_;
+ my $default = $_[1]; #shift @_;
use Getopt::Long qw(:config no_ignore_case no_auto_abbrev);
#my @Opt = @_>1 ? @{$_[1]} : ();
my @Opt = $default ? @$default : ();
- #use Data::Dumper; die Dumper(@Opt);
+ #use Data::Dumper; die Dumper(@Opt);
sub pod_opt {
local $_;
my $o = shift;
$main::VERBOSE = $VERBOSE = $Opt->{'verbose'} if defined $_[0]{'verbose'};
$main::DEBUG = $DEBUG = $Opt->{'debug'} if defined $_[0]{'debug'};
- $Opt{pipe} = -t STDOUT ? 0 : 1 unless defined $Opt{pipe};
+ $Opt{pipe} = -t STDOUT ? 0 : 1 unless defined $Opt{pipe};
}
sub curl_help {
- open(CURL,'curl --help |') or die "Can't run curl";
- my $o = $CURL_OPT_EXP;
- while (<CURL>) {
- #print $_;
- #/^\s*(?:-(\w+),\s*)?--([\w-]+)(.*?)\$/ or next;
- @_ = /(?:-(\w+).*?)?--($o)\s+(.*?)$/ or next;
- #warn $_;
- push(@_,'') if @_<3; $_[0] = '' unless $_[0];
- $_[1] .= '|' if $_[0];
-
- my $type = '!';
- $type = '=s' if $_[2] =~ /^[A-Z]{2,}/;
- #print "=item B<option[$_[1]$_[0]$type]> $_[2]\n\n";
- print "'$_[1]$_[0]$type' => undef, # $_[2]\n";
- }
- close CURL;
- exit;
+ open(CURL,'curl --help |') or die "Can't run curl";
+ my $o = $CURL_OPT_EXP;
+ while (<CURL>) {
+ #print $_;
+ @_ = /(?:-(\w+).*?)?--($o)\s+(.*?)$/ or next;
+ push(@_,'') if @_<3; $_[0] = '' unless $_[0];
+ $_[1] .= '|' if $_[0];
+
+ my $type = '!';
+ $type = '=s' if $_[2] =~ /^[A-Z]{2,}/;
+ #print "=item B<option[$_[1]$_[0]$type]> $_[2]\n\n";
+ print "'$_[1]$_[0]$type' => undef, # $_[2]\n";
+ }
+ close CURL;
+ exit;
}
__DATA__
Value understand patterns:
- - *PATTERN*
- - ~REGEX
- - ![PATTERN|REGEX]
+ - *PATTERN*
+ - ~REGEX
+ - ![PATTERN|REGEX]
=head1 OPTIONS
curl's OPTIONS:
- --compressed, -z Request compressed response (using deflate or gzip) (default: 1)
- --dump-header, -D FILE Write the headers to FILE
- --get, -G Send the -d data with a HTTP GET (H)
- --silent, -s Silent mode (don't output anything)
- --header, -H LINE Pass custom header LINE to server (H) (default: 1)
- --netrc, -n Must read .netrc for user name and password
- --insecure, -k Allow connections to SSL sites without certs (H)
- --user-agent, -A STRING User-Agent to send to server (H)
- --user, -u=s USER[:PASSWORD] Server user and password
+ --compressed, -z Request compressed response (using deflate or gzip) (default: 1)
+ --dump-header, -D FILE Write the headers to FILE
+ --get, -G Send the -d data with a HTTP GET (H)
+ --silent, -s Silent mode (don't output anything)
+ --header, -H LINE Pass custom header LINE to server (H) (default: 1)
+ --netrc, -n Must read .netrc for user name and password
+ --insecure, -k Allow connections to SSL sites without certs (H)
+ --user-agent, -A STRING User-Agent to send to server (H)
+ --user, -u=s USER[:PASSWORD] Server user and password
=cut
=head1 EXAMPLES
Convert a database into sqlite:
- dbq f=text a=db.dump db=wp db.type=sqlite | sqlite3 db.sqlite
+
+ dbq f=text a=db.dump db=wp db.type=sqlite | sqlite3 db.sqlite
+ dbq /URL
+ dbq PROTO://DOMAIN/URL
=head1 REQUIRES
=head1 COPYRIGHT AND LICENSE
+Copyright (C) 2017 Nicolas Boisselier
-=head1 SEE ALSO
+This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version.
-perl(1), http://perldoc.perl.org/perlpodstyle.html
+See <http://www.gnu.org/licenses/>.
=head1 AUTHOR
-
+Nicolas Boisselier <nicolas.boisselier@gmail.com>
=cut
projects / nb.git / commitdiff