Result:
found more than 871 distributions - search limited to the first 2001 files matching your query
( run in 1.576 )
App-Genpass-ID
view release on metacpan or search on metacpan
script/_genpass-id view on Meta::CPAN
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
script/_genpass-id view on Meta::CPAN
# if ($after_ws) {
# $is_cur_word = defined($cword) && $cword==@words;
# } else {
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
script/_genpass-id view on Meta::CPAN
# v => 1.1,
# summary => 'Given two or more answers, combine them into one',
# description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
script/_genpass-id view on Meta::CPAN
# if (@_fixups) {
# $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
# }
#
# if ($_is_dd) {
# say $res;
# return wantarray() || @_ > 1 ? @_ : $_[0];
# } else {
# return $res;
# }
#}
App-Genpass-WordList
view release on metacpan or search on metacpan
script/_genpass-wordlist view on Meta::CPAN
# ((?: \\\\|\\"|\\'|\\=|\\\s|[^"'@><=|&\(:\s])+)(\s*) | # 8) unquoted word 9) space after
# ([\@><=|&\(:]+) | # 10) non-whitespace word-breaking characters
# \s+
# )!
# $pos += length($1);
# #say "D: \$1=<$1> \$2=<$3> \$3=<$3> \$4=<$4> \$5=<$5> \$6=<$6> \$7=<$7> \$8=<$8> \$9=<$9> \$10=<$10>";
# #say "D:<$1> pos=$pos, point=$point, cword=$cword, after_ws=$after_ws";
#
# if ($2 || $5 || defined($8)) {
# # double-quoted/single-quoted/unquoted chunk
#
# if (not(defined $cword)) {
# $pos_min_ws = $pos - length($2 ? $4 : $5 ? $7 : $9);
# #say "D:pos_min_ws=$pos_min_ws";
# if ($point <= $pos_min_ws) {
# $cword = @words - ($after_ws ? 0 : 1);
# } elsif ($point < $pos) {
# $cword = @words + 1 - ($after_ws ? 0 : 1);
# $add_blank = 1;
script/_genpass-wordlist view on Meta::CPAN
# if ($after_ws) {
# $is_cur_word = defined($cword) && $cword==@words;
# } else {
# $is_cur_word = defined($cword) && $cword==@words-1;
# }
# #say "D:is_cur_word=$is_cur_word";
# $chunk =
# $2 ? _add_double_quoted($3, $is_cur_word) :
# $5 ? _add_single_quoted($6) :
# _add_unquoted($8, $is_cur_word, $after_ws);
# if ($opts && $opts->{truncate_current_word} &&
# $is_cur_word && $pos > $point) {
# $chunk = substr(
# $chunk, 0, length($chunk)-($pos_min_ws-$point));
# #say "D:truncating current word to <$chunk>";
# }
# if ($after_ws) {
# push @words, $chunk;
# } else {
# $words[-1] .= $chunk;
script/_genpass-wordlist view on Meta::CPAN
# v => 1.1,
# summary => 'Given two or more answers, combine them into one',
# description => <<'_',
#
#This function is useful if you want to provide a completion answer that is
#gathered from multiple sources. For example, say you are providing completion
#for the Perl tool <prog:cpanm>, which accepts a filename (a tarball like
#`*.tar.gz`), a directory, or a module name. You can do something like this:
#
# combine_answers(
# complete_file(word=>$word),
script/_genpass-wordlist view on Meta::CPAN
# if (@_fixups) {
# $res = "do{my\$a=$res;" . join("", @_fixups) . "\$a}";
# }
#
# if ($_is_dd) {
# say $res;
# return wantarray() || @_ > 1 ? @_ : $_[0];
# } else {
# return $res;
# }
#}
App-GetoptLongUtils
view release on metacpan or search on metacpan
script/parse-getopt-long-spec view on Meta::CPAN
use Data::Dmp;
use Getopt::Long::Util qw(parse_getopt_long_opt_spec);
for (@ARGV) {
say "$_: ", dmp(parse_getopt_long_opt_spec($_));
}
# ABSTRACT: Parse Getopt::Long option specification
# PODNAME: parse-getopt-long-spec
App-Gimei
view release on metacpan or search on metacpan
author/format.pl view on Meta::CPAN
foreach my $f (@files) {
if ( any { $f =~ $_ } @patterns ) {
$self->format($f);
}
}
say "Done $#files files.";
}
method format($file) {
my $perltidyrc = File::Spec->catfile( $root_dir, '.perltidyrc' );
App-Git-Info
view release on metacpan or search on metacpan
lib/App/Git/Info.pm view on Meta::CPAN
s#\A(On branch \S+\n)((?:\S[^\n]*\n)?).*#"⇒ $1".($2 ? "⇒ $2" : "")#emrs
. `git status -s`
. "⇒ Remotes:\n"
. `git remote -v` );
chomp $ret;
say $ret;
return;
}
sub run
App-GitFind
view release on metacpan or search on metacpan
lib/App/GitFind/Actions.pm view on Meta::CPAN
}
# TODO optimization? Pull the stat() results from $_[1] rather than
# re-statting. May not be an issue.
sub do_print {
say $_[0]->dot_relative_path($_[1]);
true
}
sub do_print0 { print $_[0]->dot_relative_path($_[1]), "\0"; true }
App-GitGitr
view release on metacpan or search on metacpan
lib/App/GitGitr.pm view on Meta::CPAN
my( $self , $opt , $args ) = @_;
my $version = $opt->{version} // _build_version();
my $install_dir = $opt->{prefix} // "/opt/git-$version";
say "CURRENT VERSION: $version"
if $opt->{verbose};
if ( -e $install_dir and ! $opt->{reinstall} ) {
if( $opt->{no_symlink} ) {
say "Most recent version ($version) already installed.";
}
else {
$self->_symlink( $opt , $version );
say "Most recent version ($version) already installed. /opt/git redirected to that version";
}
}
else {
chdir( '/tmp' );
say "BUILD/INSTALL git-$version"
if $opt->{verbose};
my $pkg_path = $self->_download( $opt , $version );
$self->_extract( $opt , $pkg_path );
$self->_configure( $opt , $version , $install_dir );
lib/App/GitGitr.pm view on Meta::CPAN
$self->_make_test( $opt ) if $opt->{run_tests};
$self->_make_install( $opt );
$self->_cleanup( $opt , $version );
$self->_symlink( $opt , $version ) unless $opt->{no_symlink};
say "\n\nBuilt new git $version."
if $opt->{verbose};
say "/opt/git symlink switched to new version ($version)."
unless $opt->{no_symlink};
}
die "No new version?!"
unless -e "/opt/git-$version";
lib/App/GitGitr.pm view on Meta::CPAN
}
sub _download {
my( $self , $opt , $version ) = @_;
say "*** download" if $opt->{verbose};
my $pkg_path = sprintf "git-%s.tar.gz" , $version;
my $url = sprintf "https://kernel.org/pub/software/scm/git/%s" , $pkg_path;
#my $url = sprintf "http://git-core.googlecode.com/files/%s" , $pkg_path;
lib/App/GitGitr.pm view on Meta::CPAN
return $pkg_path;
};
sub _extract {
my( $self , $opt , $pkg_path ) = @_;
say "*** extract" if $opt->{verbose};
my $ae = Archive::Extract->new( archive => $pkg_path );
$ae->extract or die $ae->error;
unlink $pkg_path;
};
sub _configure {
my( $self , $opt , $version , $install_dir ) = @_;
say "*** configure" if $opt->{verbose};
chdir "git-$version";
### FIXME should have some way to allow override of these args
my $cmd = "./configure --prefix=$install_dir --without-tcltk";
# MacOS doesn't have openssl.h anymore, i guess?
$cmd .= " --without-openssl" if $^O eq 'darwin';
_run( $cmd );
};
sub _make {
my( $self , $opt ) = @_;
say "*** make" if $opt->{verbose};
_run( 'make' );
};
sub _make_test {
my( $self , $opt ) = @_;
say "*** make test" if $opt->{verbose};
_run( 'make test' );
};
sub _make_install {
my( $self , $opt ) = @_;
say "*** make install" if $opt->{verbose};
_run( 'make install' );
};
sub _cleanup {
my( $self , $opt , $version ) = @_;
say "*** cleanup" if $opt->{verbose};
chdir '..';
remove( \1 , "git-$version" );
};
sub _symlink {
my( $self , $opt , $version ) = @_;
say "*** symlink" if $opt->{verbose};
chdir '/opt';
remove( 'git' );
symlink( "git-$version" , 'git' );
};
App-GitGot
view release on metacpan or search on metacpan
lib/App/GitGot/Command.pm view on Meta::CPAN
try {
eval "use $scheme";
die $@ if $@;
}
catch {
say "Failed to load color scheme '$scheme'.\nExitting now.\n";
exit(5);
};
return $scheme->new({ no_color => $self->no_color });
}
lib/App/GitGot/Command.pm view on Meta::CPAN
$status = $self->$fxn($repo) if ($fxn);
next REPO if $self->quiet and !$status;
say "$msg$status";
}
}
sub _find_repo_root {
my( $self , $path ) = @_;
lib/App/GitGot/Command.pm view on Meta::CPAN
: ( -d $repo->path ) ? 'NO REMOTE'
: 'ERROR: No remote and no repo?!';
printf "%3d) ", $repo->number;
if ( $self->quiet ) { say $repo->label }
else {
printf "%-${max_len}s %-4s %s\n",
$repo->label, $repo->type, $repo_remote;
if ( $self->verbose ) {
printf " tags: %s\n" , $repo->tags if $repo->tags;
lib/App/GitGot/Command.pm view on Meta::CPAN
}
return 1;
}
say "repository not in Got list";
return;
}
sub _read_config {
my $file = shift;
my $config;
if ( -e $file ) {
try { $config = LoadFile( $file ) }
catch { say "Failed to parse config..."; exit };
}
# if the config is completely empty, bootstrap _something_
return $config // [ {} ];
}
lib/App/GitGot/Command.pm view on Meta::CPAN
next REPO if $self->quiet and !$status;
}
elsif ( $repo->repo ) { $status = 'Not checked out' }
else { $status = $self->error("ERROR: repo '$label' does not exist") }
say "$msg$status";
}
}
sub _update {
my( $self , @repos ) = @_;
lib/App/GitGot/Command.pm view on Meta::CPAN
$status = $self->$fxn($repo) if ($fxn);
next REPO if $self->quiet and !$status;
say "$msg$status";
}
}
# override this in commands that shouldn't use IO::Page -- i.e., ones that
# need to do incremental output
App-GitGrepPerlStatement
view release on metacpan or search on metacpan
lib/App/GitGrepPerlStatement.pm view on Meta::CPAN
use App::GitGrepPerlStatement::StatementFinder;
use Term::ANSIColor qw(colored);
our $VERSION = "0.05";
sub say ($) {
my ($message) = @_;
print $message . "\n";
}
sub run {
my ($class, @argv) = @_;
my $word = (@argv)[0];
unless (defined $word) {
say "USAGE: git grep-per-statement <pattern token> <pathspec>";
exit 1;
}
my @files = split "\n", `git grep --name-only --cached --word-regexp @{[ join ' ', map { quotemeta($_) } @argv ]}`;
lib/App/GitGrepPerlStatement.pm view on Meta::CPAN
for my $file (@files) {
my @found = $finder->search($file);
for (@found) {
if (-t STDOUT) {
say colored(
['bold'],
"@{[ $file ]}:@{[ $_->line_number ]}"
);
say $finder->highlight($_);
} else {
say "@{[ $file ]}:@{[ $_->line_number ]}";
say $_;
}
}
$finder->flush;
}
App-GitHub
view release on metacpan or search on metacpan
scripts/github.pl view on Meta::CPAN
if ($create) {
eval { $github->repo_create($create); };
if ($@) {
say STDERR "Could not create repo $create";
print STDERR $@;
}
else {
say "Created repo $create";
}
}
elsif ($key) {
say STDERR "Provide a name for the key with -n" if not $name;
eval { $github->user_pub_keys( "add", $name, $key ); };
if ($@) {
say STDERR "Could not add key";
print STDERR $@;
}
else {
say "Added pubkey";
}
}
elsif ($fork) {
eval { $github->run_basic_repo_cmd( 'repos', 'create_fork', $fork ); };
if ($@) {
say STDERR "Could not fork $fork";
print STDERR $@;
}
else {
say "Forked repo $fork";
}
}
}
1;
App-GitHubPullRequest
view release on metacpan or search on metacpan
lib/App/GitHubPullRequest.pm view on Meta::CPAN
#!perl
use strict;
use warnings;
use feature qw(say state);
package App::GitHubPullRequest;
$App::GitHubPullRequest::VERSION = '0.6.0';
# ABSTRACT: Command-line tool to query GitHub pull requests
lib/App/GitHubPullRequest.pm view on Meta::CPAN
sub list {
my ($self, $state) = @_;
$state ||= 'open';
my $remote_repo = _find_github_remote();
my $prs = _api_read("/repos/$remote_repo/pulls?state=$state");
say ucfirst($state) . " pull requests for '$remote_repo':";
unless ( @$prs ) {
say "No pull requests found.";
return 0;
}
foreach my $pr ( @$prs ) {
my $number = $pr->{"number"};
my $title = encode_utf8( $pr->{"title"} );
my $date = $pr->{"updated_at"} || $pr->{'created_at'};
say join(" ", $number, $date, $title);
}
return 0;
}
lib/App/GitHubPullRequest.pm view on Meta::CPAN
{
my $user = $pr->{'user'}->{'login'};
my $title = encode_utf8( $pr->{"title"} );
my $body = encode_utf8( $pr->{"body"} );
my $date = $pr->{"updated_at"} || $pr->{'created_at'};
say "Date: $date";
say "From: $user";
say "Subject: $title";
say "Number: $number";
say "\n$body\n" if $body;
}
my $comments = _api_read( $pr->{'comments_url'} );
foreach my $comment (@$comments) {
my $user = $comment->{'user'}->{'login'};
my $date = $comment->{'updated_at'} || $comment->{'created_at'};
my $body = encode_utf8( $comment->{'body'} );
say "-" x 79;
say "Date: $date";
say "From: $user";
say "\n$body\n";
}
return 0;
}
lib/App/GitHubPullRequest.pm view on Meta::CPAN
. " to existing remote.\n")
if $rc != 0;
}
# Fetch changes from just added remote
say "Fetching changes from '$head_remote/$head_branch'";
my ($content, $rc) = _run_ext(
qw(git fetch),
$head_remote,
);
die("git failed with error $rc when trying to update remote.\n")
lib/App/GitHubPullRequest.pm view on Meta::CPAN
my ($self, $number) = @_;
die("Please specify a pull request number.\n") unless $number;
my $pr = $self->_state($number, 'closed');
die("Unable to close pull request $number.\n")
unless defined $pr;
say "Pull request $number now in state: " . $pr->{'state'};
return 0;
}
sub open { ## no critic (Subroutines::ProhibitBuiltinHomonyms)
my ($self, $number) = @_;
die("Please specify a pull request number.\n") unless $number;
my $pr = $self->_state($number, 'open');
die("Unable to open pull request $number.\n")
unless defined $pr;
say "Pull request $number now in state: " . $pr->{'state'};
return 0;
}
sub comment {
lib/App/GitHubPullRequest.pm view on Meta::CPAN
};
die($@ . ( defined $filename ? "Comment text saved in '$filename'. Please remove it manually." : "" ) ."\n")
if $@; # most likely network error
die("Unable to add comment on pull request $number.\n")
unless defined $comment;
say "Comment added. You can view it online here: " . $comment->{'html_url'};
# Remove temporary file if everything went well
if ( defined $filename and -e $filename ) {
my $count = unlink $filename;
warn("Unable to remove temporary file $filename: $!\n")
lib/App/GitHubPullRequest.pm view on Meta::CPAN
sub login {
my ($self, $user, $password, $two_factor_token) = @_;
# Add deprecation message
say "\nThis authorization method is deprecated and will be removed on November 13, 2020.";
say "Please use the 'authorize' command to authenticate with GitHub.\n";
# Try to fetch user/password from git config (or prompt)
$user ||= _qx('git', "config github.user") || _prompt('GitHub username');
$password ||= _qx('git', "config github.password") || _prompt('GitHub password', 'hidden');
die("Please specify a user name.\n") unless $user;
lib/App/GitHubPullRequest.pm view on Meta::CPAN
# Store authorization token
my ($content, $rc) = _run_ext(qw(git config --global github.pr-token), $token);
die("git config returned message '$content' and code $rc when trying to store your token.\n")
if $rc != 0;
say "Access token stored successfully. Go to https://github.com/settings/tokens to revoke access.";
return 0;
}
sub authorize {
my ($self, $token) = @_;
# Verify that you want to overwrite an existing token
my $old_token = _qx('git', "config github.pr-token");
if ( $old_token and not $token ) {
say "You're already authorized.";
my $q = _prompt("Do you want to generate a new token (y/N)") || "n";
return 0 if lc($q) ne 'y';
}
# Give instructions and ask for token if not specified on command line
unless ( $token ) {
say "Go to https://github.com/settings/tokens/new and follow the directions to generate a new token.";
say "Give the token a name of your choice, e.g. 'git-pr', and give it the 'repo' permission.";
say "The 'public_repo' permission is enough if you only plan to use it with public repositories.\n";
$token = _prompt('GitHub OAuth personal access token');
}
# Make sure a token is specified
die("No token was specified. No changes have been made to your configuration.\n")
unless $token;
# Store authorization token
my ($content, $rc) = _run_ext(qw(git config --global github.pr-token), $token);
die("git config returned message '$content' and code $rc when trying to store your token.\n")
if $rc != 0;
say "Access token stored successfully. Go to https://github.com/settings/tokens to revoke access.";
return 0;
}
sub _state {
my ($self, $number, $state) = @_;
App-GitHubUtils
view release on metacpan or search on metacpan
lib/App/GitHubUtils.pm view on Meta::CPAN
chomp($repo);
my $stdout;
IPC::System::Options::system(
{die=>1, log=>1, capture_stdout=>\$stdout},
"git", "config", "-l");
say $stdout;
$stdout =~ m!.*=.*github\.com:?/?([^/]+)/(.+?)(?:\.git)?$!im
or return [412, "Can't find github username and repository name from configuration"];
Browser::Open::open_browser("https://github.com/$1/$2");
[200];
}
App-Github-Email
view release on metacpan or search on metacpan
Change: 69eec28e13ca6a18ef0ef6cb3659940c70396633
Author: faraco <skelic3@gmail.com>
Date : 2018-08-31 11:46:31 +0000
replaced say with print
Change: dd18621ef8c15c47fc0031adc2cf4fcf6854a7c1
Author: faraco <skelic3@gmail.com>
Date : 2018-08-31 00:12:20 +0000
App-GnuCash-MembershipUtils
view release on metacpan or search on metacpan
bin/gc-members-generate-invoices view on Meta::CPAN
## * Before comitting this file to the repository, ensure Perl Critic can be
## invoked at the HARSH [3] level with no errors
##****************************************************************************
use strict;
use warnings;
use feature qw( say state );
## Cannot use Find::Bin because script may be invoked as an
## argument to another script, so instead we use __FILE__
use File::Basename qw(dirname fileparse basename);
use File::Spec;
bin/gc-members-generate-invoices view on Meta::CPAN
my $warning;
($error, $warning) = validate_accounts_in_config({
schema => $schema,
config => $config,
});
say STDERR $warning if ($warning);
if ($error) {
say STDERR $error;
exit(1);
}
my @members = get_all_members({
active_only => 1,
bin/gc-members-generate-invoices view on Meta::CPAN
owner_id => $member->{id},
account => $member->{membership_account},
price => $member->{membership_amount},
desc => join(" - ", grep { length } ($member->{membership_type}, $gOptions{memo})),
);
$csv->say ($fh, [ map { $inv{$_} } @CSV_COLUMNS ]);
}
close($fh);
} else {
say STDERR "Error writing '$gOptions{outfile}': $!";
exit(1);
}
## use critic
# "First Invoice: '%06d'"
printf("Last Invoice: '%06d'\n", --$next_inv_id);
App-Gnuget
view release on metacpan or search on metacpan
1.930 2013-09-18
- add a pod to App::Gnuget
- fix versions in doc and help
1.925 2013-09-03
- don't use say() anymore to be able to run tests on perl 5.8
1.92 2013-08-30
- fix a typo in unit test (thanks srezic)
1.91 2013-08-30
App-Goto-Amazon
view release on metacpan or search on metacpan
lib/App/Goto/Amazon.pm view on Meta::CPAN
}
# Exit with a list of hosts if no name specified
my $name = $self->name;
unless ($name) {
say join "\n", sort @{$self->instances};
exit;
}
# We have all we need. Let's goto!
my $goto = App::Goto->new({ args => [qr/$name/], config => $self->config });
my $cmd = $goto->cmd;
App-Goto
view release on metacpan or search on metacpan
use Config::Tiny;
use App::Goto;
# Quit with help text if asked for it/didn't ask for anything
if (!@ARGV || $ARGV[0] =~ /^--?h/) {
say 'g2: shortcut utility';
say 'g2 <label for desired host> [label for command to run remotely]';
say 'Requires valid config file at /etc/g2rc or ~/.g2rc';
exit;
}
# Not helping, so check for a config
my $my_config_file = "$ENV{HOME}/.g2rc";
# Config file exists, command has been given. Do what's needed
my $goto = App::Goto->new({ args => \@ARGV, config => $config });
# Handle bad input
unless ($goto->is_success) {
say $goto->error();
exit
}
# Looks like we're good to go
if ($ENV{G2DB}) {
say $goto->cmd();
}
else {
system( $goto->cmd() );
}
App-Goto2
view release on metacpan or search on metacpan
lib/App/Goto2.pm view on Meta::CPAN
my $hosts = $self->hosts;
my @matching_hosts = grep { m/$hostre/ } sort keys %$hosts;
error("No matching hosts found") unless @matching_hosts;
say "Hosts found: @matching_hosts" if $self->verbose;
# Just print a list of servers if appropriate
$self->print_list(\@matching_hosts) if $self->list;
# Either iterate over all matching hosts, or just use the first
for my $host ( @matching_hosts ) {
my $cmd = $self->generate_ssh_cmd($hosts->{$host});
say "Executing command: $cmd" if $self->verbose;
system( $cmd );
exit unless $self->iterate;
}
}
lib/App/Goto2.pm view on Meta::CPAN
my ($self, $hostnames) = @_;
my $hosts = $self->hosts;
for my $host (@$hostnames) {
say "$host: " . $hosts->{$host}{hostname};
}
exit;
}
sub generate_ssh_cmd {
lib/App/Goto2.pm view on Meta::CPAN
return $cmd;
}
sub error {
my ($msg) = @_;
say $msg;
exit 1;
}
sub hosts {
my ($self) = @_;
App-GrepUtils
view release on metacpan or search on metacpan
script/grep-terms view on Meta::CPAN
sub parse_cmdline {
Getopt::Long::Configure('auto_abbrev', 'pass_through');
my $res = GetOptions(
'version|V' => sub {
no warnings 'once';
say "grep-terms version ", ($main::VERSION // 'dev');
exit 0;
},
'help' => sub {
print <<USAGE;
Usage:
App-Greple-charcode
view release on metacpan or search on metacpan
lib/App/Greple/annotate.pm view on Meta::CPAN
}
sub annotate {
config('annotate') or return;
if (my @annon = $annotation->shift) {
say $_->annon for @annon;
}
undef;
}
1;
App-Greple-subst
view release on metacpan or search on metacpan
lib/App/Greple/subst.pm view on Meta::CPAN
sub subst_initialize {
state $once_called++ and return;
if ($opt_show_dictdir) {
say "$ENV{GREPLE_SUBST_DICT}";
exit;
}
Getopt::EX::LabeledParam
->new(HASH => \%opt_stat_item)
lib/App/Greple/subst.pm view on Meta::CPAN
print colorize('000/L24E', sprintf($dict_format, $dict->NAME));
}
for my $item (@$show) {
my($i, $p, $hash) = @$item;
if ($p->is_comment) {
say $p->comment if $opt_show_comment;
next;
}
my($from_re, $to) = ($p->string, $p->correct // '');
my @keys = keys %{$hash};
if ($opt_stat_style eq 'dict') {
App-Greple-tee
view release on metacpan or search on metacpan
docs/Makefile view on Meta::CPAN
ENGINES := deepl gpt5
#LANGS_deepl := DE EL ES ET FR ID JA KO NL RO RU TR ZH
LANGS_gpt5 := JA KO ZH
MOD_NAME := $(shell perl -MJSON -0777nE 'say decode_json($$_)->{name}' ../META.json)
MOD_PATH := ../lib/$(subst -,/,$(MOD_NAME)).pm
MOD_FILE := $(notdir $(MOD_PATH))
MOD_DIR := $(dir $(MOD_PATH))
MOD_NAME := $(MOD_FILE:.pm=)
SRC_DIR := src
App-Greple-wordle
view release on metacpan or search on metacpan
lib/App/Greple/wordle.pm view on Meta::CPAN
$game = App::Greple::wordle::game->new(answer => $app->answer);
push @$argv, $app->patterns;
if ($interactive = -t STDIN) {
push @$argv, '--interactive', ('/dev/stdin') x $app->total;
select->autoflush;
say $app->title;
print prompt();
}
}
sub respond {
lib/App/Greple/wordle.pm view on Meta::CPAN
max(11, vwidth($_) + length(prompt()) + 2)));
print s/(?<=.)\z/\n/r for @_;
}
sub show_answer {
say colorize('#6aaa64', uc $game->answer);
}
sub show_result {
printf "\n%s %d/%d\n\n", $app->title, $game->attempt, $app->trial;
say $game->result;
}
sub check {
my $word = lc s/\n//r;
if (not $word_all{$word}) {
lib/App/Greple/wordle.pm view on Meta::CPAN
return 1;
}
@remember = @word;
do {
local $, = ' ';
say $game->hint_color(@word);
};
1;
}
sub help {
App-Greple-xlate
view release on metacpan or search on metacpan
script/xlate view on Meta::CPAN
# Utility functions
##############################################################################
dist_dir() {
local mod=$1
perl -M$mod -MFile::Share=:all -E "say dist_dir '${mod//::/-}'"
}
warn() {
[[ ${quiet:-} ]] && return
echo "$@" >&2
App-Greple
view release on metacpan or search on metacpan
lib/App/Greple/select.pm view on Meta::CPAN
sub select {
my %arg = @_;
my $name = delete $arg{&FILELABEL} or die;
if ($select->check($name, *_)) {
say $name if $opt{yes};
$opt{die} and die "SKIP $name\n";
} else {
say $name if $opt{no};
die "SKIP $name\n";
}
}
1;
App-HPGL2Cadsoft
view release on metacpan or search on metacpan
lib/App/HPGL2Cadsoft.pm view on Meta::CPAN
$zero_length_stubs++;
}
next;
}
if ( $command =~ /IN/ ) {
say "Init sequence found";
next;
}
if ( $command =~ /SP(\d+)/ ) {
say "Selected pen $1";
next;
}
if ( $command =~ /^PU$/) {
# Final PU command
lib/App/HPGL2Cadsoft.pm view on Meta::CPAN
sub run {
my $self = shift();
my ($lines, $zero_stubs)= $self->_parse_hpgl();
say "Found $lines valid segments in HPGL file";
say "Skipped $zero_stubs segments with zero length";
$self->_scale();
$self->_calculate_bbox();
# Report bounding box dimensions, maybe the user wants to change the scaling factor
say "Object bounding box stretches from (x,y) to (x,y) in millimeter:";
say " ("
. sprintf( '%.3f', $self->_bbox->min_x() ) . " "
. sprintf( '%.3f', $self->_bbox->min_y() ) . ") ("
. sprintf( '%.3f', $self->_bbox->max_x() ) . " "
. sprintf( '%.3f', $self->_bbox->max_y() ) . ")";
say
"Total dimensions in x and y directions with scaling factor " . $self->scaling_factor() . " in mm are:";
say " ("
. sprintf( '%.3f', $self->_bbox->max_x() - $self->_bbox->min_x() ) . " "
. sprintf( '%.3f', $self->_bbox->max_y() - $self->_bbox->min_y() ) . ")";
$self->_write_script();
say "Done!";
}
sub _calculate_bbox {
my $self = shift();
App-Hack-Exe
view release on metacpan or search on metacpan
lib/App/Hack/Exe.pm view on Meta::CPAN
my $pause_for = DOTS_DURATION / $num_dots;
while ($num_dots --> 0) {
print '.';
$self->_sleep($pause_for);
}
say '[', colored('COMPLETE', 'bold green'), ']';
$self->_sleep(0.6);
return;
}
sub _get_ip {
my ($self, $hostname) = @_;
$self->_dots('Enumerating Target');
say ' [+] Host: ', $hostname;
my %ips = _lookup_ips($hostname);
my %to_get = (
'IPv4' => $self->{get_ipv4},
'IPv6' => $self->{get_ipv6},
);
foreach my $ip_type (sort keys %ips) {
my $addrs = $ips{$ip_type};
foreach my $addr (@{$addrs}) {
if ($to_get{$ip_type} --> 0) {
say " [+] $ip_type: $addr";
}
}
}
return;
}
lib/App/Hack/Exe.pm view on Meta::CPAN
while (@proxies) {
push @chained, shift @proxies;
print "\r [+] ", (scalar @chained), RECALL_CURSOR, "@chained";
$self->_sleep(0.2);
}
say '';
return;
}
sub _launchproxy {
my $self = shift;
$self->_dots('Opening SOCKS5 ports on infected hosts');
say ' [+] SSL entry point on 127.0.0.1:1337';
return;
}
sub _portknock {
my $self = shift;
lib/App/Hack/Exe.pm view on Meta::CPAN
if (@ports) {
print $";
}
$self->_sleep(0.2);
}
say '';
return;
}
sub _prompt {
my $self = shift;
lib/App/Hack/Exe.pm view on Meta::CPAN
}
sub _w00tw00t {
my $self = shift;
$self->_dots('Sending PCAP datagrams for fragmentation overlap');
say ' [+] Stack override ***** w00t w00t g0t r00t!';
say '';
print '[';
my $chars = 65;
while ($chars --> 0) {
print '=';
$self->_sleep(0.01);
}
say ']';
return;
}
=head1 METHODS
lib/App/Hack/Exe.pm view on Meta::CPAN
$self->_chainproxies;
$self->_portknock;
$self->_w00tw00t;
$self->_prompt($hostname);
say 'Done';
return;
}
=head1 AUTHOR
App-Hasher
view release on metacpan or search on metacpan
my ($file_name) = @_;
my $result = open my $fh, '<', $file_name;
if (not $result) {
say "Error. Can't open file '$file_name' - $!.";
exit 1;
}
# $sha1->b64digest
#
# main
sub main {
if (not defined $ARGV[0]) {
say "Error. Expecting at least one filename as the parameters to the script.";
exit 1;
};
foreach my $argument (@ARGV) {
my $extension = _get_file_extension($argument);
my ($original_file_name, $dir) = fileparse $argument;
my $new_file_name = $hash . $extension;
say sprintf
"%s{ %s -> %s }",
$dir,
colored($original_file_name, 'red'),
colored($new_file_name, 'green'),
;
$dir . $original_file_name,
$dir . $new_file_name
);
if (not $result) {
say "Error. Can't rename file '$dir$original_file_name' to '$dir$new_file_name' - $!.";
exit 1;
}
}
App-Hashl
view release on metacpan or search on metacpan
'd|database=s' => \$db_file,
'e|extra-db=s' => \@edb_files,
'f|force' => \$add_unignore,
'n|no-progress' => sub { $show_progress = 0 },
's|read-size=i' => sub { $read_size = $_[1] * 1024 },
'V|version' => sub { say "hashl version ${VERSION}"; exit 0 },
'x|one-file-system' => sub { $xdev_fsno = ( stat($base) )[0] },
) or usage();
if ( substr( $db_file, 0, 1 ) ne q{/} ) {
$db_file = "${base}/${db_file}";
sub db_find_new {
my ( $file, $path ) = @_;
if ( not any { $_->file_in_db($path) } @ehashl ) {
print STDERR "\r\e[2K";
say $file;
}
return;
}
sub db_find_known {
my ( $file, $path ) = @_;
if ( any { $_->file_in_db($path) } @ehashl ) {
print STDERR "\r\e[2K";
say $file;
}
return;
}
return;
}
sub cmd_list_files {
say join( "\n", sort map { $_->files } @ehashl );
return;
}
sub cmd_list_ignored {
ensure_equal_hash_sizes();
say join( "\n", map { $_->ignored } @ehashl );
return;
}
sub cmd_update {
App-HistHub
view release on metacpan or search on metacpan
inc/Test/Builder.pm view on Meta::CPAN
}
sub _is_qr {
my $regex = shift;
# is_regexp() checks for regexes in a robust manner, say if they're
# blessed.
return re::is_regexp($regex) if defined &re::is_regexp;
return ref $regex eq 'Regexp';
}
( run in 1.576 second using v1.01-cache-2.11-cpan-d7a12ab2c7f )