Acme-Schlong
view release on metacpan or search on metacpan
lib/Acme/Schlong.pm view on Meta::CPAN
documentation => q{The all might, all elementary information!},
);
has perl_specific => ( is => 'ro', isa => Bool, traits => ['Getopt'], cmd_aliases => ['P'], default => 0 );
has username => ( is => 'ro', isa => Str, traits => ['ENV'], env_key => 'user' );
has home_directory => ( is => 'ro', isa => Dir, traits => ['ENV'], env_key => 'home' );
has term => ( is => 'ro', isa => Str, traits => ['ENV'] );
has useraccounts => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{Check if system is like /home/b/bruder ... then you have to also supply the hidden "I'm the administrator switch"} );
has username_length => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{self explanatory} );
has shell => ( is => 'ro', isa => Str, lazy_build => 1, documentation => q{self explanatory} );
has harddrive_size => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{self explanatory} );
has harddrive_used => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{self explanatory} );
has uptime => ( is => 'ro', isa => Any, lazy_build => 1, documentation => q{self explanatory} );
has users => ( is => 'ro', isa => Any, lazy_build => 1, documentation => q{The number of users logged in on the system} );
has cores => ( is => 'ro', isa => Any, lazy_build => 1, documentation => q{The Number of cores of this machine} );
has using_multiplex => ( is => 'ro', isa => Bool, lazy_build => 1, documentation => q{using screen or tmux});
has using_byobu => ( is => 'ro', isa => Bool, lazy_build => 1, documentation => q{using byobu as multiplexer frontend!} );
has using_tmux => ( is => 'ro', isa => Bool, lazy_build => 1, documentation => q{using tmux as multiplexer} );
has using_screen => ( is => 'ro', isa => Bool, lazy_build => 1, documentation => q{using screen as multiplexer} );
lib/Acme/Schlong.pm view on Meta::CPAN
has cpan_modules => ( is => 'ro', isa => Num, lazy_build => 1, documentation => q[self explanatory]);
has perls_installed => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{the number of perls installed through perlbrew} );
has known_hosts => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{self explanatory});
has f => ( is => 'ro', isa => 'File::Util', default => sub { File::Util->new } );
# has followers_on_github =>
# has number_of_rc_files => ~/.*rc
# has length of .vimrc
# has length of .emacs
# has number of files in ~/.emacs.d
# has using .ssh/config
# has rvm/rbenv installed
#
# has number_of_modules => ( is => 'ro', isa => Int, lazy_build => 1, documentation => q{} );
method _build_useraccounts { scalar grep { !/Shared/ } grep { -d $_ } glob ( dir( $self->home_directory => '..') . '/*'); } #TODO Make safer for WIN
method _build_username_length { length $self->username }
method _build_shell { $_ = $ENV{SHELL}; s/.*\/(.*?)$/$1/; $_ } # /r
method _build_harddrive_size { $_=`df -l | grep '\\/\$' | awk '{print \$2}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
method _build_harddrive_used { $_=`df -l | grep '\\/\$' | awk '{print \$3}'`; chomp; $_ } # -E 'use IPC::Run qw<run timeout>; my $out; my @cmd = (q<du>, q<-s>, q</>); run \@cmd, "", \undef, \$out, timeout( 100 ) echo `uptime|grep days|sed...
method _build_uptime { 100 }
method _build_users { 5 }
method _build_cores { App::OS::Detect::MachineCores->new->cores }
method _build_using_multiplex { $self->using_byobu or $self->using_tmux or $self->using_screen ? true : false }
method _build_using_byobu { exists $ENV{BYOBU_BACKEND} ? 1 : 0 }
method _build_using_tmux { $ENV{TERM} ~~ 'tmux' ? 1 : 0 }
method _build_using_screen { $ENV{TERM} ~~ 'screen' ? 1 : 0 }
lib/Acme/Schlong.pm view on Meta::CPAN
->{'username'};
}
method _build_cpan_modules { scalar MetaCPAN::API->new->release(search => {author => $self->pause_name, filter => "distribution", fields=>"name"})->{hits}->{hits} }
method _build_perls_installed { $_ =()= $self->f->list_dir("$ENV{PERLBREW_ROOT}/perls", '--dirs-only', '--no-fsdots') if exists $ENV{PERLBREW_ROOT} }
method _build_known_hosts { $_ = `wc -l ~/.ssh/known_hosts | awk '{print \$1}'`; chomp; $_ }
method _build_size {
$self->size(0);
# useraccounts
# username_length
# shell
# harddrive_size
# uptime
# users
# cores
# using_multiplex
# using_byobu
# using_tmux
# using_screen
#
lib/Acme/Schlong.pm view on Meta::CPAN
# using_tcsh
# using_csh
# say for glob (dir($self->home_directory) . '/' . '.*');
$self->add_size(10) if $self->using_zsh;
$self->add_size(100) if $self->using_multiplex;
$self->add_size( 100 * $self->cores );
$self->sub_size( 10 * $self->username_length );
$self->abs_size
}
method testdrive {
say "Your Acme Schlong size is: ", $self->size;
say "Your username is: ", $self->username;
say "Your home directory is: ", $self->home_directory;
say "The number of useraccounts is ", $self->useraccounts;
say "Your TERM is ", $self->term;
say "Your shell is ", $self->shell;
say "You are using byobu ", $self->using_byobu;
say "Your username length is ", $self->username_length;
say "You harddrive_size is ", $self->harddrive_size;
say "The number of cores is ", $self->cores;
say "Your perl version is ", $self->perl_version;
# say "Your perl version is a dev_release: ", $self->perl_version_is_dev;
say "You have this many dirs in PATH: ", $self->directories_in_path;
say "You are using a multiplexer: ", $self->using_multiplex;
say "You are using perlbrew: ", $self->using_perlbrew;
say "You are using zsh: ", $self->using_zsh;
say "You are using bash: ", $self->using_bash;
say "You are using cpanm: ", $self->using_cpanm;
t/00-report-prereqs.t view on Meta::CPAN
my $ver = MM->parse_version( catfile($prefix, $file) );
$ver = "undef" unless defined $ver; # Newer MM should do this anyway
push @reports, [$ver, $mod];
}
else {
push @reports, ["missing", $mod];
}
}
if ( @reports ) {
my $vl = max map { length $_->[0] } @reports;
my $ml = max map { length $_->[1] } @reports;
splice @reports, 1, 0, ["-" x $vl, "-" x $ml];
diag "Prerequisite Report:\n", map {sprintf(" %*s %*s\n",$vl,$_->[0],-$ml,$_->[1])} @reports;
}
pass;
# vim: ts=2 sts=2 sw=2 et:
t/000-report-versions.t view on Meta::CPAN
return $self->_error("Stream has a non UTF-8 BOM");
} else {
# Strip UTF-8 bom if found, we'll just ignore it
$string =~ s/^\357\273\277//;
}
# Try to decode as utf8
utf8::decode($string) if HAVE_UTF8;
# Check for some special cases
return $self unless length $string;
unless ( $string =~ /[\012\015]+\z/ ) {
return $self->_error("Stream does not end with newline character");
}
# Split the file into lines
my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
split /(?:\015{1,2}\012|\015|\012)/, $string;
# Strip the initial YAML header
@lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
t/000-report-versions.t view on Meta::CPAN
} elsif ( $lines[0] =~ /^\s*\-/ ) {
# An array at the root
my $document = [ ];
push @$self, $document;
$self->_read_array( $document, [ 0 ], \@lines );
} elsif ( $lines[0] =~ /^(\s*)\S/ ) {
# A hash at the root
my $document = { };
push @$self, $document;
$self->_read_hash( $document, [ length($1) ], \@lines );
} else {
croak("YAML::Tiny failed to classify the line '$lines[0]'");
}
}
$self;
}
# Deparse a scalar string to the actual scalar
t/000-report-versions.t view on Meta::CPAN
return '' unless defined $1;
$string = $1;
$string =~ s/\'\'/\'/g;
return $string;
}
if ( $string =~ /^\"((?:\\.|[^\"])*)\"\z/ ) {
# Reusing the variable is a little ugly,
# but avoids a new variable and a string copy.
$string = $1;
$string =~ s/\\"/"/g;
$string =~ s/\\([never\\fartz]|x([0-9a-fA-F]{2}))/(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}/gex;
return $string;
}
# Special cases
if ( $string =~ /^[\'\"!&]/ ) {
croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
}
return {} if $string eq '{}';
return [] if $string eq '[]';
# Regular unquoted string
return $string unless $string =~ /^[>|]/;
# Error
croak("YAML::Tiny failed to find multi-line scalar content") unless @$lines;
# Check the indent depth
$lines->[0] =~ /^(\s*)/;
$indent->[-1] = length("$1");
if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
# Pull the lines
my @multiline = ();
while ( @$lines ) {
$lines->[0] =~ /^(\s*)/;
last unless length($1) >= $indent->[-1];
push @multiline, substr(shift(@$lines), length($1));
}
my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
return join( $j, @multiline ) . $t;
}
# Parse an array
sub _read_array {
my ($self, $array, $indent, $lines) = @_;
t/000-report-versions.t view on Meta::CPAN
# Check for a new document
if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
while ( @$lines and $lines->[0] !~ /^---/ ) {
shift @$lines;
}
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
# Inline nested hash
my $indent2 = length("$1");
$lines->[0] =~ s/-/ /;
push @$array, { };
$self->_read_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
# Array entry with a value
shift @$lines;
push @$array, $self->_read_scalar( "$2", [ @$indent, undef ], $lines );
} elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
shift @$lines;
unless ( @$lines ) {
push @$array, undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)\-/ ) {
my $indent2 = length("$1");
if ( $indent->[-1] == $indent2 ) {
# Null array entry
push @$array, undef;
} else {
# Naked indenter
push @$array, [ ];
$self->_read_array( $array->[-1], [ @$indent, $indent2 ], $lines );
}
} elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
push @$array, { };
$self->_read_hash( $array->[-1], [ @$indent, length("$1") ], $lines );
} else {
croak("YAML::Tiny failed to classify line '$lines->[0]'");
}
} elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
# This is probably a structure like the following...
# ---
# foo:
# - list
t/000-report-versions.t view on Meta::CPAN
# Check for a new document
if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
while ( @$lines and $lines->[0] !~ /^---/ ) {
shift @$lines;
}
return 1;
}
# Check the indent level
$lines->[0] =~ /^(\s*)/;
if ( length($1) < $indent->[-1] ) {
return 1;
} elsif ( length($1) > $indent->[-1] ) {
croak("YAML::Tiny found bad indenting in line '$lines->[0]'");
}
# Get the key
unless ( $lines->[0] =~ s/^\s*([^\'\" ][^\n]*?)\s*:(\s+|$)// ) {
if ( $lines->[0] =~ /^\s*[?\'\"]/ ) {
croak("YAML::Tiny does not support a feature in line '$lines->[0]'");
}
croak("YAML::Tiny failed to classify line '$lines->[0]'");
}
my $key = $1;
# Do we have a value?
if ( length $lines->[0] ) {
# Yes
$hash->{$key} = $self->_read_scalar( shift(@$lines), [ @$indent, undef ], $lines );
} else {
# An indent
shift @$lines;
unless ( @$lines ) {
$hash->{$key} = undef;
return 1;
}
if ( $lines->[0] =~ /^(\s*)-/ ) {
$hash->{$key} = [];
$self->_read_array( $hash->{$key}, [ @$indent, length($1) ], $lines );
} elsif ( $lines->[0] =~ /^(\s*)./ ) {
my $indent2 = length("$1");
if ( $indent->[-1] >= $indent2 ) {
# Null hash entry
$hash->{$key} = undef;
} else {
$hash->{$key} = {};
$self->_read_hash( $hash->{$key}, [ @$indent, length($1) ], $lines );
}
}
}
}
return 1;
}
# Set error
sub _error {
( run in 0.541 second using v1.01-cache-2.11-cpan-65fba6d93b7 )