App-reposdb
view release on metacpan or search on metacpan
script/_reposdb-inline view on Meta::CPAN
defined($toc_line)
or die "Unexpected end of data section while reading TOC line #$i";
chomp($toc_line);
$toc_line =~ /\S/ or last;
$toc_line =~ /^([^,]+),(\d+),(\d+)(?:,(.*))?$/
or die "Invalid TOC line #$i in data section: $toc_line";
$toc{$1} = [$2, $3, $4];
}
my $pos = tell $fh;
$toc{$_}[0] += $pos for keys %toc;
# calculate the line number of data section
my $data_pos = tell(DATA);
seek DATA, 0, 0;
my $pos = 0;
while (1) {
my $line = <DATA>;
$pos += length($line);
$data_linepos++;
last if $pos >= $data_pos;
}
seek DATA, $data_pos, 0;
\%toc;
};
if ($toc->{$_[1]}) {
seek DATA, $toc->{$_[1]}[0], 0;
read DATA, my($content), $toc->{$_[1]}[1];
my ($order, $lineoffset) = split(';', $toc->{$_[1]}[2]);
$content =~ s/^#//gm;
$content = "# line ".($data_linepos + $order+1 + $lineoffset)." \"".__FILE__."\"\n" . $content;
open my $fh, '<', \$content
or die "DataPacker error loading $_[1]: $!";
return $fh;
}
return;
};
}
# END DATAPACK CODE
# Note: This completer script is generated by App::GenPericmdCompleterScript version 0.122
# on Sat Oct 10 19:58:23 2020. You probably should not manually edit this file.
# NO_PERINCI_CMDLINE_SCRIPT
# PERINCI_CMDLINE_COMPLETER_SCRIPT: {program_name=>"reposdb-inline",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>{ls=>"/App/reposdb/list_repos","remove-all-tags"=>"/App/reposdb/remove_all_repo_tags","remove-tag"=>"/App/reposdb/remove_re...
# FRAGMENT id=shcompgen-hint completer=1 for=reposdb-inline
our $DATE = '2020-10-10'; # DATE
our $VERSION = '0.007'; # VERSION
# PODNAME: _reposdb-inline
# ABSTRACT: Completer script for reposdb-inline
use 5.010;
use strict;
use warnings;
die "Please run this script under shell completion\n" unless $ENV{COMP_LINE} || $ENV{COMMAND_LINE};
my $args = {program_name=>"reposdb-inline",read_config=>0,read_env=>0,skip_format=>undef,subcommands=>{ls=>"/App/reposdb/list_repos","remove-all-tags"=>"/App/reposdb/remove_all_repo_tags","remove-tag"=>"/App/reposdb/remove_repo_tag",touch=>"/App/repo...
my $meta = {_orig_args_as=>undef,_orig_result_naked=>undef,args_as=>"hash",description=>"\n`repos.db` is a SQLite database that lists repository names along with some\nextra data. They have various uses, but my first use-case for this is to store\nla...
my $sc_metas = do{my$a={ls=>{_orig_args_as=>undef,_orig_result_naked=>undef,args=>{detail=>{cmdline_aliases=>{l=>{}},schema=>["bool",{},{}],tags=>["category:field-selection"]},has_tags=>{element_completion=>sub{package App::reposdb;use warnings;use s...
my $copts = {format=>{default=>undef,getopt=>"format=s",handler=>sub{package Perinci::CmdLine::Base;use warnings;use strict;no feature;use feature ':5.10';my($go, $val, $r) = @_;$$r{'format'} = $val},is_settable_via_config=>1,schema=>["str*","in",["t...
my $r = {};
# get words
my $shell;
my ($words, $cword);
if ($ENV{COMP_LINE}) { $shell = "bash"; require Complete::Bash; require Encode; ($words,$cword) = @{ Complete::Bash::parse_cmdline() }; ($words,$cword) = @{ Complete::Bash::join_wordbreak_words($words,$cword) }; $words = [map {Encode::decode("UTF-8",...
elsif ($ENV{COMMAND_LINE}) { $shell = "tcsh"; require Complete::Tcsh; ($words,$cword) = @{ Complete::Tcsh::parse_cmdline() }; }
@ARGV = @$words;
# strip program name
shift @$words; $cword--;
# parse common_opts which potentially sets subcommand
{
require Getopt::Long;
my $old_go_conf = Getopt::Long::Configure('pass_through', 'no_ignore_case', 'bundling', 'no_auto_abbrev', 'no_getopt_compat', 'gnu_compat');
my @go_spec;
for my $k (keys %$copts) { push @go_spec, $copts->{$k}{getopt} => sub { my ($go, $val) = @_; $copts->{$k}{handler}->($go, $val, $r); } }
Getopt::Long::GetOptions(@go_spec);
Getopt::Long::Configure($old_go_conf);
}
# select subcommand
my $scn = $r->{subcommand_name};
my $scn_from = $r->{subcommand_name_from};
if (!defined($scn) && defined($args->{default_subcommand})) {
# get from default_subcommand
if ($args->{get_subcommand_from_arg} == 1) {
$scn = $args->{default_subcommand};
$scn_from = "default_subcommand";
} elsif ($args->{get_subcommand_from_arg} == 2 && !@ARGV) {
$scn = $args->{default_subcommand};
$scn_from = "default_subcommand";
}
}
if (!defined($scn) && $args->{subcommands} && @ARGV) {
# get from first command-line arg
$scn = shift @ARGV;
$scn_from = "arg";
}
if (defined($scn) && !$sc_metas->{$scn}) { undef $scn } # unknown subcommand name
# XXX read_env
# complete with periscomp
my $compres;
{
require Perinci::Sub::Complete;
$compres = Perinci::Sub::Complete::complete_cli_arg(
meta => defined($scn) ? $sc_metas->{$scn} : $meta,
words => $words,
cword => $cword,
common_opts => $copts,
riap_server_url => undef,
riap_uri => undef,
script/_reposdb-inline view on Meta::CPAN
# },
# },
# result_naked => 1,
# result => {
# schema => 'array',
# },
#};
#sub complete_file {
# require Complete::Path;
# require Encode;
# require File::Glob;
#
# my %args = @_;
# my $word = $args{word} // "";
# my $handle_tilde = $args{handle_tilde} // 1;
# my $allow_dot = $args{allow_dot} // 1;
#
# # if word is starts with "~/" or "~foo/" replace it temporarily with user's
# # name (so we can restore it back at the end). this is to mimic bash
# # support. note that bash does not support case-insensitivity for "foo".
# my $result_prefix;
# my $starting_path = $args{starting_path} // '.';
# if ($handle_tilde && $word =~ s!\A(~[^/]*)/!!) {
# $result_prefix = "$1/";
# my @dir = File::Glob::bsd_glob($1); # glob will expand ~foo to /home/foo
# return [] unless @dir;
# $starting_path = Encode::decode('UTF-8', $dir[0]);
# } elsif ($allow_dot && $word =~ s!\A((?:\.\.?/+)+|/+)!!) {
# # just an optimization to skip sequences of '../'
# $starting_path = $1;
# $result_prefix = $1;
# $starting_path =~ s#/+\z## unless $starting_path =~ m!\A/!;
# }
#
# # bail if we don't allow dot and the path contains dot
# return [] if !$allow_dot &&
# $word =~ m!(?:\A|/)\.\.?(?:\z|/)!;
#
# # prepare list_func
# my $list = sub {
# my ($path, $intdir, $isint) = @_;
# opendir my($dh), $path or return undef;
# my @res;
# for (sort readdir $dh) {
# # skip . and .. if leaf is empty, like in bash
# next if ($_ eq '.' || $_ eq '..') && $intdir eq '';
# next if $isint && !(-d "$path/$_");
# push @res, Encode::decode('UTF-8', $_);
# }
# \@res;
# };
#
# # prepare filter_func
#
# # from the filter option
# my $filter;
# if ($args{filter} && !ref($args{filter})) {
# my @seqs = split /\s*\|\s*/, $args{filter};
# $filter = sub {
# my $name = shift;
# my @st = stat($name) or return 0;
# my $mode = $st[2];
# my $pass;
# SEQ:
# for my $seq (@seqs) {
# my $neg = sub { $_[0] };
# for my $c (split //, $seq) {
# if ($c eq '-') { $neg = sub { $_[0] ? 0 : 1 } }
# elsif ($c eq 'r') { next SEQ unless $neg->($mode & 0400) }
# elsif ($c eq 'w') { next SEQ unless $neg->($mode & 0200) }
# elsif ($c eq 'x') { next SEQ unless $neg->($mode & 0100) }
# elsif ($c eq 'f') { next SEQ unless $neg->($mode & 0100000)}
# elsif ($c eq 'd') { next SEQ unless $neg->($mode & 0040000)}
# else {
# die "Unknown character in filter: $c (in $seq)";
# }
# }
# $pass = 1; last SEQ;
# }
# $pass;
# };
# } elsif ($args{filter} && ref($args{filter}) eq 'CODE') {
# $filter = $args{filter};
# }
#
# # from the file_regex_filter option
# my $filter_fregex;
# if ($args{file_regex_filter}) {
# $filter_fregex = sub {
# my $name = shift;
# return 1 if -d $name;
# return 0 unless -f _;
# return 1 if $name =~ $args{file_regex_filter};
# 0;
# };
# }
#
# # from the file_ext_filter option
# my $filter_fext;
# if ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'Regexp') {
# $filter_fext = sub {
# my $name = shift;
# return 1 if -d $name;
# return 0 unless -f _;
# my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
# return 1 if $ext =~ $args{file_ext_filter};
# 0;
# };
# } elsif ($args{file_ext_filter} && ref $args{file_ext_filter} eq 'ARRAY') {
# $filter_fext = sub {
# my $name = shift;
# return 1 if -d $name;
# return 0 unless -f _;
# my $ext = $name =~ /\.(\w+)\z/ ? $1 : '';
# if ($Complete::Common::OPT_CI) {
# $ext = lc($ext);
# for my $e (@{ $args{file_ext_filter} }) {
# return 1 if $ext eq lc($e);
# }
# } else {
# for my $e (@{ $args{file_ext_filter} }) {
script/_reposdb-inline view on Meta::CPAN
#use YAML::Old::Mo; # XXX
#
#sub yaml_dump {
# my $self = shift;
# my ($value) = @_;
# my ($class, $type) = YAML::Old::Mo::Object->node_info($value);
# no strict 'refs';
# my $kind = lc($type) . ':';
# my $tag = ${$class . '::ClassTag'} ||
# "!perl/$kind$class";
# if ($type eq 'REF') {
# YAML::Old::Node->new(
# {(&YAML::Old::VALUE, ${$_[0]})}, $tag
# );
# }
# elsif ($type eq 'SCALAR') {
# $_[1] = $$value;
# YAML::Old::Node->new($_[1], $tag);
# }
# elsif ($type eq 'GLOB') {
# # blessed glob support is minimal, and will not round-trip
# # initial aim: to not cause an error
# return YAML::Old::Type::glob->yaml_dump($value, $tag);
# } else {
# YAML::Old::Node->new($value, $tag);
# }
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::undef;
#
#sub yaml_dump {
# my $self = shift;
#}
#
#sub yaml_load {
# my $self = shift;
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::glob;
#
#sub yaml_dump {
# my $self = shift;
# # $_[0] remains as the glob
# my $tag = pop @_ if 2==@_;
#
# $tag = '!perl/glob:' unless defined $tag;
# my $ynode = YAML::Old::Node->new({}, $tag);
# for my $type (qw(PACKAGE NAME SCALAR ARRAY HASH CODE IO)) {
# my $value = *{$_[0]}{$type};
# $value = $$value if $type eq 'SCALAR';
# if (defined $value) {
# if ($type eq 'IO') {
# my @stats = qw(device inode mode links uid gid rdev size
# atime mtime ctime blksize blocks);
# undef $value;
# $value->{stat} = YAML::Old::Node->new({});
# if ($value->{fileno} = fileno(*{$_[0]})) {
# local $^W;
# map {$value->{stat}{shift @stats} = $_} stat(*{$_[0]});
# $value->{tell} = tell(*{$_[0]});
# }
# }
# $ynode->{$type} = $value;
# }
# }
# return $ynode;
#}
#
#sub yaml_load {
# my $self = shift;
# my ($node, $class, $loader) = @_;
# my ($name, $package);
# if (defined $node->{NAME}) {
# $name = $node->{NAME};
# delete $node->{NAME};
# }
# else {
# $loader->warn('YAML_LOAD_WARN_GLOB_NAME');
# return undef;
# }
# if (defined $node->{PACKAGE}) {
# $package = $node->{PACKAGE};
# delete $node->{PACKAGE};
# }
# else {
# $package = 'main';
# }
# no strict 'refs';
# if (exists $node->{SCALAR}) {
# *{"${package}::$name"} = \$node->{SCALAR};
# delete $node->{SCALAR};
# }
# for my $elem (qw(ARRAY HASH CODE IO)) {
# if (exists $node->{$elem}) {
# if ($elem eq 'IO') {
# $loader->warn('YAML_LOAD_WARN_GLOB_IO');
# delete $node->{IO};
# next;
# }
# *{"${package}::$name"} = $node->{$elem};
# delete $node->{$elem};
# }
# }
# for my $elem (sort keys %$node) {
# $loader->warn('YAML_LOAD_WARN_BAD_GLOB_ELEM', $elem);
# }
# return *{"${package}::$name"};
#}
#
##-------------------------------------------------------------------------------
#package YAML::Old::Type::code;
#
#my $dummy_warned = 0;
#my $default = '{ "DUMMY" }';
#
#sub yaml_dump {
# my $self = shift;
# my $code;
# my ($dumpflag, $value) = @_;
( run in 1.111 second using v1.01-cache-2.11-cpan-39bf76dae61 )